HLI: IFAM1 job program examples

From m204wiki
Revision as of 21:40, 2 May 2016 by ELowell (talk | contribs)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search

Overview

This topic provides examples of IFAM1 jobs, complete with program code. The sample programs illustrate the use of Host Language Interface functions in an IFAM1 processing environment.

For more information

See HLI: IFAM2/IFAM4 job program examples for additional examples of HLI applications written in COBOL and job setups that can be run in IFAM2 and IFAM4. That topic includes an example of an application that uses a multiple cursor IFSTRT thread.

See HLI: Coding conventions for guidelines on using different programming languages when coding HLI programs. See other HLI topics for coding examples related to particular aspects of HLI processing.

COBOL example

This section provides a sample program written in COBOL to run in the IFAM1 environment under VSE or CMS using the Model 204 Host Language Interface.

The sample COBOL program that is shown in Sample COBOL program (VSE) can be run as shown with the application code embedded in the VSE job stream.

Or, the program can be extracted from the VSE JCL and compiled and linked as program IFAM1PG and then run in CMS using the EXECs shown in Sample EXEC to run an IFAM1 program (CMS) and Example of FILES EXEC for IFAM1 program (CMS).

Using a vehicles file

The IFAM1 COBOL application program accesses a file that contains vehicle data (a Model 204 data file named VEHICLES) and uses the information to produce a report of high risk vehicles.

IFAM1 COBOL example (VSE)

The following example is an HLI application program that is written for IFAM1 in COBOL which, with the JCL that is shown in the job stream, runs under a VSE operating system.

This application uses a single cursor IFSTRT thread.

Sample COBOL program (VSE)

