|
 |
Free Form RPG
What more can I say, "I kinda like it."
I know you have a programmer in the building that says
" These punch cards were good enough for me in the 70’s so there good
enough for me now. This is for them slip a couple lines of Free Format RPG
into their source and watch their heads explode.
If nothing else, this will give you a taste of other languages, cause believe
it or not, the time is coming/here when those PC type languages are going to
slowly replace our beloved RPG.
The only two lines of code that must start in a specific position
are the compiler directives /FREE and /END-FREE, which begin in column 7.
The lines in between can use any columns between 8 and 80,
allowing you to logically indent your code as we did here.
Notice that even operations like Read, Dsply and BegSR can be used in free format.
Each statement ends with a semicolon.
That is something you’ll forget many times before it becomes natural to you.
You are still limited to one op-code per line, which is probably a good idea,
but statements can span multiple lines if necessary.
Supported Opcodes
Op-Code Purpose
ACQ Acquire device
BEGSR Begin Subroutine
CALLP Call Prototyped Procedure or Program
CHAIN Retrieve Record by key
CLEAR Clear
CLOSE Close File
COMMIT Commit Database changes
DEALLOC Release Dynamically Allocated Storage
DELETE Delete Record
DOU Do Until
DOW Do While
DSPLY Display message
DUMP Dump Program
ELSE Else
ELSEIF Else If
ENDyy End a Structured Group (where yy = DO, FOR, IF, MON, SL, or SR)
EVAL Evaluate expression
EVALR Evaluate expression and right adjust result
EXCEPT Perform Exception Output
EXFMT Write/Then Read Format from display
EXSR Execute Subroutine
FEOD Force End of Data
FOR For
FORCE Force specified file to be read on next Cycle
IF If
IN Retrieve a Data Area
ITER Iterate
LEAVE Leave a Do/For Group
LEAVESR Leave a Subroutine
MONITOR Begin a Monitor Group
NEXT Next
ON-ERROR Specify errors to handle within MONITOR group
OPEN Open File for Processing
OTHER Start of default processing for SELECT group
OUT Write Data Area
POST Post
READ Read a record
READC Read next changed record
READE Read next record with equal Key
READP Read prior record
READPE Read prior record with equal Key
REL Release
RESET Reset
RETURN Return to Caller
ROLBK Roll Back uncommitted database changes
SELECT Begin a Select Group
SETGT Position database to record with key greater than specified key
SETLL Position database to record with key not greater than specified key
SORTA Sort an Array
TEST Test Date/Time/Timestamp
UNLOCK Unlock a Data Area or Release a Record
UPDATE Modify Existing Record
WHEN Condition test within SELECT group
WRITE Write New Record
Simple Example download text file
D*
D* Program Info
D*
D SDS
D @PGM 001 010
D @PARMS 037 039 0
D @JOB 244 253
D @USER 254 263
D @JOB# 264 269 0
D*
D* Constants
D*
D CMP01 C CONST(01)
D Digits C CONST('0123456789')
D*
D* Field Definitions.
D*
D ISOdate S D
D DateIn S D Datfmt(*MDY)
D Year S 4 0
D Month S 2 0
D Day S 2 0
D FromISO S D
D ToISO S D
D DiffDays S 3 0
D WorkField S 5 0
D Name S 9 Based(NamePtr)
D Name2 S 9
D NamePtr S * Inz(%ADDR(Names))
D Names S 63 Inz('Sunday Monday Tuesday Wedn+
D esdayThursday Friday Saturday ')
C*======================================================
C*
/Free
DateIn = %Date() ;
ISODate = %Date() ;
ISODate = DateIn ;
Year = %Subdt(ISODate:*Y) ;
Month = %Subdt(ISODate:*M) ;
Day = %Subdt(ISODate:*D) ;
FromISO = ISODate - %YEARS(1) ;
ToISO = ISODate ;
DiffDays = %Diff(ToISO:FromISO:*DAYS) ;
ISODate = DateIn ;
WorkField = %Diff(ISODate:D'1899-12-31':*DAYS);
WorkField = %REM(WorkField:7);
NamePtr = NamePtr + (WorkField * 9);
Name2 = Name;
*Inlr = *On ;
/End-Free
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C* *Inzsr - Initial one time run subroutine.
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
CSR *Inzsr Begsr
C*
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C* Read entire file free format
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
/free
// Loop through all records of file
read file;
dow not %eof(file); // Process until end of file
if %error;
dsply 'Read error: process aborting.';
leave;
else;
pos = %scan (',': name);
if pos > 0;
firstname = %trimr(%subst(name:1:pos-1));
update file;
endif;
read file;
enddo;
/end-free
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C* Free format keylist processing
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
V5R2
// The ProductKeys DS will contain the fields that make up the
// key for the Product File (Division, Part No & Version)
<1> D ProductKeys DS LikeRec(ProductRec : *Key)
// Read specified record using full key
<2> Chain %KDS(ProductKeys) ProductRec;
// Position file using first 2 key fields
<3> SetLL %KDS(ProductKeys : 2 ) ProductRec;
// Read using specified keys
<4> Chain (Division : PartNumber : Version) ProductRec;
// Position file based on first 2 key fields
<5> SetLL (Division : PartNumber) ProductRec;
// Position file to specified Part number in Division 99
<6> SetLL ( '99' : PartNumber) ProductRec;
// Update only the Cost and UnitPrice fields
<7> Update Products %Fields( UnitCost : UnitPrice );
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C* Free format call a prototype
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
/FREE
READ somefile;
DOW Not %EOF(somefile);
RecordCount = RecordCount + 1;
If Hours <= 37.5;
Pay = Hours * Rate;
Else;
Eval(H) Pay = (37.5 * Rate) + ((Hours - 37.5)
* (Rate * 1.5));
EndIf;
// Concatenate first and last name
FLName = %TrimR(LName) + ', ' + FName;
//It’s a CALLP (Call with Prototype). The parentheses following the name may have
// been a clue, because that’s how parameters are specified on a CALLP statement.
Process_transaction();
If RecordCount = MaxPage;
Leave; // Max records reached so exit loop
Else;
READ somefile;
EndIf;
ENDDO; // Loop back if not EOF
/END-FREE
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C* Free format elseif process
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
/free
Dsply 'Display this message';
If Not %Eof(MyFile);
Read MyFile;
ElseIf RecordCount > *Zero;
ProcessTotals();
EndIf;
/end-free
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C* Free Format %dec and %decpos
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
d character1 S 5 inz('12345')
d character2 S 5 inz('1 3 5')
d character3 S 5 inz('1234w')
d signed S 5S 0 inz(12345)
d packed S 5 0
d*----------------------------------------------------------
/free
// assign characters '12345' to a packed numeric
packed = %dec(character1:5:0) ; // packed = 12345
// note in this example the blanks are ignored!
packed = %dec(character2:5:0) ; // packed = 135
/end-free
D signed s 7s 5 inz (73.73551)
D packed1 s 7p 5
D packed2 s 7p 5
/FREE
packed1 = %dec(signed:5:2); // result is 73.73000
packed2 = %dech(signed:5:2); // result is 73.74000
*inLR = *ON ;
/END-FREE
D packed1 s 7p 3 inz (8236.567)
D signed1 s 9s 5 inz (23.73442)
D result1 s 5i 0
D result2 s 5i 0
/FREE
result1 = %decpos (packed1); // "result1" is 3
result2 = %decpos (signed1); // "result2" is 5
*inLR = *ON;
/END-FREE
D arr1d S 20 DIM(10)
D table S 10 DIM(20) ctdata
D mds DS 20 occurs(30)
D num S 5p 0
* like_array will be defined with a dimension of 10.
* array_dims will be defined with a value of 10.
D like_array S like(arr1d) dim(%elem(arr1d))
D array_dims C const (%elem (arr1d))
/free
num = %elem (arr1d); // num is now 10 ;
num = %elem (table); // num is now 20 ;
num = %elem (mds); // num is now 30 ;
Eval *inlr = *on ;
/end-free
// assign signed to a packed numeric
packed = %dec(signed) ;
// nice try - an alpha here will crash the program
packed = %dec(character3:5:0) ; // *CRASH*
*inlr = *on ;
/end-free
Examples posted by visitors
Posted by: jamie - move data in and out of an array
| eval xx_cnfn = *blanks;
eval xx_cnln = *blanks;
idx1 = %scan(' ' : AuthName);
if %subst(AuthName : idx1 + 2 : 1) = '.';
eval idx2 = idx1 + 4;
else;
if %subst(AuthName : idx1 + 2 : 1) <> *blank;
eval idx2 = idx1 + 1;
else;
eval idx2 = idx1 + 3;
endif;
endif;
eval fNameLen = idx2 - 1;
if fNameLen > 10;
eval fNameLen = 10;
endif;
eval lNameLen = (40 - idx2) + 1;
if lNameLen > 25;
eval lNameLen = 25;
endif;
eval xx_cnfn = %subst(AuthName : 1 : fNameLen);
eval xx_cnln = %subst(AuthName : idx2 : lNameLen);
|
|
|
Posted by: Jimmy - Read a file
| /free
DailyTotal = 0;
setll (MyDate) INVHEADER;
reade (MyDate) INVHEADER;
dow not %EOF(INVHEADER);
InvTotal = 0;
setll (InvDate: InvNo) INVDETAILS;
reade (InvDate: InvNo) INVDETAILS;
dow not %EOF(INVDETAILS);
InvTotal += Price * Qty;
reade (InvDate: InvNo) INVDETAILS;
enddo;
InvTotal -= Discounts;
InvTotal += Taxes;
DailyTotal += InvTotal;
reade (MyDate) INVHEADER;
enddo;
/end-free
|
|
|
Posted by: mike noun - Get the remainder of a division
| It's often useful to be able to get the remainder of a division
operation. For example, if you want to know the remainder of X divided
by Y, you'd traditionally code the following:
C X DIV Y UNUSED
C MVR R
With the %REM() BIF, you no longer need to do division first -- and
you no longer need to define a variable that you don't need elsewhere.
You can simply code this:
R = %REM(X : Y);
|
|
|
Posted by: chris hayden - Sample Free program
| // jobdat 8,0, jobtim 6,0
jobdat = %Uns( %Char( %Date( timeStamp ) : *ISO0 ) );
jobtim = %Uns( %Char( %Time( timeStamp ) : *HMS0 ) );
// convert character to numeric
dtseq = %Int(PDTSEQ);
// convert numeric to character
Rhdate = %Char(Rhjdt@);
// no more key lists
Setll (wrkCorp#: wrkCo#: wrkCust#) Arlcsmst;
Reade (wrkCorp#: wrkCo#: wrkCust#) Arlcsmst;
Chain (wrkCorp# : wkrCo# : wrkCust# ) Arlcsmst;
// get todays date
Date8s0 = %Uns(%Char(%Date():*ISO0));
Date8a0 = %Char(%Date():*USA0);
// TodaysDate defined as a "D" field
ToDaysDate = %Date();
BirthDate = %DATE(BirthYMD:*USA);
DaysOld = %DIFF(Today:BirthDate:*DAYS);
DaysOld = %DIFF(%DATE() :
%DATE(BirthYMD:*USA) :
*DAYS);
DueDate = InvDate + %DAYS(30);
//convert a date back to a character field
DateCharacter = %CHAR(Date:*ISO0);
DateNumeric = %UNS(%CHAR(Date:*ISO0));
// retrieve the month
MM = %SubDt(SomeDate : *Months);
// check the month
If %SubDt(SomeDate : *Months) = ReportMonth;
// scan for string, check result
If %Scan(SomeSrch : SomeString) > 0;
// thetimenow defined as a "T" field
TheTimeNow = %Time();
// Assuming the 8.0 Field is to be in YYYYMMDD Format:
// Assuming the 6.0 Field is to be in HHMMSS Format:
YYYYMMDD = %Int( %Char( ToDaysDate : *ISO0 ) );
HHMMSS = %Int( %Char( TheTimeNow : *HMS0 ) );
// You Need V5R2 to use %uns
YYYYMMDD = %uns( %char( %date : *ISO0 ) );
HHMMSS = %uns( %char( %time : *HMS0 ) );
Eval DueDate = LoanDate + %Years(YY) +
%Months(MM) +
%Days(DD);
OutDate = DueDate - %Days( 14 );
EndTime = StrTime + %Hours( 8 );
NbrDays = %Diff( DueDate : OutDate : *Days )
NbrHrs = %Diff( EndTime : StrTime : *Hours )
BirthYear = %SubDt( BirthDate : *Years );
CurHour = %SubDt( CurTime : *Hours );
SomeTimestamp = %Timestamp( CharTimestamp );
SomeDate = %Date( CharDate : *MDY0 )
SomeTime = %Time( CharTime : *USA )
ISODueDt = %Date( EurDueDt : *Eur ) ;
ISODate = %Date( NumericDate ) + %Days( 5 ) ;
YYYY = %SubDt( ISODate : *Years ) ;
MM = %SubDt( ISODate : *Months ) ;
DD = %SubDt( ISODate : *Days ) ;
count += 1; // increment count by 1
count -= 5; // decrement count
count *= (a+b); // multiply count by (a+b)
count /= 17; // divide count by 17
count **= 3; // cube the count
string += 'QED.'; // append to the end of string
ptr += %len(var); // increment pointer
date += %years(2) + %months(5) - %days(17);
// using procedures in expressions
if MyFunc1(string1) = %trim (MyFunc2(string2));
%subst(X(3))= MyFunc3('abc');
endif;
//only update certain fields available v5r2
UPDATE EmpRec %FIELDS(Salary:Status);
// no more EVAL
dataBaseField = screenField;
*inlr = *On;
// no more CALLP
$CopyNotes( Scr_OrgOrd : Scr_Ord# );
// julian dates
LongJulA = %Char(%Date(DMY:*DMY):*LongJul0) ;
// qualified data structure
Price = OrderDetail.Part.Cost;
// qualified data structure with arrays
price = Order(I+17). ItemList(p). Part. Cost;
// get the number of elements in the array
ArraySize = %elem (Array);
// convert string to decimal with positions
number = %dec(string:7:2);
// for loops
For Index = StartVal To EndVal By IncVal;
ExSr Process;
EndFor;
For Counter = 1 To NbrLoops;
ExSr Process;
EndFor;
// Monitor for Errors
Monitor;
Dou %EOF(TimeRecord);
Read TimeRecord;
If %EOF(TimeRecord);
Leave;
Else;
TotalPay = (RegHours * Rate)
+ (OvtHours * Rate * 1.5)
+ (DblHours * Rate * 2);
Update TimeRecord;
Endif;
Enddo;
On-error 1218; // Record locked
Dsply 'TimeRecord record locked.';
Leave;
On-error 1011:1211:*FILE; // File error
Dsply 'Unexpected file error occurred.';
Leave;
On-error *PROGRAM; // Non-file error
Dsply 'Unexpected program error occurred.';
Leave;
Endmon;
// Error Extension
Chain(E) SlcKey Master;
Select;
When %Error;
MasterIOErr();
When Not %Found( Master );
MasterNFnd();
Other;
ProcMaster();
EndSl;
// divide and remainder
quote = %div( total : count );
remain = %rem( total : count );
msg = 'total divided by count = ' +
%char(quote) + ' remainder ' +
%char(remain); |
|
|
Posted by: using /FREE to access Iseries Tables
| // The myFileDs DS will contain the three fields that
// make up the key for myFile
d myFileDs DS likeRec(myFileRec : *Key)
// Alternative method that I like more
d myFileDs E DS extname(myFile : *Key)
/Free
// Position based on first 2 key fields only
// I prefer this method, it leans most against the old klist method
myFileDs.keyField1 = 'value';
myFileDs.keyField2 = 'value';
setll %kds(myFileDs : 2 ) myFile;
reade %kds(myFileDs : 2 ) myFile;
// Same thing but specifying the list of fields "by hand",
// only type must be identical, length is converted
// in the way like the EVAL opcode does.
SetLL ( value : getValue() ) myFile;
SetLL ( value : 'ABC' ) myFile;
SetLL *START myFile; |
|
|
Posted by: jimmy octane/reading a file
| /Free
Dou %EOF(TimeRecord); // Process all time records
Read(e) TimeRecord; // Get next time record
Select;
When %EOF(TimeRecord);
Leave;
When %ERROR;
Dsply 'Error reading time records.';
Leave;
Other;
Chain(ne) EmployeeID Employees;
Select;
When %ERROR;
Dsply 'Error reading employees.';
Leave;
When not %FOUND;
Dsply 'Employee not found.';
Iter;
Endsl;
TotalPay = (RegHours * Rate)
+ (OvtHours * Rate * 1.5)
+ (DblHours * Rate * 2);
FedTax = CalcTaxes('FED':EmployeeID:TotalPay);
FICATax = CalcTaxes('FICA':EmployeeID:TotalPay);
StateTax = CalcTaxes(EmpState:EmployeeID:TotalPay);
UpdateTimeRecord();
Endsl;
Enddo;
*INLR = *ON;
Return;
/End-Free
|
|
|
Posted by: Use monitor to test numeric in Free form
| monitor;
myNumFld = %dec(myCharFld: 7: 2);
on-error;
myNumFld = 0;
msg = 'Invalid number! Try again';
endmon; |
|
|
Posted by: Jimmy - Test date in free form
| TempDate = %subst(s2NewOvr:1:8);
test(de) *usa0 TempDate;
|
|
|
Posted by: Another keylist example with data structure
| Assume a keyed data file ARTRANSACT, record name ARRECORD, has key fields
ARcompany, ARcustomer, and ARinvoice, and many other non-key fields.
FARTRANSACT IF E K DISK
*
D KeyStruct DS LikeRec(ARRECORD:*KEY)
*
/free
. . .
KeyStruct.ARcompany = ScreenComp;
KeyStruct.ARcustomer = ScreenCust;
Setll %kds(KeyStruct:2) ARTRANSACT; // Set file-ptr
Dou %eof(ARTRANSACT); // Loop through invoices
ReadE %kds(KeyStruct:2) ARTRANSACT;
If not %eof(ARTRANSACT);
// Process an invoice for this Company/Cust group
Endif;
Enddo;
. . .
The above example picks up company and customer number values from another
file, possibly a display device file, and puts them in the appropriate
qualified data structure subfields. Now, the key data structure can be used on
the SETLL, READE, or other operations. A partial key is used in this example
to access all invoices for a specified company and customer.
|
|
|
Posted by: Martin Hillier / half adjust in free form
| Question:
When doing a divide in freeform, how do I use half-adjust?
Answer:
Try the %INTH or %DECH Bifs
ie,
x=%INTH(5/3);
Here x will be 2 |
|
|
Posted by: /Free Overflow:
| FKCG700PR O E PRINTER OFLIN (Overflow)
If Overflow;
Exsr WriteHeadings;
Overflow = *Off;
EndIf;
|
|
|
Posted by: /Free Test date
| test(de) *iso0 khsdat;
if %error;
exsr WriteError;
endif;
|
|
|
Posted by: /Free Test Time
| @Timex = %subst(timey:1:2) + ':' +
%subst(timey:3:2) + ':' + '00';
test(et) *hms @timex;
if %error;
exsr WriteError;
endif;
|
|
|
Posted by: / Free Check parameters
| if %parms < 4;
*inlr = *on;
return;
endif;
|
|
|
Posted by: chris hayden - really long procedure names
| D generalInformation...
D Pr
D programmerInformation...
D Pr
// write general information
generalInformation();
// write programmer information
programmerInformation();
***********************************
* write programmer information
***********************************
P programmerInformation...
P B
d programmerInformation...
d Pi
P programmerInformation...
P E
|
|
|
Posted by: Gurmeet Singh/built-in function : %replace/%check/
| var1 have value as '1 '.
following code will give the result in var2 as '00001'.
eg: if var1 = '123 ' then var2 will be equal to '00123'.
dvar1 s 5a inz('1 ')
dvar2 s 5a inz('00000')
dvar3 s 5 0
dvar4 s 5a
/free
var3 = %dec(var1:5:0) ;
evalr var4 = %char(var3) ;
var2 = %replace(%triml(var4):var2:%check(' ':var4)) ;
dsply var2 ;
*inlr = *on ;
/end-free |
|
|
Posted by: Suresh Babu - SBG - Muscat -Oman
| Free Formated sub routine. Using database chain, calculation,
Using Setll,Reade, Update file, Print record etc..
*==================================================================*
/free
BegSr Subr30;
//Chain With Accessory Fitment Header file to check the record status
Chain (P#VIN:P#FRAN) VhlAfvh10;
If %found(VhlAfvh10);
If AfhStts <>'P';
//Creating Rec order
ExSr Subr41;
ExSr Subr42;
EndIf;
Else;
Return;
EndIf;
//Dow while VIN/Fran are same
Setll (P#VIN:P#Fran) VHLAFVD10;
Reade (P#VIN:P#Fran) VHLAFVD10;
Dow Not %Eof(VhlAfVd10);
//Omit Cancelled
If AFDSTTS ='C';
Reade (P#VIN:P#Fran) VHLAFVD10;
iter;
Endif;
//If Processed then skip
If AFDSTTS ='P';
Reade (P#VIN:P#Fran) VHLAFVD10;
iter;
Endif;
If Afditty <> 'L';
Reade (P#VIN:P#Fran) VHLAFVD10;
iter;
Endif;
// Spec code/Spec description /spec code/fitment status
RrSpDs = AfDsPdS;
RrSpCd = AfdSpCd;
RrSts = Afdftst;
WsRecCnt = WsRecCnt+1;
If WsRecCnt = 1;
Chain (P#VIN) VhlSto36;
If %found(VhlSto36);
// Check Work order no is not generated; then get no
// from paramater file
Chain (P#VIN) VhlStkExt1;
If %found(VhlStkExt1);
//If SteWoNo <=0;
If W1Wono = 0;
//Get Work Order No.from Parameter file and Update
Chain (StFran:StBrCd:StYdCd:'WORD') VhlVprm1;
if %found(VhlVpRm1);
VpDoNo = VpDoNo+1;
WsWoPx = VpDoPx;
WsWoNo = VpDoNo;
Update RfVpRm;
Chain (StFran:StBrCd:StYdCd) Vhlafbr1;
if %found(Vhlafbr1);
WsWoFr = Afbsefr;
WsWoBr = AfBsebr;
WsWoPx = AfBwopx;
Endif;
// Update Work order no into stock file
SteWobr = WsWoBr;
SteWoPx = WsWoPx;
SteWoNo = WsWoNo;
SteWoDt = WsTmstamp;
WsIso = %date(SteWodt);
WsWoDt = WsIso;
Update RfStkExt;
// Update Work order no in Accessory fitment file le
// and Create New record into VHFAFVW file
ExSr Subr44;
//%Found(VhlVprm1)
Endif;
//SteWono<=0
//W1Wono=0
Else;
WsWoBr = SteWoBr;
WsWoPx = SteWoPx;
WsWoNo = SteWoNo;
WsIso = %date(SteWodt);
WsWoDt = WsIso;
// Update Work order no in Accessory fitment file le
ExSr Subr45;
//W1Wono=0
Endif;
//%found(VhlStkExt1)
Endif;
Chain (StFran:'FRAN':STFRAN) VhlCode1;
Chain (StFran:StMocd:StChcd:StMoyr) VhlModl1;
If %found(VhlModl1);
RrMoDs = %trim(cddesl) +' - ' +%trim(MmMoDs);
Endif;
Chain (StFran:WsClTy:StCeCd) VhlClr1;
If %found(VhlClr1);
RrClDs = CoClDs;
Endif;
RrVin=StVin;
RrWoNo =%trim(StFran)+'/'+
%trim(%Editc(WsWoBr:'4')) +'/'+
%trim(WsWoPx)+'/'+ %trim(%Editc(WsWoNo:'4'));
//Subr40 to get Work order date
ExSr Subr40;
// Print details
Write RrVm0121;
//%found(VhlSto36)
Endif;
//WsRecCnt = 1
Endif;
Write RrVm0122;
Reade (P#VIN:P#Fran) Vhlafvd10;
//Not %Eof(VhlAfVd10)
EndDo;
//Subr30
EndSr;
/End-Free
|
|
|
Posted by: Ajay Nayakal
| If we are having width > 200 of Printer File. Then Use Following Parameters to
compile the Printer File.
a) Width=215 (or whatever the width is)
b) Length=96
c) LPI=12
d) CPI=15
e) OF=88
f) FONT = try first with *CPI and then with font 281
g) PAGRTT=*AUTO
h) UOM=*INCH
|
|
|
Post your Free Format RPG Source
(must enter name and example to post)
|
