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:

A menudo es útil poder obtener el resto de una división

operación. Por ejemplo, si quiere saber el resto de X dividido

por Y, tradicionalmente codificaría lo siguiente:

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:

Con% REM () BIF, ya no es necesario hacer divisiones primero, y ya no es necesario definir una variable que no necesite en otro lugar. Usted puede simplemente codificar esto:

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

convertir una fecha a un campo de carácter

DateCharacter = %CHAR(Date:*ISO0);

DateNumeric = %UNS(%CHAR(Date:*ISO0));

// retrieve the month recuperar el mes

MM = %SubDt(SomeDate : *Months);

// check the month verificar el mes

If %SubDt(SomeDate : *Months) = ReportMonth;

// scan for string, check result escanee la cuerda, compruebe el resultado

If %Scan(SomeSrch : SomeString) > 0;

// thetimenow defined as a "T" field thetimenow definido como un campo "T"

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 usando procedimientos en expresiones

if MyFunc1(string1) = %trim (MyFunc2(string2));

%subst(X(3))= MyFunc3('abc');

endif;

//only update certain fields available v5r2 solo actualice ciertos campos disponibles v5r2

UPDATE EmpRec %FIELDS(Salary:Status);

// no more EVAL no más EVAL

dataBaseField = screenField;

*inlr = *On;

// no more CALLP no más CALLP

$CopyNotes( Scr_OrgOrd : Scr_Ord# );

// julian dates fechas julianas

LongJulA = %Char(%Date(DMY:*DMY):*LongJul0) ;

// qualified data structure estructura de datos calificada

Price = OrderDetail.Part.Cost;

// qualified data structure with arrays estructura de datos calificados con matrices

price = Order(I+17). ItemList(p). Part. Cost;

// get the number of elements in the array obtener la cantidad de elementos en la matriz

ArraySize = %elem (Array);

// convert string to decimal with positions convertir cadena a decimal con posiciones

number = %dec(string:7:2);

// for loops para bucles

For Index = StartVal To EndVal By IncVal;

ExSr Process;

EndFor;

For Counter = 1 To NbrLoops;

ExSr Process;

EndFor;

// Monitor for Errors Monitor para errores

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 Registro bloqueado

Dsply 'TimeRecord record locked.';

Leave;

On-error 1011:1211:*FILE; // File error error de archivo

Dsply 'Unexpected file error occurred.';

Leave;

On-error *PROGRAM; // Non-file error Error sin archivo

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 dividir y resto

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 MyFileDs DS contendrá los tres campos que componen la clave para myFile

d myFileDs DS likeRec(myFileRec : *Key)

// Alternative method that I like more Método alternativo que me gusta más

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 Posición basada en los primeros 2 campos clave solo

  Prefiero este método, se inclina más contra el viejo método klist

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. Lo mismo pero especificando la lista de campos "a mano",

 solo el tipo debe ser idéntico, la longitud se convierte

 en la forma en que lo hace el opcode EVAL.

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. Supongamos que un archivo de datos con clave ARTRANSACT, nombre de registro ARRECORD, tiene campos clave

ARcompany, ARcustomer, y ARinvoice, y muchos otros campos no clave.

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.

El ejemplo anterior recoge valores de compañía y número de cliente de otro archivo, posiblemente un archivo de dispositivo de visualización, y los coloca en el archivo apropiado

subcampos de estructura de datos calificados. Ahora, la estructura de datos clave se puede usar en

SETLL, READE u otras operaciones. Una clave parcial se usa en este ejemplo para acceder a todas las facturas de una empresa y un cliente especificados.

     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'.

El siguiente código dará el resultado en var2 como '00001'.

por ejemplo: si var1 = '123' entonces var2 será igual a '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..

Sub rutina libre formateada. Usando la cadena de la base de datos, cálculo,Usando Setll, Reade, Update file, Print record, etc.

*==================================================================*

/free

BegSr Subr30;

//Chain With Accessory Fitment Header file to check the record status Cadena con archivo de encabezado de equipamiento accesorio para verificar el estado del registro

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.

Si tenemos ancho> 200 de archivo de impresora. Luego use los siguientes parámetros para compilar el archivo de impresora.

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