* ************************************************************* * * * This example COBOL job compiles and catalogs an IFAM1 * * program into a user's private library and * * is based on the following assumptions: * * * * (1) All Model 204 distribution macros, object modules, etc. * * are in the M204 library as distributed by Rocket; * * * * (2) All IBM distributed libraries (such as standard macros, * * COBOL compiler, link-time modules, etc.) are defined in * * your permanent library search sequence; * * * * (3) You have a private library for in-house developed * * application programs (systems). * * * * ************************************************************* * $$ JOB ... . . . // JOB CATALOG IFAM1 PROGRAM (WRITTEN IN COBOL) // DLBL M204LIB, 'M204.PROD.LIBRARY' // EXTENT SYSnnn,......balance of the EXTENT statement // DLBL USERLIB,'user.applic.system.library' // EXTENT SYSnnn,....balance of the EXTENT statement // LIBDEF *,SEARCH=(M204LIB.V220,USERLIB.sublib) // LIBDEF PHASE,CATALOG=(USERLIB.sublib) // OPTION CATAL PHASE IFiPGM,* REPLACE=YES // EXEC FCOBOL,SIZE=(160K) *************************************************************** * * * THIS IS A SAMPLE IFAM1 COBOL PROGRAM. * * * * THIS COBOL PROGRAM USES IFAM1 CALLS. * * IT PRODUCES A REPORT OF HIGH RISK VEHICLES. IT ALSO * * CHANGES THE SURCHARGE% ON CERTAIN HIGH RISK * * VEHICLES TO 15%. * * * * * *************************************************************** IDENTIFICATION DIVISION. PROGRAM-ID. IFAM1EX1. AUTHOR. JANE DOE. DATE-WRITTEN. MAY 15, 1990. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT REPORT-FILE ASSIGN TO UT-S-REPORT. DATA DIVISION. FILE SECTION. FD REPORT-FILE LABEL RECORDS ARE OMITTED BLOCK CONTAINS 0 RECORDS DATA RECORD IS REPORT-RECORD. 01 REPORT-RECORD PIC X(133). WORKING-STORAGE SECTION. 01 CRITICAL-ERROR-SW PIC X(3) VALUE "NO ". 88 NO-CRITICAL-ERROR VALUE "NO ". 88 CRITICAL-ERROR VALUE "YES". 01 DONE-PROCESS-SW PIC X(3) VALUE "NO ". 88 DONE-PROCESS VALUE "YES". 01 ERROR-FUNCTION PIC X(8). 01 DISPLAY-STATUS-IND PIC 9(5) VALUE ZERO. 01 WS-OUTPUT-REPORT-LINE. 05 WS-CCTL-CHAR PIC X. 05 WS-132-CHAR-LINE PIC X(132) VALUE SPACES. 01 WS-LINE-COUNT PIC 99 VALUE ZERO. 01 NEW-SURCHARGE PIC X(2) VALUE "15". 01 M204-INTEGER-CALL-ARGS COMP SYNC. 05 STATUS-IND PIC 9(5). 05 LANGUAGE-IND PIC 9(5) VALUE 2. 05 UPDATE-IND PIC 9(5) VALUE 0. 05 FIND-COUNT PIC 9(5). 01 M204-STRING-CALL-ARGS. 05 EXEC-PARMS. 10 FILLER PIC X(7) VALUE "SYSOPT=". 10 INPUT-SYSOPT PIC X(3). 10 FILLER PIC X VALUE ";". 05 USER0-PARMS. 10 FILLER PIC X(7) VALUE "MAXBUF=". 10 INPUT-MAXBUF PIC X(3). 10 FILLER PIC X(8) VALUE ",MINBUF=". 10 INPUT-MINBUF PIC X(3). 10 FILLER PIC X(8) VALUE ",SPCORE=". 10 INPUT-SPCORE PIC X(5). 10 FILLER PIC X(8) VALUE ",LAUDIT=". 10 INPUT-LAUDIT PIC X(1). 10 FILLER PIC X VALUE ";". 05 LOGIN PIC X(20) VALUE "SUPERKLUGE;PIGFLOUR;". 05 VEHICLE-FILE PIC X(8) VALUE "VEHICLES;". 05 FIND-CRITERIA PIC X(41) VALUE "VEHICLE USE CLASS IS GREATER THAN 79;END;". 05 GET-EDIT-SPEC. 10 FILLER PIC X(45) VALUE "EDIT(VEHICLE USE CLASS,VIN,OWNER POLICY,MAKE,". 10 FILLER PIC X(43) VALUE "MODEL,BODY,YEAR,SURCHARGE%)(X(7),J(2),X(8),". 10 FILLER PIC X(43) VALUE "A(12),X(6),A(6),X(6),A(15),X(3),A(15),X(3),". 10 FILLER PIC X(26) VALUE "A(4),X(4),A(2),X(8),J(2));". 05 M204-ERR-MESSAGE PIC X(80). 05 PUT-EDIT-SPEC PIC X(23) VALUE "EDIT(SURCHARGE%)(Z(2));". 05 PUTNAME PIC X(8) VALUE "PUTNAME;". 05 GETNAME PIC X(8) VALUE "GETNAME;". 01 REPORT-OUTPUT-DETAIL. 05 FILLER PIC X(7). 05 USE-CLASS PIC X(2). 05 FILLER PIC X(8). 05 VIN PIC X(12). 05 FILLER PIC X(6). 05 OWNER-POLICY PIC X(6). 05 FILLER PIC X(6). 05 MAKE PIC X(15). 05 FILLER PIC X(3). 05 MODEL PIC X(15). 05 FILLER PIC X(3). 05 BODY PIC X(4). 05 FILLER PIC X(4). 05 YEAR PIC X(2). 05 FILLER PIC X(8). 05 SURCHARGE PIC X(2). 05 FILLER PIC X(28) VALUE SPACES. 01 REPORT-HEADING-AREA. 05 FILLER PIC X(40) VALUE SPACES. 05 FILLER PIC X(46) VALUE "HIGH RISK VEHICLES - INCLUDING NEW SURCHARGE %". 05 FILLER PIC X(46) VALUE SPACES. 01 REPORT-DETAIL-HEADING. 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(12) VALUE "USE CLASS ". 05 FILLER PIC X(16) VALUE " V I N ". 05 FILLER PIC X(15) VALUE "OWNER POLICY ". 05 FILLER PIC X(18) VALUE " MAKE ". 05 FILLER PIC X(20) VALUE " MODEL ". 05 FILLER PIC X(07) VALUE "BODY ". 05 FILLER PIC X(07) VALUE "YEAR ". 05 FILLER PIC X(10) VALUE "SURCHARGE%". 05 FILLER PIC X(25) VALUE SPACES. 01 WS-PARAMETER-INPUT. 05 PARAM-SYSOPT PIC X(3). 05 FILLER PIC X. 05 PARAM-MAXBUF PIC X(3). 05 FILLER PIC X. 05 PARAM-MINBUF PIC X(3). 05 FILLER PIC X. 05 PARAM-SPCORE PIC X(5). 05 FILLER PIC X. 05 PARAM-LAUDIT PIC X(1). PROCEDURE DIVISION. INITIALIZATION. OPEN OUTPUT REPORT-FILE. ACCEPT WS-PARAMETER-INPUT FROM SYSIPT. ************************************************************** * NOTE: PARAMETER INPUT MUST BE ENTERED IN THE FOLLOWING * * FORMAT IN THE INPUT-FILE: 999,999,999,99999,9 * * WHICH CORRESPONDS TO THE VALUES OF: * * SYSOPT,MAXBUF, MINBUF,SPCORE,LAUDIT * * ************************************************************* IF PARAM-SYSOPT NOT NUMERIC OR PARAM-SYSOPT > 186 DISPLAY "INVALID SYSOPT PARAMETER, DEFAULT OF 128 USED" MOVE "128" TO INPUT-SYSOPT ELSE MOVE PARAM-SYSOPT TO INPUT-SYSOPT. IF PARAM-MINBUF NOT NUMERIC OR PARAM-MINBUF < 003 DISPLAY "INVALID MINBUF PARAMETER, DEFAULT OF 3 USED" MOVE "003" TO INPUT-MINBUF ELSE MOVE PARAM-MINBUF TO INPUT-MINBUF. IF PARAM-MAXBUF NOT NUMERIC OR PARAM-MAXBUF < 003 DISPLAY "INVALID MAXBUF PARAMETER, DEFAULT OF 100 USED" MOVE "100" TO INPUT-MAXBUF ELSE MOVE PARAM-MAXBUF TO INPUT-MAXBUF. IF INPUT-MINBUF > INPUT-MAXBUF DISPLAY "MINBUF REQUESTED> MAXBUF, DEFAULT TO MAX=MIN". MOVE INPUT-MINBUF TO INPUT-MAXBUF. IF PARAM-SPCORE NOT NUMERIC DISPLAY "INVALID SPCORE PARAMETER, DEFAULT TO 8192" MOVE "08192" TO INPUT-SPCORE ELSE MOVE PARAM-SPCORE TO INPUT-SPCORE. IF PARAM-LAUDIT > 7 DISPLAY "INVALID LAUDIT PARAMETER, DEFAULT TO 7" MOVE "7" TO INPUT-LAUDIT ELSE MOVE PARAM-LAUDIT TO INPUT-LAUDIT. PERFORM NEW-PAGE. CALL "IFSTRT" USING STATUS-IND, LANGUAGE-IND, EXEC-PARMS, USER0-PARMS. IF STATUS-IND IS NOT EQUAL ZERO MOVE "IFSTRT " TO ERROR-FUNCTION PERFORM ERROR-ROUTINE ELSE CALL "IFLOG" USING STATUS-IND, LOGIN IF STATUS-IND IS NOT EQUAL ZERO MOVE "IFLOG " TO ERROR-FUNCTION PERFORM ERROR-ROUTINE ELSE CALL "IFOPEN" USING STATUS-IND, VEHICLE-FILE IF STATUS-IND IS NOT EQUAL ZERO AND STATUS-IND IS NOT EQUAL 16 AND STATUS-IND IS NOT EQUAL 32 MOVE "IFOPEN " TO ERROR-FUNCTION PERFORM ERROR-ROUTINE. FIND-RECORDS. IF CRITICAL-ERROR GO TO FIND-RECORDS-EXIT. * ************************************************************* * DO NOT ATTEMPT TO FIND THE RECORDS IN THE MODEL 204 FILE * * IF YOU PREVIOUSLY ENCOUNTERED AN ERROR WITH * * IFSTRT, IFLOG, OR IFOPEN. * * ************************************************************* CALL "IFFIND" USING STATUS-IND, FIND-CRITERIA. IF STATUS-IND NOT EQUAL ZERO MOVE "IFFIND " TO ERROR-FUNCTION PERFORM ERROR-ROUTINE ELSE CALL "IFCOUNT" USING STATUS-IND, FIND-COUNT IF STATUS-IND NOT EQUAL ZERO MOVE "IFCOUNT " TO ERROR-FUNCTION PERFORM ERROR-ROUTINE ELSE IF FIND-COUNT= ZERO MOVE "NO RECORDS FOUND" TO WS-132-CHAR-LINE WRITE REPORT-RECORD FROM WS-OUTPUT-REPORT-LINE MOVE "YES" TO DONE-PROCESS-SW. ************************************************************** * * * DO NOT ATTEMPT TO GET MODEL 204 RECORDS IF YOU * * ENCOUNTERED AN ERROR WITH IFFIND/IFCOUNT OR IF THERE * * WERE NO RECORDS FOUND (THAT IS, FIND-COUNT IS ZERO) * * * * THE DONE-PROCESS SWITCH WILL INDICATE WHEN ALL THE * * RECORDS IN THE "FOUND SET" HAVE BEEN PROCESSED. * * IF NO RECORDS WERE FOUND THEN THE DONE PROCESS * * SWITCH IS TO "YES" IMMEDIATELY AFTER IFCOUNT. * * * *************************************************************** PERFORM GET-AND-PROCESS-RECORDS UNTIL DONE-PROCESS OR CRITICAL-ERROR. FIND-RECORDS-EXIT. EXIT. TERMINATION. CLOSE REPORT-FILE. CALL "IFFNSH" USING STATUS-IND. IF STATUS-IND NOT EQUAL 1000 MOVE "IFFNSH " TO ERROR-FUNCTION PERFORM ERROR-ROUTINE. STOP RUN. GET-AND-PROCESS-RECORDS. CALL "IFGET" USING STATUS-IND, REPORT-OUTPUT-DETAIL, GET-EDIT-SPEC, GETNAME. IF STATUS-IND= 2 MOVE "YES" TO DONE-PROCESS-SW ELSE IF STATUS-IND NOT EQUAL ZERO MOVE "IFGET " TO ERROR-FUNCTION PERFORM ERROR-ROUTINE ELSE PERFORM REPORT-AND-UPDATE. REPORT-AND-UPDATE. IF USE-CLASS > 85 OR USE-CLASS = 85 MOVE NEW-SURCHARGE TO SURCHARGE CALL "IFPUT" USING STATUS-IND, SURCHARGE, PUT-EDIT-SPEC, PUTNAME IF STATUS-IND NOT EQUAL ZERO MOVE "IFPUT " TO ERROR-FUNCTION PERFORM ERROR-ROUTINE. IF WS-LINE-COUNT > 50 PERFORM NEW-PAGE. MOVE REPORT-OUTPUT-DETAIL TO WS-132-CHAR-LINE. WRITE REPORT-RECORD FROM WS-OUTPUT-REPORT-LINE. ADD 1 TO WS-LINE-COUNT. ERROR-ROUTINE. MOVE "YES" TO CRITICAL-ERROR-SW. ************************************************************** * THIS CRITICAL ERROR SWITCH IS SET IF THERE IS A BAD * * IFAM CALL TO MODEL 204. * ************************************************************** MOVE STATUS-IND TO DISPLAY-STATUS-IND. DISPLAY "CRITICAL ERROR ENCOUNTERED WITH FUNCTION: " ERROR-FUNCTION ", WITH A RETURN CODE OF: " DISPLAY-STATUS-IND. CALL "IFGERR" USING STATUS-IND M204-ERR-MESSAGE. DISPLAY "M204 ERROR MESSAGE= " M204-ERR-MESSAGE. NEW-PAGE. * MOVE "1" TO WS-CCTL-CHAR. MOVE REPORT-HEADING-AREA TO WS-132-CHAR-LINE. WRITE REPORT-RECORD FROM WS-OUTPUT-REPORT-LINE. * MOVE "0" TO WS-CCTL-CHAR. MOVE REPORT-DETAIL-HEADING TO WS-132-CHAR-LINE. WRITE REPORT-RECORD FROM WS-OUTPUT-REPORT-LINE. * MOVE " " TO WS-CCTL-CHAR. MOVE SPACES TO WS-132-CHAR-LINE. WRITE REPORT-RECORD FROM WS-OUTPUT-REPORT-LINE. MOVE ZEROS TO WS-LINE-COUNT. *************************************************************** * JOB STEP #2: LINK-EDIT THE PROGRAM * *************************************************************** /* INCLUDE IFIF1DOS ENTRY IFAMTEST // EXEC LNKEDT /& * ************************************************************* * JOB STEP #3: * * EXECUTE IFAM1 IF1PGM PROGRAM UNDER VSE * * RESULTS PRINTED IN REPORT ON SYSLST * * ************************************************************* // JOB IF1RUN // DLBL M204LIB, 'M204.PROD.LIBRARY' // EXTENT SYSnnn,......balance of the EXTENT statement // DLBL USERLIB,'user.applic.system.library' // EXTENT SYSnnn,....balance of the EXTENT statement * // DLBL CCAJRNL,'SQADOS.M204SYS.CCAJRNL',0 // EXTENT SYS021,SYSWK1,,,72470,2000 // DLBL CCASTAT,'SQADOS.M204SYS.CCASTAT',0 // EXTENT SYS024,SYSWK4,,,1059,100 // DLBL CCATEMP,'SQADOS.M204SYS.CCATEMP',,DA // EXTENT SYS021,SYSWK1,,,51330,2000 // DLBL VEHICLE,'PSGRAY.M204DB.VEHICLE',,DA // EXTENT SYS023,SYSWK3,,,68101,2600 // ASSGN SYS007,SYSLST // ASSGN SYS008,05E // EXEC IF1PGM,SIZE=(AUTO,60K) 144,010,010,10000,0 /* /& * $$ EOJ

