View source for HLI: IFAM1 job program examples


==Overview==
<p>
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.</p>

===For more information===
<p>
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.</p>
<p>
See [[HLI: Coding conventions]] for guidelines on using different programming languages when coding HLI programs. See other [[:Category: Host Language Interface|HLI]] topics for coding examples related to particular aspects of HLI processing.</p>

==COBOL example==
<p>
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. </p>
<p>
The sample COBOL program that is shown in [[#fig1|Sample COBOL program (VSE)]] can be run as shown with the application code embedded in the VSE job stream.</p>
<p>
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 [[#fig2|Sample EXEC to run an IFAM1 program (CMS)]] and [[#fig3|Example of FILES EXEC for IFAM1 program (CMS)]].   </p>

===Using a vehicles file===
<p>
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.</p>

===IFAM1 COBOL example (VSE)===
<p>
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. </p>
<p>
This application uses a single cursor IFSTRT thread.</p>
<div id="fig1"></div>
<p class="caption">Sample COBOL program (VSE)</p>
<p class="code"><nowiki>* *************************************************************
*                                                             *
* 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 ...</nowiki>
.
.
.
// 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)<nowiki>
***************************************************************
*                                                             *
*  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%.                                           *
*                                                             *
*                                                             *
***************************************************************
</nowiki>
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. <nowiki>
**************************************************************
* 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                        *
* *************************************************************
</nowiki>
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.<nowiki>
* *************************************************************
*  DO NOT ATTEMPT TO FIND THE RECORDS IN THE MODEL 204 FILE   *
*  IF YOU PREVIOUSLY ENCOUNTERED AN ERROR WITH                *
*  IFSTRT, IFLOG,  OR IFOPEN.                                 *
* *************************************************************
</nowiki>
   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.<nowiki>
**************************************************************
*                                                             *
*  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.              *
*                                                             *
***************************************************************</nowiki>
  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.<nowiki>
**************************************************************
*     THIS CRITICAL ERROR SWITCH IS SET IF THERE IS A BAD     *
*     IFAM CALL TO MODEL 204.                                 *
**************************************************************</nowiki>
  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.<nowiki>
* 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.</nowiki>

<nowiki>***************************************************************
* JOB STEP #2:  LINK-EDIT THE PROGRAM                         *
***************************************************************
/*
  INCLUDE IFIF1DOS
ENTRY IFAMTEST
// EXEC LNKEDT
/&amp;
* *************************************************************
*  JOB STEP #3:                                               *
*  EXECUTE IFAM1 IF1PGM PROGRAM UNDER VSE                     *
*  RESULTS PRINTED IN REPORT ON SYSLST                        *
* *************************************************************</nowiki>

// 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<nowiki>
*</nowiki>
// 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
/*
/&amp;<nowiki>
* $$ EOJ</nowiki></p>

===IFAM1 COBOL example (CMS)===
<p>
[[#fig2|Sample EXEC to run an IFAM1 program (CMS)]] and [[#fig3|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.</p>

<p class="note"><b>Note:</b> These EXECs could be used with the COBOL program in [[#fig1|Sample COBOL program (VSE)]], assuming that the program is compiled and linked as IFAM1PG.</p>
<p>
The following figure shows an EXEC that generates an IFAM1 application module, IFAM1PG, running under CMS.</p>

<div id="fig2"></div>
<p class="caption">Sample EXEC to run an IFAM1 program (CMS)</p>
<p class="code"><nowiki>&amp;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
*
&amp;TYPE
&amp;TYPE IFAM1PG MODULE A HAS BEEN GENERATED FOR YOUR USE
&amp;TYPE
&amp;EXIT &amp;RETCODE</nowiki></p>
<p>
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. </p>

<div id="fig3"></div>
<p class="caption">Example of FILES EXEC for IFAM1 program (CMS)</p>
<p class="code"><nowiki>&amp;TRACE ALL
*
* EXEC TO DEFINE FILES FOR IFAM1 JOB
*
  &amp;ERROR &amp;EXIT &amp;RETCODE
  FILEDEF * CLEAR

* ACCESS XXX 121 DISK
  GETFMADR 250
  &amp;READ VARS &amp; &amp;XXX121M &amp;XXX121D
  EXECIO 0 CP ( STRING LINK XXX 121 &amp;XXX121D MW
  ACCESS &amp;XXX121D &amp;XXX121M

* GET TEMP DISK SPACE FOR CCATEMP FILE
  GETFMADR 250
  &amp;READ VARS &amp; &amp;TEMPM &amp;TEMPD
  EXECIO 0 CP (STRING DEFINE T3380 &amp;TEMPD CYL 3
  &amp;IF &amp;RETCODE NE 92 &amp;IF &amp;RETCODE NE 0 &amp;EXIT &amp;RETCODE
  &amp;STACK LIFO YES
  M204UTIL INIT &amp;TEMPD TEM204
  ACCESS &amp;TEMPD &amp;TEMPM
  M204UTIL CREATE M204 CMS CCATEMP &amp;TEMPM ( PRIMARY 40 TRK

* DEFINE FILES USED BY IFAM1 APPLICATION PROGRAM &amp; MODEL 204
  FILEDEF  CCAAUDIT   DISK IFM1   CCAAUDIT A
  FILEDEF  CCAPRINT   DISK IFM1   CCAPRINT A
  FILEDEF  CCASTAT &amp;XXX121M       DSN PSSOSMNT PROD CCASTAT M204
  FILEDEF  CCASNAP    DISK IFM1   CCASNAP A
  FILEDEF  CCATEMP &amp;TEMPM         DSN M204 CMS CCATEMP
  FILEDEF  VEHICLES &amp;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

  &amp;STACK IFAM1PG

&amp;EXIT &amp;RETCODE</nowiki></p>


==PL/I example==
<p>
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 [[#fig4|Sample PL/I program (z/OS)]] can be run as shown with the application code embedded in the z/OS job stream. </p>

===Using a claims file===
<p>
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. </p>

===IFAM1 PL/I example (z/OS)===
<p>
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. </p>
<p>
This application uses a single cursor IFSTRT thread.</p>
<div id="fig4"></div>
<p class="caption">Sample PL/I program (z/OS)</p>
<p class="code">//JOBNAME JOB ,'IFAM1 TEST',MSGCLASS=A,CLASS=A
//PLI  EXEC PGM=IEL0AA,PARM='OBJECT, NODECK',REGION=100K
//SYSPRINT   DD SYSOUT=*
//SYSLIN     DD DSN=&amp;&amp;LOADSET,DISP=(MOD,PASS),UNIT=SYSDA,
//  SPACE=(80,(250,100))
//SYSUT1     DD DSN=&amp;&amp;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 &#172;= 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 &#172;= 0)
   THEN DO;
      PUT DATA (IFLOG_ARGS);
      SIGNAL CONDITION (M204_ERROR_AND_TERMINATION);
   END;

 CALL IFOPEN (IF_RET_CODE, FILE_PSWD);
   IF ( &#172; (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 &#172;= 0)
  THEN DO;
     PUT DATA (IFFIND_ARGS);
     SIGNAL CONDITION (M204_ERROR_AND_TERMINATION);
   END;


CALL IFCOUNT (IF_RET_CODE,  COUNT);
  IF (IF_RET_CODE &#172;= 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 &#172;= 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 &#172;= 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=&amp;&amp;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=&amp;&amp;LOADSET,DISP=(OLD,DELETE), -
//               UNIT=SYSDA
// DD                DDNAME=SYSIN
//SYSIN      DD *
     INCLUDE OB(IFIF1OS)
     NAME IFAMTEST(R)  
</p>
<p>
Run the IFAM1 PL/I application using the following JCL: </p>
<p class="code">//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 </p>

===IFAM1 jobs: Compiling under Enterprise PL/I for z/OS===
<p>
When compiling a PL/I application under the Enterprise PL/I for z/OS compiler, the following compiler parameter is required:</p>
<p class="code">DEFAULT(LINKAGE(SYSTEM))</p>
<p>
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).</p>
<p>
For example:</p>
<p class="code">//PLICMPL EXEC PGM=IBMZPLI,PARM='OBJECT,OPTIONS,
//             DEFAULT(LINKAGE(SYSTEM))',REGION=512K,...
</p>
<p>
If this compiler option is not specified, subsequent executions of the application will fail with 0C4 abends.</p>

==FORTRAN example==
<p>
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 [[#fig5|Sample FORTRAN program (z/OS)]] can be run as shown with the application code embedded in the z/OS job stream. </p>

===Using a claims file===
<p>
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.   </p>

===IFAM1 FORTRAN example (z/OS)===
<p>
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. </p>
<p>
This application uses a single cursor IFSTRT thread.</p>
<div id="fig5"></div>
<p class="caption">Sample FORTRAN program (z/OS) </p>
<p class="code"><nowiki>//JOBNAME JOB 'IFAM1',MSGLEVEL=1,MSGCLASS=A
//************************************************************
//*
//* JCL TO COMPILE AND LINK AN IFAM1 FORTRAN PROGRAM
//*
**************************************************************
</nowiki>
//JOBLIB     DD DSN=USER.LINKLIB,DISP=SHR
//FORT   EXEC    PGM=IEYFORT
//SYSPRINT   DD SYSOUT=*
//SYSLIN     DD DSN=&amp;&amp;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=&amp;&amp;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)  </p>
<p>
Run the IFAM1 FORTRAN application using the following JCL: </p>
<p class="code">//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
// </p>

==Assembler example==
<p>
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 [[#fig6|Sample Assembler program (z/OS)]] can be run as shown with the application code embedded in the z/OS job stream.</p>

===Using a claims file===
<p>
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.   </p>

===IFAM1 Assembler example (z/OS)===
<p>
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. </p>
<p>
This application uses a single cursor IFSTRT thread.</p>
<div id="fig6"></div>
<p class="caption">Sample Assembler program (z/OS)</p>
<p class="code">//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<nowiki>
*************************************************************
* MAIN PROCESSING LOOP
*************************************************************
</nowiki>

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<nowiki>
************************************************************
* VARIABLES AND CONSTANTS
*
************************************************************</nowiki>
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)
/* </p>

==SOUL (User Language) example==
<p>
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. </p>
<p>
The SOUL solution is based on the same example as the sample PL/I, FORTRAN, and Assembler programs in the preceding sections.</p>
<p>
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.</p> 
<p class="note"><b>Note:</b> The HLI application below uses a single cursor IFSTRT thread.</p>
<table>
<tr class="head">
<th>SOUL solution</th>
<th>HLI application</th>
</tr>
<tr>
<td>Connect (dial the number and give the Model 204 application ID)</td>
<td><code>IFSTRT</code></td>
</tr>
<tr>
<td><code>Log in</code></td>
<td><code>IFLOG</code></td>
</tr>
<tr>
<td><code>OPEN CLAIMS90</code> (and enter password)</td>
<td><code>IFOPEN</code></td>
</tr>
<tr>
<td>
<code>BEGIN <br />&nbsp;&nbsp;LOCATE: <br />&nbsp;&nbsp;FD CLAIM TYPE= L <br />&nbsp;&nbsp;SETTLEMENT DATE IS BETWEEN  - <br />&nbsp;&nbsp;900100 AND 900631 </code></td>
<td><code>IFFIND</code> (with similar criteria)</td>
</tr>
<tr>
<td>&nbsp;&nbsp;&nbsp;&nbsp;<code>TALLY: </code><br />
  &nbsp;&nbsp;&nbsp;&nbsp;<code>COUNT RECORDS IN LOCATE</code></td>
<td><code>IFCOUNT</code>
(assigns the count to a variable)</td>
</tr>
<tr>
<td><code>FR LOCATE</code></td>
<td><code>Loop</code></td>
</tr>
<tr>
<td><code>SUM: %TOTAL= %TOTAL +  </code>&nbsp;&nbsp; -  <br />
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<code>  SETTLEMENT AMOUNT</code></td>
<td>
<code>IFGET</code> assigns the SETTLEMENT AMOUNT to a variable (and code computes the total)</td>
</tr>
<tr>
<td><code>AVRG:</code><br />
  &nbsp;<code>  %AVG = %TOTAL/COUNT IN SUM</code></td>
<td>Code performs computation</td>
</tr>
<tr>
</tr>
<tr>
<td><code>PRT: <br />&nbsp;&nbsp;PRINT %AVG <br />END </code></td>
<td>Code performs a print function</td>
</tr>
<tr>
<td><code>CLOSE CLAIMS90</code>
</td>
<td><code>IFCLOSE</code>
</td>
</tr>
<tr>
<td><code>LOGOUT</code><br />
<code>DISCONNECT</code></td>
<td><code>IFFNSH</code></td>
</tr>
<tr>
</tr>
</table>

<p class="note"><b>Note:</b> 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.</p>

==See also==
{{Template: HLI reference topic list}}

[[Category: Host Language Interface]]