IFAM1 COBOL example (CMS)

Sample EXEC to run an IFAM1 program (CMS) and Example of FILES EXEC for IFAM1 program (CMS) show sample EXECs that can be used to execute an HLI application program in the IFAM1 environment under CMS.

Note: These EXECs could be used with the COBOL program in Sample COBOL program (VSE), assuming that the program is compiled and linked as IFAM1PG.

The following figure shows an EXEC that generates an IFAM1 application module, IFAM1PG, running under CMS.

Sample EXEC to run an IFAM1 program (CMS)

&CONTROL ALL * * SAMPLE EXEC FOR GENERATING AN IFAM1 APPLICATION * * PROGRAM NAME= IFAM1PG * COBOL IFAM1PG * GLOBAL TXTLIB M204IFM1 COBOLVS COBLIBVS LOAD IFAM1PG IFCM1 ( RESET IFAM1PG ) GENMOD IFAM1PG * &TYPE &TYPE IFAM1PG MODULE A HAS BEEN GENERATED FOR YOUR USE &TYPE &EXIT &RETCODE

The following figure shows an EXEC that defines the files for the IFAM1PG program running under CMS, which is shown in "Sample EXEC to run an IFAM1 program (CMS)" above.

Example of FILES EXEC for IFAM1 program (CMS)

&TRACE ALL * * EXEC TO DEFINE FILES FOR IFAM1 JOB * &ERROR &EXIT &RETCODE FILEDEF * CLEAR * ACCESS XXX 121 DISK GETFMADR 250 &READ VARS & &XXX121M &XXX121D EXECIO 0 CP ( STRING LINK XXX 121 &XXX121D MW ACCESS &XXX121D &XXX121M * GET TEMP DISK SPACE FOR CCATEMP FILE GETFMADR 250 &READ VARS & &TEMPM &TEMPD EXECIO 0 CP (STRING DEFINE T3380 &TEMPD CYL 3 &IF &RETCODE NE 92 &IF &RETCODE NE 0 &EXIT &RETCODE &STACK LIFO YES M204UTIL INIT &TEMPD TEM204 ACCESS &TEMPD &TEMPM M204UTIL CREATE M204 CMS CCATEMP &TEMPM ( PRIMARY 40 TRK * DEFINE FILES USED BY IFAM1 APPLICATION PROGRAM & MODEL 204 FILEDEF CCAAUDIT DISK IFM1 CCAAUDIT A FILEDEF CCAPRINT DISK IFM1 CCAPRINT A FILEDEF CCASTAT &XXX121M DSN PSSOSMNT PROD CCASTAT M204 FILEDEF CCASNAP DISK IFM1 CCASNAP A FILEDEF CCATEMP &TEMPM DSN M204 CMS CCATEMP FILEDEF VEHICLES &XXX121M DSN PSSOSMNT TEST VEHICLES M204 FILEDEF REPORT DISK IFM1 REPORT A FILEDEF SYSIN DISK IFM1 SYSIN * FILEDEF SYSOUT DISK IFM1 SYSOUT A * STACK IFAM1 APPLICATION PROGRAM NAME &STACK IFAM1PG &EXIT &RETCODE


PL/I example

This section provides a sample program written in PL/I to run in the IFAM1 environment under z/OS using the Model 204 Host Language Interface. The sample PL/I program that is shown in Sample PL/I program (z/OS) can be run as shown with the application code embedded in the z/OS job stream.

Using a claims file

The IFAM1 PL/I application program accesses a file that contains insurance data (a Model 204 data file named CLAIMS90) and uses the information to determine the average settlement amount for all liability claims settled in the first half of 1990. Liability claims are indicated by the field name = value pair of CLAIM TYPE= L. The format of SETTLEMENT DATE is YYMMDD.

IFAM1 PL/I example (z/OS)

The following example is an HLI application program that is written for IFAM1 in PL/I which, with the JCL that is shown in the job stream, runs under an z/OS operating system.

This application uses a single cursor IFSTRT thread.

Sample PL/I program (z/OS)

//JOBNAME JOB ,'IFAM1 TEST',MSGCLASS=A,CLASS=A //PLI EXEC PGM=IEL0AA,PARM='OBJECT, NODECK',REGION=100K //SYSPRINT DD SYSOUT=* //SYSLIN DD DSN=&&LOADSET,DISP=(MOD,PASS),UNIT=SYSDA, // SPACE=(80,(250,100)) //SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA, // SPACE=(1024,(200,50),,CONTIG,ROUND), // DCB=BLKSIZE=1024 //SYSIN DD * //* /*-----------------------------------------------------*/ /* COMPUTE AVERAGE SETTLEMENT AMOUNT FOR LIABILITY */ /* CLAIMS SETTLED IN FIRST HALF OF 1990 */ /*-----------------------------------------------------*/ AVGSET: PROCEDURE OPTIONS (MAIN); /*-----------------------------------------------------*/ /* M204 HOST LANGUAGE INTERFACE (IFAM) CALLS */ /*-----------------------------------------------------*/ DECLARE IFSTRT EXT ENTRY (FIXED BIN(31), FIXED BIN(31), CHAR(*),CHAR(*)), IFLOG EXT ENTRY (FIXED BIN(31), CHAR(*)), IFOPEN EXT ENTRY (FIXED BIN(31), CHAR(*)), IFFIND EXT ENTRY (FIXED BIN(31), CHAR(*)), IFCOUNT EXT ENTRY (FIXED BIN(31), FIXED BIN(31)), IFGET EXT ENTRY (FIXED BIN(31), CHAR(*) VAR, CHAR(*)), IFGERR EXT ENTRY (FIXED BIN(31), CHAR(*) VAR), IFFNSH EXT ENTRY (FIXED BIN(31)); /*--------------------------------------------------*/ /* M204 CALL ARGUMENTS */ /*--------------------------------------------------*/ DECLARE IF_RET_CODE FIXED BIN(31), 01 IFSTRT_ARGS, 05 LANGUAGE CHAR(1) INIT ('3'), 05 EXEC_PARMS CHAR(255) VAR INIT ('SYSOPT=144'), 05 USER0_PARMS CHAR(255) VAR INIT ('SPCORE=10000,MINBUF=03,MAXBUF=10,LAUDIT=7'), 01 IFLOG_ARGS, 05 ACCOUNT_PSWD CHAR(255) VAR INIT ('JANE;JANEPSWD'), 01 IFOPEN_ARGS, 05 FILE_PSWD CHAR(255) VAR INIT ('CLAIMS90;'), 01 IFFIND_ARGS, 05 CRITERIA CHAR(255) VAR INIT ('SETTLEMENT DATE IS BEFORE 800631;CLAIM TYPE= L;END;'), 01 IFCOUNT_ARGS, 05 COUNT FIXED BIN(31), 01 IFGET_ARGS, 05 EDIT_BUFFER CHAR (255) VAR, 05 EDIT_SPEC CHAR (255) VAR INIT ('EDIT (SETTLEMENT AMOUNT) (J(6));'), 01 EDIT_BUFFER_ITEMS, 05 SETTLEMENT_AMOUNT PICTURE '999999', 01 IFGERR_ARGS, 05 MESSAGE CHAR(80) VAR; /*-----------------------------------------------------*/ /* OTHER DECLARATIONS */ /*-----------------------------------------------------*/ DECLARE M204_ERROR_AND_TERMINATION INTERNAL CONDITION, TOTAL_SETTLEMENT_AMOUNT FIXED BIN(31) INIT (0), AVERAGE_SETTLEMENT_AMOUNT FIXED BIN(31) INIT (0), I FIXED BIN(31), PLIRETC BUILTIN, YSPRINT FILE PRINT; /*-----------------------------------------------------*/ /* M204 ERROR HANDLING */ /* CONTROL IS TRANSFERRED HERE AFTER AN M204 ERROR FROM */ /* A CALL. */ /* CONTROL IS TRANSFERRED BY THIS ROUTINE TO THE */ /* PROGRAM'S END. */ /*-----------------------------------------------------*/ ON CONDITION (M204_ERROR_AND_TERMINATION) BEGIN; PUT SKIP(2) EDIT ('*** M204 ERROR. RETURN CODE= ', IF_RET_CODE)(A, F(6) ); CALL IFGERR (IF_RET_CODE, MESSAGE); PUT SKIP EDIT ('IFGERR MESSAGE= ', IFGERR_ARGS.MESSAGE) (A, A); CALL PLIRETC (999); GO TO TERMINATION; /* AT END OF PROGRAM */ END; /*-----------------------------------------------------*/ /* START M204 INTERFACE AND OPEN CLAIMS90 FILE */ /*-----------------------------------------------------*/ CALL IFSTRT (IF_RET_CODE,LANGUAGE, EXEC_PARMS, USER0_PARMS); IF (IF_RET_CODE ¬= 0) THEN DO; PUT DATA (IFSTRT_ARGS); SIGNAL CONDITION (M204_ERROR_AND_TERMINATION); END; CALL IFLOG (IF_RET_CODE, ACCOUNT_PSWD); IF (IF_RET_CODE ¬= 0) THEN DO; PUT DATA (IFLOG_ARGS); SIGNAL CONDITION (M204_ERROR_AND_TERMINATION); END; CALL IFOPEN (IF_RET_CODE, FILE_PSWD); IF ( ¬ (IF_RET_CODE = 0 | IF_RET_CODE= 16 ) ) THEN DO; PUT DATA (IFOPEN_ARGS); SIGNAL CONDITION (M204_ERROR_AND_TERMINATION); END; /*-----------------------------------------------------*/ /* RETRIEVE DATA AND COMPUTE AVERAGE SETTLEMENT CLAIM */ /*-----------------------------------------------------*/ CALL IFFIND (IF_RET_CODE, CRITERIA); IF (IF_RET_CODE ¬= 0) THEN DO; PUT DATA (IFFIND_ARGS); SIGNAL CONDITION (M204_ERROR_AND_TERMINATION); END; CALL IFCOUNT (IF_RET_CODE, COUNT); IF (IF_RET_CODE ¬= 0) THEN DO; PUT DATA (IFCOUNT_ARGS); SIGNAL CONDITION (M204_ERROR_AND_TERMINATION); END; IF COUNT= 0 THEN DO; PUT LIST ('NO RECORDS IN FOUND SET-CANNOT COMPUTE AVG'); GO TO TERMINATION; END; DO I = 1 TO COUNT; CALL IFGET (IF_RET_CODE, EDIT_BUFFER, EDIT_SPEC); IF (IF_RET_CODE ¬= 0) THEN DO; PUT DATA (IFGET_ARGS); SIGNAL CONDITION (M204_ERROR_AND_TERMINATION); END; EDIT_BUFFER_ITEMS= EDIT_BUFFER; TOTAL_SETTLEMENT_AMOUNT = TOTAL_SETTLEMENT_AMOUNT + EDIT_BUFFER_ITEMS.SETTLEMENT_AMOUNT; END; AVERAGE_SETTLEMENT_AMOUNT= TOTAL_SETTLEMENT_AMOUNT / IFCOUNT_ARGS.COUNT; PUT EDIT ('AVG SETTLEMENT AMOUNT FOR CLAIMS SETTLED BETWEEN ' || '01/01/90 AND 06/31/90 = ', AVERAGE_SETTLEMENT_AMOUNT) (A, F(6) ); /*-----------------------------------------------------*/ /* END OF PROGRAM - TERMINATION PROCESSING */ /*-----------------------------------------------------*/ /* FALL THROUGH TO THIS CODE IF NO M204 ERROR. BRANCH */ /* TO THIS CODE FROM M204_ERROR_AND_TERMINATION */ /* CONDITION IF THERE WAS AN M204 ERROR. */ /*-----------------------------------------------------*/ TERMINATION: CALL IFFNSH (IF_RET_CODE); IF (IF_RET_CODE ¬= 1000) THEN DO; PUT SKIP(2) EDIT ('*** M204 IFFNSH ERROR. RETURN CODE= ', IF_RET_CODE) (A, F(6) ); CALL IFGERR (IF_RET_CODE, MESSAGE); PUT SKIP EDIT ('IFGERR RETURN CODE=', IF_RET_CODE, 'MESSAGE= ', MESSAGE) (A, F(6), A, A); END; END; //LKED EXEC PGM=IEWL,PARM='RENT,LIST,LET,MAP, // COND=(9,LT,PLI) //SYSLIB DD DSN=SYS1,PLIBASE,DISP=SHR //SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA, - // SPACE=(1024,(200,20)), - // DCB=BLKSIZE=1024 //SYSLMOD DD DSN=LOCAL.M204.IFAM1.APPLIC,DISP=SHR //SYSPRINT DD SYSOUT=C //OB DD DSN=LOCAL.M204.OBJECT,DISP=SHR //SYSOUT DD SYSOUT=C //SYSLIN DD DSN=&&LOADSET,DISP=(OLD,DELETE), - // UNIT=SYSDA // DD DDNAME=SYSIN //SYSIN DD * INCLUDE OB(IFIF1OS) NAME IFAMTEST(R)

Run the IFAM1 PL/I application using the following JCL:

//RUNIFAM1 JOB ,'RUNIFAM1,MSGLEVEL=(1,1), - // MSGCLASS=C,CLASS=T //* //IFAM1 EXEC PGM=IFAMTEST //* //STEPLIB DD DSN=LOCAL.M204.IFAM1.APPLIC,DISP=SHR // DD DSN=LOCAL.M204.LOAD,DISP=SHR //CCAAUDIT DD SYSOUT=C //CCAPRINT DD SYSOUT=C //CCASNAP DD SYSOUT=C //SYSUDUMP DD SYSOUT=C //CCATEMP DD DISP=NEW,UNIT=SYSDA,SPACE=(TRK,20) //CCASTAT DD DSN=M204.CCASTAT,DISP=SHR //SYSRINT DD SYSOUT=C //CLAIMS90 DD DSN=M204.CLAIMS90,DISP=SHR

IFAM1 jobs: Compiling under Enterprise PL/I for z/OS

When compiling a PL/I application under the Enterprise PL/I for z/OS compiler, the following compiler parameter is required:

DEFAULT(LINKAGE(SYSTEM))

This causes the parameter list to be built in the same way that it was built by the old compilers (including turning on the high-order bit of the address of the last parameter).

For example:

//PLICMPL EXEC PGM=IBMZPLI,PARM='OBJECT,OPTIONS, // DEFAULT(LINKAGE(SYSTEM))',REGION=512K,...

If this compiler option is not specified, subsequent executions of the application will fail with 0C4 abends.

FORTRAN example

This section provides a sample program written in FORTRAN to run in the IFAM1 environment under z/OS using the Model 204 Host Language Interface. The sample FORTRAN program that is shown in Sample FORTRAN program (z/OS) can be run as shown with the application code embedded in the z/OS job stream.

Using a claims file

The IFAM1 FORTRAN application program accesses a file that contains insurance data (a Model 204 data file named CLAIMS90) and uses the information to determine the average settlement amount for all liability claims settled in the first half of 1990. Liability claims are indicated by the field name = value pair of CLAIM TYPE= L. The format of SETTLEMENT DATE is YYMMDD.

IFAM1 FORTRAN example (z/OS)

The following example is an HLI application written for IFAM1 in FORTRAN, which, with the JCL that is shown in the job stream, runs under an z/OS operating system.

This application uses a single cursor IFSTRT thread.

Sample FORTRAN program (z/OS)

//JOBNAME JOB 'IFAM1',MSGLEVEL=1,MSGCLASS=A //************************************************************ //* //* JCL TO COMPILE AND LINK AN IFAM1 FORTRAN PROGRAM //* ************************************************************** //JOBLIB DD DSN=USER.LINKLIB,DISP=SHR //FORT EXEC PGM=IEYFORT //SYSPRINT DD SYSOUT=* //SYSLIN DD DSN=&&LOADSET, // DISP=(MOD,PASS),UNIT=SYSDA,SPACE=(80,(500,100)) //SYSIN DD * C C C GLOSSARY: C ALIBC: AVERAGE LIABILITY CLAIM C CNT: ASSIGNED VALUE OF 5, USED IN ERROS (ERROR ROUTINE) C EDITS: M204 VARIABLE NAMES AND THEIR EDIT MASKS (IFGET) C FILEID:M204 FILE NAME (IFOPEN) C FIN: ASSIGNED VALUE OF 7, USED IN ERROS (ERROR ROUTINE) C FIND: ASSIGNED VALUE OF 4, USED IN ERROS (ERROR ROUTINE) C FINDS: FIND CRITERIA PROVIDED BY USERS (IFFIND) C GET: ASSIGNED VALUE OF 6, USED IN ERROS (ERROR ROUTINE) C IRC: RETURN CODE FROM HOST LANGUAGE INTERFACE CALLS C OPEN: ASSIGNED VALUE OF 3, USED IN ERROS (ERROR ROUTINE) C LIBC: LIABILITY CLAIM AMOUNT RETURNED FROM M204 FILE C LOG: ASSIGNED VALUE OF 2, USED IN ERROS (ERROR ROUTINE) C LOGIN: M204 USER-ID AND PASSWORD (IFLOG) C LTYPE: LANGUAGE TYPE (FORTRAN, COBOL, PL/I, OR BAL) IN C THIS CASE, FORTRAN C NFINDS: NUMBER OF FINDS, USED AS TEST VALUE IN DO LOOP C NLIBC: THE NUMBER OF LIABILITY CLAIMS, USED TO COMPUTE C THE AVERAGE C PARMS: HOST LANGUAGE INTERFACE PARAMETERS C STRT: ASSIGNED VALUE OF 1, USED IN ERROS (ERROR ROUTINE) C TLIBC: TOTAL LIABILITY CLAIM C USER0: USER ZERO INPUT FOR HOST LANGUAGE INT EXECUTION C C SUBROUTINES: C C IFSTRT: STARTUP MODEL 204 HOST LANGUAGE INTERFACE THREAD C IFLOG: LOGIN TO M204 C IFOPEN: OPEN MODEL 204 FILE C IFFIND: 'FIND ALL RECORDS . . .' C IFCNT: 'COUNT RECORDS IN . . .' C IFGET: 'FOR EACH RECORD IN . . .' C IFFNSH: 'LOGOUT' C ERROS: ERROR ROUTINE (M204 ERRORS) C C REAL ALIBC,LIBC,TLIBC INTEGER PARMS(20),USER0(20),FINDS(20),EDITS(20) INTEGER LOGIN(10),FILEID(10) INTEGER IRC,LTYPE,NFINDS,NLIBC INTEGER*2 STRT,LOG,OPEN,FIND,CNT,GET,FIN DATA STRT /1/, * LOG /2/, * OPEN /3/, * FIND /4/, * CNT /5/, * GET /6/, * FIN /7/ DATA LTYPE/2/ C C READ IN USER INPUT C READ(05,500) (PARMS(I),I=1,20) READ(05,500) (USER0(I),I=1,20) READ(05,500) (LOGIN(I),I=1,10) READ(05,500) (FILEID(I),I=1,10) READ(05,500) (FINDS(I),I=1,20) READ(05,500) (EDITS(I),I=1,20) C C ECHO INPUT PARAMETERS C WRITE(06,610) WRITE(06,611) (PARMS(I),I=1,20) WRITE(06,611) (USER0(I),I=1,20) WRITE(06,611) (LOGIN(I),I=1,10) WRITE(06,611) (FILEID(I),I=1,10) WRITE(06,611) (FINDS(I),I=1,20) WRITE(06,611) (EDITS(I),I=1,20) C C START M204 THREAD C CALL IFSTRT(IRC,LTYPE,PARMS,USER0) IF (IRC.EQ.0) GOTO 10 CALL ERROS(STRT,IRC) C C LOGIN TO M204 C 10 CALL IFLOG(IRC,LOGIN) IF (IRC.EQ.0) GOTO 20 CALL ERROS(LOG,IRC) C C OPEN FILE C 20 CALL IFOPEN(IRC,FILEID) IF ((IRC.EQ. 0) .OR. * (IRC.EQ.16) .OR. * (IRC.EQ.32)) GOTO 30 CALL ERROS(OPEN,IRC) C C FIND STATEMENT C 30 CALL IFFIND(IRC,FINDS) IF (IRC.EQ.0) GOTO 40 CALL ERROS(FIND,IRC) C C COUNT THE NUMBER OF RECORDS FOUND C 40 CALL IFCNT(IRC,NFINDS) IF (IRC.EQ.0) GOTO 50 CALL ERROS(CNT,IRC) C C CHECK TO SEE IF ANY RECORDS WERE FOUND C 50 IF (NFINDS.GT.0) GOTO 60 WRITE(06,600) STOP 999 60 WRITE(06,640) NFINDS C C SIMULATION OF THE 'FOR EACH RECORD' LOOP C DO 110 I=1,NFINDS C C 'GET' THE RECORDS FROM M204 C CALL IFGET(IRC,LIBC,EDITS) IF (IRC.EQ.0) GOTO 70 CALL ERROS(GET,IRC) GOTO 110 C C ADD THE LIBC TO TLIBC C 70 TLIBC=TLIBC+LIBC NLIBC=NLIBC+1 110 CONTINUE C C COMPUTE THE AVERAGE C ALIBC=TLIBC/NLIBC WRITE(06,650) TLIBC,ALIBC CALL IFFNSH(IRC) IF (IRC.EQ.1000) GOTO 1000 C C TERMINATE M204 THREAD C CALL ERROS(FIN,IRC) STOP 1999 1000 STOP 500 FORMAT(20A4) 600 FORMAT('1',//,' REQUEST ENDED 999: NO RECORDS FOUND') 610 FORMAT('1',' INPUT PARAMETERS') 611 FORMAT(' ',20A4) 640 FORMAT('1',/////,' NUMBER OF RECORDS ',I7) 650 FORMAT(////,'TOTAL CLAIMS: ',F7.1,' AVERAGE CLAIM: ',F7.1) END C C C GLOSSARY: C IERR: VECTOR OF SUBROUTINE NAMES; USED IN PRINTING ERROR C MESSAGES C MESSGE: TEXT RETURNED FORM M204 (IFGERR) C IPRC: PREVIOUS RETURN CODE C IRC: RETURN CODE FROM HLI CALLS C ITYPE: VALUE OF STRT, LOG, OPEN, FIND, CNT, GET, OR FIN C C SUBROUTINES: C C IFGERR: GET TEXT OF RETURN CODE FROM M204 C C SUBROUTINE ERROS(ITYPE,IRC) REAL*8 IERR(7),MESSGE(10) INTEGER*2 ITYPE DATA IERR/'IFSTRT ','IFLOG ','IFOPEN ', * 'IFFIND ','IFCNT ','IFGET ','IFFNSH '/ IPRC=IRC C C GET RETURN CODE MESSAGE TEXT AND ABEND 999 C CALL IFGERR(IRC,MESSGE) WRITE(06,600) IERR(ITYPE),IPRC,MESSGE 600 FORMAT('1',////,'BAD CALL:' ,A8,'RETURN CODE: ',I5,': ',10A8) STOP 999 END /* //LKED EXEC PGM=IEWL,PARM='LIST,XREF,LET,RENT', // COND=(5,LT,FORT) //SYSLIN DD DSN=&&LOADSET,DISP=(OLD,DELETE) // DD DDNAME=SYSIN //SYSLMOD DD DSN=LOCAL.M204.IFAM1.APPLIC,DISP=SHR //SYSLIB DD DSN=SYS1.FORTLIB,DISP=SHR //SYSUT1 DD UNIT=(SYSDA,SEP=(SYSLIN,SYSLMOD)), // SPACE=(1024,(50,20)) //SYSOUT DD SYSOUT=C //SYSPRINT DD SUSOUT=C //OB DD DSN=LOCAL.M204.OBJECT,DISP=SHR //SYSIN DD * INCLUDE OB(IFIF1OS) NAME IFAMTEST(R)

Run the IFAM1 FORTRAN application using the following JCL:

//RUNIFAM1 JOB ,'RUNIFAM1',MSGLEVEL=(1,1),MSGCLASS=C,CLASS=T //* //IFAM1 EXEC PGM=IFAMTEST //* //STEPLIB DD DSN=LOCAL.M204.IFAM1.APPLIC,DISP=SHR // DD DSN=LOCAL.M204.LOAD,DISP=SHR //FT05F001 DD * SYSOPT=144; MAXBUF=2,MINBUF=2,SPCORE=10000,LAUDIT=7; userid;password; CLAIMS90; CLAIM TYPE=L;SETTLEMENT DATE IS BETWEEN 900100 AND 900631;END; EDIT(SETTLEMENT AMOUNT) (F(4)); //CCAAUDIT DD SYSOUT=C //CCAPRINT DD SYSOUT=C //CCASNAP DD SYSOUT=C //SYSUDUMP DD SYSOUT=C //CCATEMP DD DISP=NEW,UNIT=SYSDA,SPACE=(TRK,(20) //CCASTAT DD DSN=M204.CCASTAT,DISP=SHR //SYSPRINT DD SYSOYT=C //CLAIMS90 DD DSN=M204.CLAIMS90,DISP=SHR //

Assembler example

This section provides a sample program written in Assembler to run in the IFAM1 environment under z/OS using the Model 204 Host Language Interface. The sample Assembler program that is shown in Sample Assembler program (z/OS) can be run as shown with the application code embedded in the z/OS job stream.

Using a claims file

The IFAM1 Assembler application program accesses a file that contains insurance data (a Model 204 data file named CLAIMS90) and uses the information to determine the average settlement amount for all liability claims settled in the first half of 1990. Liability claims are indicated by the field name = value pair of CLAIM TYPE= L. The format of SETTLEMENT DATE is YYMMDD.

IFAM1 Assembler example (z/OS)

The following example is an HLI application written for IFAM1 in Assembler which, with the JCL that is shown in the job stream, runs under an z/OS operating system.

This application uses a single cursor IFSTRT thread.

Sample Assembler program (z/OS)

//JOBNAME JOB CLASS=A,MSGCLASS=A //ASM EXEC PGM=IEV90,PARM='NODECK,OBJECT,XREF(SHORT)', // REGION=512K //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR //SYSUT1 DD SPACE=(CYL,(4,2)),UNIT=SYSDA //SYSPRINT DD SYSOUT=A //SYSPUNCH DD SYSOUT=A //SYSLIN DD DSN=LOCAL.M204.OBJLIB(IFAMT1),DISP=SHR //SYSIN DD * IFAMT1 TITLE 'IFAM1 JOB' R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 RA EQU 10 RB EQU 11 RC EQU 12 RD EQU 13 RE EQU 14 RF EQU 15 IFAMT1 CSECT STM RE,RC,12(RD) SAVE THEIR REGISTERS LR RB,RF SET BASE REGISTER USING AMT1,RB ESTABLISH ADDRESSABILITY ST RD,SAVEAREA+4 STORE THEIR SAVEAREA POINTER LA R2,SAVEAREA GET POINTER TO OUR SAVEAREA ST R2,8(,RD) STORE OUR SAVEAREA POINTER LR RD,R2 POINT TO OUR SAVEAREA ************************************************************* * MAIN PROCESSING LOOP ************************************************************* MAIN DS 0H INITIALIZATION AND CONNECT MVC THRDNO(4),RESET INITIALIZE THREAD NUMBER CALL IFSTRTN,(RETCODE,LANGIND,LOGON,MODEUP,THRDNO,OSCHNL),VL L R7,RETCODE GET RETURN CODE LTR R7,R7 DID WE GET A RETURN CODE ZERO BNZ ENDIT NO, GO END IT CALL IFOPEN,(RETCODE,FILEDATA),VL OPEN FILE L R7,RETCODE GET RETURN CODE LTR R7,R7 NO, DID WE GET A RETURN CODE ZERO BNZ TERM GO FINISH UP CALL IFFIND,(RETCODE,SELECT),VL FIND M204 RECORDS L R7,RETCODE GET RETURN CODE LTR R7,R7 DID WE GET A RETURN CODE ZERO BNZ TERM NO, GO CLOSE FILE AND FINISH GETLOOP DS 0H GET ALL RECORDS CALL IFGET,(RETCODE,GETAREA,GETLIST),VL CLC RETCODE,ENDSET END OF FOUND SET= 2 BE TERM YES, EXIT CALL IFPUT,(RETCODE,GETAREA,GETLIST),VL TERM CALL IFFNSH,(RETCODE),VL CLOSE M204 CONNECTION ENDIT L RD,SAVEAREA+4 RESTORE R13 TO THEIR SAVEAREA ST R7,16(,RD) SET R15 TO RETURN CODE LM RE,RC,12(RD) RESTORE THEIR REGISTERS BR RE RETURN EJECT ************************************************************ * VARIABLES AND CONSTANTS * ************************************************************ SAVEAREA DS 18F IFAM REGISTER SAVE AREA RETCODE DC F'0' MODEL 204 RETURN CODE AREA LANGIND DC F'2' MODEL 204 LANGUAGE IND AREA MODEUP DC F'1' INDICATES UPDATE MODE THRDNO DC F'0' THREAD NUMBER RESET DC F'0' RESET THREAD NUMBER IFERROR DC F'4' ERROR RETURN CODE FOR IFSTRTN ENDSET DC F'2' END OF FOUND SET (IFGET) FILEDATA DC CL14'FILE CLAIMS90;' DATA FOR IFOPEN SELECT DC CL10'A=999;END;' DATA FOR IFFIND GETLIST DC CL5'DATA;' DATA FOR IFGET GETAREA DS CL40 DATA AREA FOR IFGET CHAN DC CL8' ' CHANNEL NAME AREA OSCHNL DC CL8'IFAMTEST' DEFAULT TEST CHANNEL NAME LOGON DC CL11'USER1;PSW1;' M204 LOGON END IFAMT1 //* //LKED EXEC PGM=IEWL,PARM='LET,LIST,MAP,SIZE=(256K,64K), // XREF',REGION=512K //SYSPRINT DD SYSOUT=A //SYSLMOD DD DSN=LOCAL.M204.LOADLIB,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(TRK,(15,10)) //CCA DD DSN=LOCAL.M204.OBJLIB,DISP=SHR //SYSLIN DD * INCLUDE CCA(IFAMT1) INCLUDE CCA(IFIF1OS) NAME IFAMT1(R) /*

SOUL (User Language) example

The three programs (PL/I, FORTRAN, and Assembler) in the preceding sections all use the same insurance file (CLAIMS90) and the same HLI functions to determine the average settlement amount for all liability claims settled in the first half of 1990.

The SOUL solution is based on the same example as the sample PL/I, FORTRAN, and Assembler programs in the preceding sections.

For each action, Model 204 command, or SOUL statement on the left, the column on the right shows the corresponding action of the HLI application, which includes any HLI call.

Note: The HLI application below uses a single cursor IFSTRT thread.

SOUL solution HLI application
Connect (dial the number and give the Model 204 application ID) IFSTRT
Log in IFLOG
OPEN CLAIMS90 (and enter password) IFOPEN
BEGIN
  LOCATE:
  FD CLAIM TYPE= L
  SETTLEMENT DATE IS BETWEEN -
  900100 AND 900631
IFFIND (with similar criteria)
    TALLY:
    COUNT RECORDS IN LOCATE
IFCOUNT (assigns the count to a variable)
FR LOCATE Loop
SUM: %TOTAL= %TOTAL +    -
         SETTLEMENT AMOUNT
IFGET assigns the SETTLEMENT AMOUNT to a variable (and code computes the total)
AVRG:
  %AVG = %TOTAL/COUNT IN SUM
Code performs computation
PRT:
  PRINT %AVG
END
Code performs a print function
CLOSE CLAIMS90 IFCLOSE
LOGOUT
DISCONNECT
IFFNSH

Note: In addition to the functions listed, the HLI application must use IFGERR for error processing, because the error messages cannot go to the terminal user.

See also