HLI: IFAM2/IFAM4 job program examples
Overview
This topic provides examples of IFAM2 and IFAM4 jobs, complete with program code, which includes a multiple cursor IFSTRT thread application. The sample programs illustrate the use of Host Language Interface functions in the IFAM2 and IFAM4 processing environments.
For more information
See HLI: IFAM1 job program examples for examples of HLI applications written in different host languages and job setups that can be run in IFAM1. See the HLI topics for coding examples related to particular aspects of HLI processing.
Multiple cursor IFSTRT thread example
This section provides a sample program written in COBOL to run in the IFAM2 environment under CMS using the Model 204 Host Language Interface.
"Multiple cursor IFSTRT thread" below illustrates how to establish a multiple cursor IFSTRT thread. The application opens two files, VEHICLES and CLIENTS, and updates records in the CLIENTS file using data from the VEHICLES file. See Sample output from multiple cursor program for the sample output generated by the execution of this program.
Note: The following sample COBOL program can be compiled, linked, and loaded with the CMS EXEC in CMS EXEC examples. This same program (with no changes) could be run in a z/OS or VSE operating system environment by using the necessary JCL (which is not provided).
For more information, see Multiple cursor and single cursor IFSTRT threads (for job design information) and Multiple cursor IFSTRT threads (for threads overview information).
Sample program: Multiple cursor IFSTRT thread
IDENTIFICATION DIVISION. PROGRAM-ID. EX2 ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-4381. OBJECT-COMPUTER. IBM-4381. DATA DIVISION. WORKING-STORAGE SECTION. ************************************************* * SAMPLE PROGRAM WHICH UPDATES THE CLIENTS FILE USING * DATA CALCULATED FROM THE VEHICLES FILE. * THIS PROGRAM USES A MULTIPLE CURSOR IFSTRT THREAD * * FOR PURPOSES OF TESTING, YOU CAN LIMIT THIS TO THE FIRST 10 * POLICYHOLDERS IN THE CLIENTS FILE (USE VARIABLE LOOPCTR TO * CONTROL THIS AND UNCOMMENT LOOPCTR CHECK). * ************************************************* 01 INTEGER-ARGS COMP SYNC. 05 STAT-IND PIC 9(5). 05 LANG-IND PIC 9(5) VALUE 2. 05 THRD-TYPE PIC 9(5) VALUE 2. 05 THRD-NAME PIC 9(5). 05 FETCH-DIRECTION PIC 9(5) VALUE 1. 01 CHAR-ARGS. 05 LOGIN PIC X(13) VALUE "USER01;PASSW;". 05 VEH-PARM PIC X(10) VALUE "VEHICLES;;". 05 CLIENT-PARM PIC X(9) VALUE "CLIENTS;;". 05 CHAN-NAME PIC X(9) VALUE "MSPIFM22;". 05 IFGERR-MESSAGE PIC X(80) VALUE SPACES. 05 POL-FIND PIC X(6) VALUE "POLFD;". 05 POL-SET PIC X(9) VALUE "IN POLFD;". 05 POL-CURSOR PIC X(7) VALUE "POLCUR;". 05 POL-FETCH-NAME PIC X(8) VALUE "POLFTCH;". 05 IFUPDT-POL PIC X(7) VALUE "UPDPOL;". 05 FIND-POLICY PIC X(39) VALUE "IN CLIENTS FD RECTYPE=POLICYHOLDER;END;". 05 FIND-VEH PIC X(41) VALUE "IN VEHICLES FD OWNER POLICY=%POLICY;END;". 05 POL-BUF. 10 OWN-POL PIC X(6) VALUE SPACES. 05 FIND-VEH-EDIT PIC X(22) VALUE "EDIT (%POLICY) (A(6));". 05 VEH-FIND PIC X(6) VALUE "VEHFD;". 05 VEH-SET PIC X(9) VALUE "IN VEHFD;". 05 VEH-CURSOR PIC X(7) VALUE "VEHCUR;". 05 VEH-FETCH-NAME PIC X(8) VALUE "VEHFTCH;". 05 EDIT-1 PIC X(24) VALUE "EDIT (POLICY NO) (A(6));". 05 EDIT-2 PIC X(30) VALUE "EDIT (VEHICLE PREMIUM) (Z(8));". 05 EDIT-3 PIC X(29) VALUE "EDIT (TOTAL PREMIUM) (Z(10));". 01 WORK-AREA. 05 PREM-AMT PIC 9(8) VALUE ZEROES. 05 TOTAL-PREM PIC 9(10) VALUE ZEROES. 01 CALLNAME PIC X(20). 01 DISPLAY-STAT-IND PIC 9(4). 01 LOOPCTR PIC 9(3) COMP-3 VALUE 0. 01 MORE-POL-FLAG PIC XXX VALUE "YES". 88 NO-MORE-POL VALUE "NO". 01 MORE-VEH-FLAG PIC XXX VALUE "YES". 88 NO-MORE-VEH VALUE "NO". PROCEDURE DIVISION. MAINLINE. CALL "IFSTRTN" USING STAT-IND, LANG-IND, LOGIN, THRD-TYPE, THRD-NAME, CHAN-NAME. MOVE "IFSTRTN" TO CALLNAME. PERFORM RC-CHECK. CALL "IFOPEN" USING STAT-IND, VEH-PARM. MOVE "IFOPEN" TO CALLNAME. PERFORM RC-CHECK. CALL "IFOPEN" USING STAT-IND, CLIENT-PARM. MOVE "IFOPEN" TO CALLNAME. PERFORM RC-CHECK. CALL "IFFIND" USING STAT-IND, FIND-POLICY, POL-FIND. MOVE "IFFIND-P" TO CALLNAME. PERFORM RC-CHECK. CALL "IFOCUR" USING STAT-IND, POL-SET, POL-CURSOR. MOVE "IFOCUR-P" TO CALLNAME. PERFORM RC-CHECK. GET-FIRST-POLICY. CALL "IFFTCH" USING STAT-IND, OWN-POL, FETCH-DIRECTION, POL-CURSOR, EDIT-1, POL-FETCH-NAME. DISPLAY "POLNO RETRIEVED IS: " OWN-POL IF STAT-IND EQUAL 2 THEN MOVE "NO" TO MORE-POL-FLAG ELSE MOVE "IFFTCH-P1" TO CALLNAME PERFORM RC-CHECK. PERFORM UPDATE-POLICIES UNTIL NO-MORE-POL. PERFORM M204-DISCONN. STOP RUN. ******* E N D O F M A I N L I N E C O D E ****** **************** PERFORMED ROUTINES FOLLOW ************ RC-CHECK. MOVE STAT-IND TO DISPLAY-STAT-IND. IF STAT-IND NOT EQUAL 0 THEN DISPLAY "****** SERIOUS IFAM ERROR *******" DISPLAY "IFAM CALL: " CALLNAME ", RC: " DISPLAY-STAT-IND CALL "IFGERR" USING STAT-IND, IFGERR-MESSAGE DISPLAY "MESSAGE:" IFGERR-MESSAGE PERFORM M204-DISCONN STOP RUN. M204-DISCONN. DISPLAY "DISCONNECTING FROM M204 NOW". CALL "IFFNSH" USING STAT-IND. IF STAT-IND NOT EQUAL 1000 THEN MOVE STAT-IND TO DISPLAY-STAT-IND DISPLAY "IFAM CALL: IFFNSH, RC: " DISPLAY-STAT-IND. UPDATE-POLICIES. ADD 1 TO LOOPCTR. CALL "IFFIND" USING STAT-IND, FIND-VEH, VEH-FIND, OWN-POL, FIND-VEH-EDIT. MOVE "IFFIND-V" TO CALLNAME. PERFORM RC-CHECK. CALL "IFOCUR" USING STAT-IND, VEH-SET, VEH-CURSOR. MOVE "IFOCUR-V" TO CALLNAME. PERFORM RC-CHECK. * * GET FIRST CORRESPONDING VEHICLE RECORD. * MOVE "YES" TO MORE-VEH-FLAG CALL "IFFTCH" USING STAT-IND, PREM-AMT, FETCH-DIRECTION, VEH-CURSOR, EDIT-2, VEH-FETCH-NAME. IF STAT-IND EQUAL 2 THEN MOVE "NO" TO MORE-VEH-FLAG ELSE MOVE "IFFTCH-V1" TO CALLNAME PERFORM RC-CHECK. MOVE ZEROES TO TOTAL-PREM. PERFORM SUM-VEHICLES UNTIL NO-MORE-VEH. CALL "IFCCUR" USING STAT-IND, VEH-CURSOR. MOVE "IFCCUR-V" TO CALLNAME. PERFORM RC-CHECK. * * UPDATE POLICYHOLDER RECORD WITH CALCULATED TOTAL * CALL "IFUPDT" USING STAT-IND, TOTAL-PREM, POL-CURSOR, EDIT-3, IFUPDT-POL. MOVE "IFUPDT" TO CALLNAME. PERFORM RC-CHECK. DISPLAY "CALCULATED PREMIUM IS:" TOTAL-PREM * * GET NEXT POLICYHOLDER RECORD TO BE PROCESSED. * CALL "IFFTCH" USING STAT-IND, OWN-POL, FETCH-DIRECTION, POL-CURSOR, EDIT-1, POL-FETCH-NAME. DISPLAY "POLNO RETRIEVED IS: " OWN-POL IF STAT-IND EQUAL 2 THEN MOVE "NO" TO MORE-POL-FLAG ELSE MOVE "IFFTCH-P2" TO CALLNAME PERFORM RC-CHECK. IF LOOPCTR > 10 THEN MOVE "NO" TO MORE-POL-FLAG. SUM-VEHICLES. COMPUTE TOTAL-PREM = TOTAL-PREM + PREM-AMT. * * GET NEXT VEHICLE RECORD FOR THIS POLICY * CALL "IFFTCH" USING STAT-IND, PREM-AMT, FETCH-DIRECTION, VEH-CURSOR, EDIT-2, VEH-FETCH-NAME. IF STAT-IND EQUAL 2 THEN MOVE "NO" TO MORE-VEH-FLAG ELSE MOVE "IFFTCH-V2" TO CALLNAME PERFORM RC-CHECK. *************** END OF PROGRAM ****************
Sample output from multiple cursor program
The following sample output is generated by executing the sample COBOL program after it has been compiled, linked, and link-edited using CMS EXEC examples.
The first line shows the system prompt (Ready;) at the CMS terminal. The second line shows the typed user entry, which is the command to execute the program (stored as EX2MCIN).
The output lines generated by the execution of the program display a policy number and calculated premium value for each record that is updated in the CLIENTS file.
Sample program output: Multiple cursor IFSTRT thread
Ready; ex2mcin POLNO RETRIEVED IS: 111111 CALCULATED PREMIUM IS:0000000000 POLNO RETRIEVED IS: 100340 CALCULATED PREMIUM IS:0000000291 POLNO RETRIEVED IS: 100642 CALCULATED PREMIUM IS:0000000189 POLNO RETRIEVED IS: 100037 CALCULATED PREMIUM IS:0000000689 POLNO RETRIEVED IS: 100944 CALCULATED PREMIUM IS:0000001022 POLNO RETRIEVED IS: 100060 CALCULATED PREMIUM IS:0000000077 POLNO RETRIEVED IS: 100774 CALCULATED PREMIUM IS:0000000464 POLNO RETRIEVED IS: 100035 CALCULATED PREMIUM IS:0000000801 POLNO RETRIEVED IS: 100942 CALCULATED PREMIUM IS:0000000214 POLNO RETRIEVED IS: 100640 CALCULATED PREMIUM IS:0000000343 POLNO RETRIEVED IS: 100338 CALCULATED PREMIUM IS:0000000562 POLNO RETRIEVED IS: 100080 DISCONNECTING FROM M204 NOW
Multithreaded (single cursor) IFSTRT example
This section provides a sample program written in COBOL to run in the IFAM2 environment under CMS using the Model 204 Host Language Interface.
The sample "Multithreaded IFSTRT" COBOL program below establishes two single cursor IFSTRT threads and opens a file on each thread (VEHICLES and CLIENTS). The application switches between the threads to update records in the CLIENTS file using data from the VEHICLES file.
This program modifies the database in a similar way as the multiple cursor IFSTRT thread example; however, there are differences in coding. See Sample program output: Multithreaded IFSTRT for the sample output generated by the execution of this program.
Note: The following sample COBOL program can be compiled, linked, and loaded with the CMS EXEC examples. This same program (with no changes) could be run in a z/OS or VSE operating system environment by using the necessary JCL (which is not provided).
Sample program: Multithreaded IFSTRT
IDENTIFICATION DIVISION. PROGRAM-ID. EX2 ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-4381. OBJECT-COMPUTER. IBM-4381. DATA DIVISION. WORKING-STORAGE SECTION. ************************************************* * SAMPLE PROGRAM WHICH UPDATES THE CLIENTS FILE USING * DATA CALCULATED FROM THE VEHICLES FILE. * THIS PROGRAM USES TWO SINGLE CURSOR IFSTRT THREADS. * * FOR PURPOSES OF TESTING, YOU CAN LIMIT THIS TO THE FIRST 10 * POLICYHOLDERS IN THE CLIENTS FILE (USE VARIABLE LOOPCTR TO * CONTROL THIS AND UNCOMMENT LOOPCTR CHECK). * ************************************************* 01 INTEGER-ARGS COMP SYNC. 05 STAT-IND PIC 9(5). 05 LANG-IND PIC 9(5) VALUE 2. 05 UPD-YES PIC 9(5) VALUE 1. 05 UPD-NO PIC 9(5) VALUE 0. 05 CLIENT-THRD PIC 9(5). 05 VEH-THRD PIC 9(5). 05 OLD-THRD PIC 9(5). 01 CHAR-ARGS. 05 LOGIN PIC X(13) VALUE "USER01;PASSW;". 05 VEH-PARM PIC X(10) VALUE "VEHICLES;;". 05 CLIENT-PARM PIC X(9) VALUE "CLIENTS;;". 05 CHAN-NAME PIC X(9) VALUE "MSPIFM22;". 05 IFGERR-MESSAGE PIC X(80) VALUE SPACES. 05 FIND-POLICY PIC X(25) VALUE "RECTYPE=POLICYHOLDER;END;". 05 FIND-VEH. 10 FILLER PIC X(13) VALUE "OWNER POLICY=". 10 OWN-POL PIC X(6) VALUE SPACES. 10 FILLER PIC X(5) VALUE ";END;". 05 EDIT-1 PIC X(24) VALUE "EDIT (POLICY NO) (A(6));". 05 EDIT-2 PIC X(30) VALUE "EDIT (VEHICLE PREMIUM) (Z(8));". 05 EDIT-3 PIC X(29) VALUE "EDIT (TOTAL PREMIUM) (Z(10));". 01 WORK-AREA. 05 PREM-AMT PIC 9(8) VALUE ZEROES. 05 TOTAL-PREM PIC 9(10) VALUE ZEROES. 01 CALLNAME PIC X(8). 01 DISPLAY-STAT-IND PIC 9(4). 01 LOOPCTR PIC 9(3) COMP-3 VALUE 0. 01 MORE-POL-FLAG PIC XXX VALUE "YES". 88 NO-MORE-POL VALUE "NO". 01 MORE-VEH-FLAG PIC XXX VALUE "YES". 88 NO-MORE-VEH VALUE "NO". PROCEDURE DIVISION. MAINLINE. CALL "IFSTRTN" USING STAT-IND, LANG-IND, LOGIN, UPD-NO, VEH-THRD, CHAN-NAME. MOVE "IFSTRTN" TO CALLNAME. PERFORM RC-CHECK. CALL "IFOPEN" USING STAT-IND, VEH-PARM. MOVE "IFOPEN" TO CALLNAME. PERFORM RC-CHECK. CALL "IFSTRTN" USING STAT-IND, LANG-IND, LOGIN, UPD-YES, CLIENT-THRD, CHAN-NAME. MOVE "IFSTRTN" TO CALLNAME. PERFORM RC-CHECK. CALL "IFOPEN" USING STAT-IND, CLIENT-PARM. MOVE "IFOPEN" TO CALLNAME. PERFORM RC-CHECK. CALL "IFFIND" USING STAT-IND, FIND-POLICY. MOVE "IFFIND" TO CALLNAME. PERFORM RC-CHECK. GET-FIRST-POLICY. CALL "IFGET" USING STAT-IND, OWN-POL, EDIT-1. DISPLAY "POLNO RETRIEVED IS: " OWN-POL IF STAT-IND EQUAL 2 THEN MOVE "NO" TO MORE-POL-FLAG ELSE MOVE "IFGET-P1" TO CALLNAME PERFORM RC-CHECK. PERFORM UPDATE-POLICIES UNTIL NO-MORE-POL. PERFORM M204-DISCONN. STOP RUN. ******* E N D O F M A I N L I N E C O D E ****** **************** PERFORMED ROUTINES FOLLOW ************ RC-CHECK. MOVE STAT-IND TO DISPLAY-STAT-IND. IF STAT-IND NOT EQUAL 0 THEN DISPLAY "****** SERIOUS IFAM ERROR *******" DISPLAY "IFAM CALL: " CALLNAME ", RC: " DISPLAY-STAT-IND CALL "IFGERR" USING STAT-IND, IFGERR-MESSAGE DISPLAY "IFGERR-MESSAGE" PERFORM M204-DISCONN STOP RUN. M204-DISCONN. DISPLAY "DISCONNECTING FROM M204 NOW". CALL "IFFNSH" USING STAT-IND. IF STAT-IND NOT EQUAL 1000 THEN MOVE STAT-IND TO DISPLAY-STAT-IND DISPLAY "IFAM CALL: IFFNSH, RC: " DISPLAY-STAT-IND. UPDATE-POLICIES. ADD 1 TO LOOPCTR. CALL "IFSTHRD" USING STAT-IND, VEH-THRD, OLD-THRD. MOVE "IFSTHRD" TO CALLNAME. PERFORM RC-CHECK. CALL "IFFIND" USING STAT-IND, FIND-VEH. MOVE "IFFIND" TO CALLNAME. PERFORM RC-CHECK. * * GET FIRST CORRESPONDING VEHICLE RECORD. * MOVE "YES" TO MORE-VEH-FLAG CALL "IFGET" USING STAT-IND, PREM-AMT, EDIT-2. IF STAT-IND EQUAL 2 THEN MOVE "NO" TO MORE-VEH-FLAG ELSE MOVE "IFGET-V1" TO CALLNAME PERFORM RC-CHECK. MOVE ZEROES TO TOTAL-PREM. PERFORM SUM-VEHICLES UNTIL NO-MORE-VEH. * * SWITCH BACK TO CLIENTS THREAD AND POLICYHOLDER RECORD * CALL "IFSTHRD" USING STAT-IND, CLIENT-THRD, OLD-THRD. MOVE "IFSTHRD" TO CALLNAME. PERFORM RC-CHECK. * * UPDATE POLICYHOLDER RECORD WITH CALCULATED TOTAL * CALL "IFPUT" USING STAT-IND, TOTAL-PREM, EDIT-3. MOVE "IFPUT" TO CALLNAME. PERFORM RC-CHECK. DISPLAY "CALCULATED PREMIUM IS:" TOTAL-PREM * * GET NEXT POLICYHOLDER RECORD TO BE PROCESSED. * CALL "IFGET" USING STAT-IND, OWN-POL, EDIT-1. DISPLAY "POLNO RETRIEVED IS: " OWN-POL IF STAT-IND EQUAL 2 THEN MOVE "NO" TO MORE-POL-FLAG ELSE MOVE "IFGET-P2" TO CALLNAME PERFORM RC-CHECK. IF LOOPCTR > 10 THEN MOVE "NO" TO MORE-POL-FLAG. SUM-VEHICLES. COMPUTE TOTAL-PREM = TOTAL-PREM + PREM-AMT. * * GET NEXT VEHICLE RECORD FOR THIS POLICY * CALL "IFGET" USING STAT-IND, PREM-AMT, EDIT-2. IF STAT-IND EQUAL 2 THEN MOVE "NO" TO MORE-VEH-FLAG ELSE MOVE "IFGET-V2" TO CALLNAME PERFORM RC-CHECK. *************** END OF PROGRAM ****************
Sample output from multithreaded program
The following sample output is generated by executing the sample COBOL Multithreaded IFSTRT program after it has been compiled, linked, and link-edited using the CMS EXEC that is shown in EXEC to compile, link, and link-edit IFAM2 program (CMS).
The first line shows the system prompt (Ready;) at the CMS terminal. The second line shows the typed user entry, which is the command to execute the program (stored as EX2IFM2).
The output lines generated by the execution of the program display a policy number and calculated premium value for each record that is updated in the CLIENTS file.
Sample program output: Multithreaded IFSTRT
Ready; ex2ifm2 POLNO RETRIEVED IS: 100340 CALCULATED PREMIUM IS:0000000291 POLNO RETRIEVED IS: 100642 CALCULATED PREMIUM IS:0000000189 POLNO RETRIEVED IS: 100037 CALCULATED PREMIUM IS:0000000689 POLNO RETRIEVED IS: 100944 CALCULATED PREMIUM IS:0000001022 POLNO RETRIEVED IS: 100060 CALCULATED PREMIUM IS:0000000077 POLNO RETRIEVED IS: 100774 CALCULATED PREMIUM IS:0000000464 POLNO RETRIEVED IS: 100035 CALCULATED PREMIUM IS:0000000801 POLNO RETRIEVED IS: 100942 CALCULATED PREMIUM IS:0000000214 POLNO RETRIEVED IS: 100640 CALCULATED PREMIUM IS:0000000343 POLNO RETRIEVED IS: 100338 CALCULATED PREMIUM IS:0000000562 POLNO RETRIEVED IS: 100080 CALCULATED PREMIUM IS:0000000111 POLNO RETRIEVED IS: 100584 DISCONNECTING FROM M204 NOW
CMS EXEC examples
The following sample EXECS can be used to compile, link, and run an HLI application program in the IFAM2 environment under CMS:
Note: These EXECs can be used with either of the sample IFAM2 COBOL applications:
Example of an EXEC that compiles and links the program
The following example shows an EXEC that compiles, links, and link-edits an IFAM2 application running under CMS. The EXEC prompts the user for the name of the COBOL IFAM2 program that is to be compiled and linked. It then loads the program.
Note: M204IFAM TXTLIB must be available on an accessed disk to run this EXEC. See Sample EXEC: M204IFAM (CMS) for an example of the M204IFAM EXEC, which must be accessible on the machine. Note that the names of COBOL TXTLIBs might vary.
EXEC to compile, link, and link-edit IFAM2 program (CMS)
/* Exec to compile and link an IFAM2 program */ trace off address command parse upper arg pgmname say 'Compiling program now, pgm =' pgmname 'COBOL' pgmname say 'rc =' rc if rc = 0 then do say 'Loading program now' 'GLOBAL TXTLIB COBOLVS COBOLIBVS M204IFAM' 'LOAD' pgmname 'IFCM' end else exit rc say 'rc =' rc if rc = 0 then do say "Gen'ing module now" 'GENMOD' pgmname end say 'rc =' rc exit
Example of M204IFAM EXEC that must be accessible
The following "M204IFAM (CMS)" example shows an EXEC that starts an IFAM2 COBOL program running in the user machine. The M204IFAM EXEC is required to assign the channel name to the user ID.
The EXEC assumes that an IFAM2 COBOL program has previously been compiled, linked, and loaded, as is done, for example, with the previous EXEC to compile, link, and link-edit IFAM2 program (CMS).
Sample EXEC: M204IFAM (CMS)
/* REXX program to establish connection */ /* to M204 Online */ trace off parse upper arg channel if channel = 'MQFIFAMC' then push 'DEVCHAN' else push 'USERID1' exit 0
Compiled IFAM on a single cursor IFSTRT thread
This section provides a sample COBOL program to run in the IFAM2 environment using the Model 204 Host Language Interface.
This "Compiled IFAM" program below illustrates how to use Compiled IFAM calls on a single cursor IFSTRT thread.
Note: This program could be run in a z/OS, VSE, or CMS operating system environment by using the necessary JCL or EXECs (which are not provided).
See IFSTRT thread calls and compiled IFAM and Using the compiled IFAM facility for more information about compiled IFAM.
Sample program: Compiled IFAM
IDENTIFICATION DIVISION. PROGRAM-ID. IFAMTEST. AUTHOR. JOE ZEE. 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 OUT-BUFFER. 01 OUT-BUFFER PIC X(133). * WORKING-STORAGE SECTION. 01 INTEGER-CALL-ARGS COMP SYNC. 05 STATUS-IND PIC 9(5). 05 IFCOUNT-COUNT PIC 9(5). 05 LANGUAGE-IND PIC 9(5) VALUE 2. 05 READ-IND PIC 9(5) VALUE 0. 05 UPDT-IND PIC 9(5) VALUE 1. 05 THRD1 PIC 9(5). * 01 STRING-CALL-ARGS. 05 M204-ERR-MESSAGE PIC X(80) VALUE SPACES. 05 ERROR-FUNCTION PIC X(8). 05 IFSTRT-LOGIN PIC X(20) VALUE "SUPERKLUGE;PIGFLOUR;". 05 IFOPEN-FILE-PARM PIC X(10) VALUE "CLAIMS80;;". 05 IFFIND-NAME PIC X(6) VALUE "FIND1;". 05 IFFIND-SPEC PIC X(13) VALUE "KEY1=ZEE;END;". 05 IFFIND-SPEC-1 PIC X(14) VALUE "KEY1=%KEY;END;". 05 IFFIND-SPEC-2 PIC X(18) VALUE "EDIT(%KEY) (A(3));". * 05 IFGET-NAME-1 PIC X(5) VALUE "GET1;". 05 IFGET-NAME-2 PIC X(5) VALUE "GET2;". 05 IFGET-EDIT-SPEC-1 PIC X(28) VALUE "EDIT(KEY1,FORD) (A(3),A(5));". 05 IFGET-EDIT-SPEC-2 PIC X(19) VALUE "EDIT(FORD) (A(21));". 05 IFGET-SEQUENCE PIC X(17) VALUE "IN ORDER BY NORD;". * 05 IFFIND-DATA PIC X(3) VALUE "UNO". 05 IFGET-FIELDS-1. 10 IFGET-KEY PIC X(3) VALUE SPACES. 10 IFGET-FORD PIC X(5) VALUE SPACES. 05 IFGET-FIELDS-2 PIC X(21) VALUE SPACES. 05 IFGET-DUM-1 PIC X VALUE ";". 05 IFGET-DUM-2 PIC X VALUE ";". * PROCEDURE DIVISION. *********************************************************** * * THIS MODEL IS A SAMPLE IFAM2 (OR IFAM4) COBOL PROGRAM * * *********************************************************** MAIN-ROUTINE. * INITIALIZATION. * OPEN OUTPUT REPORT-FILE. CALL "IFSTRT" USING STATUS-IND, LANGUAGE-IND, IFSTRT-LOGIN, UPDT-IND, THRD1. DISPLAY "IFSTRT RETCODE: " STATUS-IND. IF STATUS-IND IS NOT EQUAL ZERO MOVE "IFSTRT " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. * PROCESS-1. CALL "IFOPEN" USING STATUS-IND, IFOPEN-FILE-PARM. DISPLAY "IFOPEN RETCODE: " STATUS-IND. IF STATUS-IND IS NOT EQUAL ZERO AND STATUS-IND IS NOT EQUAL TO 16 AND STATUS-IND IS NOT EQUAL TO 32 MOVE "IFOPEN " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. * CALL "IFFIND" USING STATUS-IND, IFFIND-SPEC. DISPLAY "IFFIND RETCODE: " STATUS-IND. IF STATUS-IND NOT EQUAL ZERO MOVE "IFFIND " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. * CALL "IFCOUNT" USING STATUS-IND, IFCOUNT-COUNT. DISPLAY "IFCOUNT RETCODE: " STATUS-IND IFCOUNT-COUNT. IF STATUS-IND NOT EQUAL ZERO MOVE "IFCOUNT " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. IF IFCOUNT-COUNT EQUAL ZERO GO TO PROCESS-2. * CALL "IFGETC" USING STATUS-IND, IFGET-EDIT-SPEC-2, IFGET-NAME-2. DISPLAY "IFGETC RETCODE: " STATUS-IND. IF STATUS-IND NOT EQUAL ZERO MOVE "IFGETC " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. * PERFORM IFGET-1 THRU IFGET-END-1 IFCOUNT-COUNT TIMES. * IFGET-1. * CALL "IFGETE" USING STATUS-IND, IFGET-FIELDS-2, IFGET-NAME-2. DISPLAY "IFGETE RETCODE: " STATUS-IND. IF STATUS-IND NOT EQUAL ZERO MOVE "IFGETE " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. * * PROCESS FIELDS RETRIEVED BY IFGET * IFGET-END-1. EXIT. * PROCESS-2. CALL "IFFIND" USING STATUS-IND, IFFIND-SPEC-1, IFFIND-NAME, IFFIND-DATA, IFFIND-SPEC-2. DISPLAY "IFFIND RETCODE: " STATUS-IND. IF STATUS-IND NOT EQUAL ZERO MOVE "IFFIND " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. * CALL "IFCOUNT" USING STATUS-IND, IFCOUNT-COUNT. DISPLAY "IFCOUNT RETCODE: " STATUS-IND IFCOUNT-COUNT. IF STATUS-IND NOT EQUAL ZERO MOVE "IFCOUNT " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. IF IFCOUNT-COUNT EQUAL ZERO GO TO TERMINATION. * PERFORM IFGET-2 THRU IFGET-END-2 IFCOUNT-COUNT TIMES. GO TO TERMINATION. * IFGET-2. CALL "IFGET" USING STATUS-IND, IFGET-FIELDS-1, IFGET-EDIT-SPEC-1, IFGET-NAME-1, IFGET-DUM-1, IFGET-DUM-2, IFGET-SEQUENCE. DISPLAY "IFGET RETCODE: " STATUS-IND. IF STATUS-IND NOT EQUAL ZERO MOVE "IFGET " TO ERROR-FUNCTION GO TO ERROR-ROUTINE. * * PROCESS FIELDS RETRIEVED BY IFGET * IFGET-END-2. EXIT. * ERROR-ROUTINE. DISPLAY "ERROR ENCOUNTERED WITH FUNCTION: " ERROR-FUNCTION ", WITH A RETURN CODE OF: " STATUS-IND. CALL "IFGERR" USING STATUS-IND M204-ERR-MESSAGE. DISPLAY "M204 ERROR MESSAGE = " M204-ERR-MESSAGE. * TERMINATION. CALL "IFFNSH" USING STATUS-IND. DISPLAY "IFFNSH RETCODE: " STATUS-IND. STOP RUN. /*
IFDIAL thread example (z/OS)
This section provides a sample program written in COBOL to run in the IFAM2 environment under z/OS or CMS using the Model 204 Host Language Interface.
The COBOL program illustrates how to establish an IFDIAL connection and how to send SOUL commands and statements to the Model 204 region.
The sample COBOL program in "Sample Program: IFDIAL Thread (z/OS)" below can be run as shown with the application code embedded in the z/OS job stream.
Note: A similarly structured COBOL program that uses an IFDIAL connection in IFAM2 is compiled and linked as program IFAM2UL to run in CMS using EXEC to compile, link, and link-edit IFAM2 program (CMS) and Sample EXEC: M204IFAM (CMS).
See HLI: Job design factors and IFSTRT and IFDIAL threads for more information about IFDIAL threads.
Example of a COBOL program using IFDIAL (z/OS)
The following example is an HLI program written in COBOL, which, with the JCL that is shown in the job stream, runs in IFAM2 under a z/OS operating system.
Note: This is an example of an IFDIAL application.
Sample Program: IFDIAL Thread (z/OS)
//CPLLKGO EXEC COBUCLG, // PARM.COB='LOAD,NOSEQ,APOST', // REGION.LKED=200K, // PARM.LKED='LIST,LET,SIZE=(192K,100K),MAP',REGION,GO=64K //COB.SYSIN DD * IDENTIFICATION DIVISION. PROGRAM-ID. CRAMDIAL. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT INPUT-FILE ASSIGN TO UT-S-INFILE. SELECT OUTPUT-FILE ASSIGN TO UT-S-OUTFILE. DATA DIVISION. FILE SECTION. FD INPUT-FILE LABEL RECORDS ARE OMITTED DATA RECORD IS INPUT-REC. FD OUTPUT-FILE LABEL RECORDS ARE OMITTED DATA RECORD IS OUTPUT-BUFFER. 01 INPUT-REC PIC X(80). WORKING-STORAGE SECTION. 01 FULL-WORDS COMP SYNC. 02 ERR PIC 9(5). 02 CBL-IND PIC 9(5) VALUE 2. 02 READ-ERR PIC 9(5). 02 WRITE-ERR PIC 9(5). 01 IFAM-ARGUMENT-STRINGS. 02 FROM-M204 PIC X(256) VALUE SPACES. 02 TO-M204 PIC X(256) VALUE SPACES. 02 M204-ERR-MSG PIC X(80) VALUE SPACES. 01 OUT-BUFFER PIC X(256) VALUE SPACES. PROCEDURE DIVISION. OPEN-FILES-ROUTINE. OPEN INPUT INPUT-FILE. DISPLAY '%%% TEST OF CRAM/USER LANGUAGE INTERFACE'. CALL 'IFDIAL' USING ERR CBL-IND. IF ERR NOT = 0 DISPLAY '%%% IFDIAL FAILED ' ERR GO TO END-ROUTINE. MVE SPACES TO FROM-M204, TO-M204. READ-FILE. READ INPUT-FILE INTO TO-M204 AT END GO TO END-ROUTINE. SEND-LINE. CALL 'IFWRITE' USING WRITE-ERR, TO-M204. IF WRITE-ERR = 2 OR 12 GO TO PRINT-FILE. IF WRITE-ERR = 1 GO TO READ-FILE. DISPLAY '%%% IFWRITE FAILED ' WRITE-ERR. GO TO END-ROUTINE. PRINT-FILE. MOVE SPACES TO FROM-M204. CALL 'IFREAD' USING READ-ERR, FROM-M204. IF READ-ERR = 1 WRITE OUT-BUFFER FROM FROM-M204 GO TO TEST-WRITE-STATUS. IF READ-ERR = 12 GO TO TEST-WRITE-STATUS. IF READ-STAT = 2 WRITE OUT-BUFFER FROM FROM-M204 GO TO PRINT-FILE. DISPLAY '%%% IFREAD FAILED ' READ-ERR. GO TO END-ROUTINE. TEST-WRITE-STATUS. IF WRITE-ERR = 12 GO TO SEND-LINE ELSE GO TO READ-FILE. END-ROUTINE. CLOSE INPUT-FILE. CALL 'IFHNGUP' USING ERR. IF ERR NOT = 0 DISPLAY '%%% IFHNGUP FAILED ' ERR PERFORM ERROR-ROUTINE. STOP RUN. //LKED.OB DD DSN=M204.OBJECT,DISP=SHR //LKED.SYSIN DD * INCLUDE OB(IFIF) //GO.SYSUDUMP DD SYSOUT=A //GO.SYSOUT DD SYSOUT=A //GO.OUTFILE DD SYSOUT=A //GO.INFILE DD * LOGIN TESTER2 PASWRD2 OPEN FOOTBALL ACCESS BEGIN %A=$USER %B=$TIME PRINT %A AT 30 AND %B AT 60 END BEGIN SEARCH: FIND ALL RECORDS FOR WHICH AGE IS GREATER THAN 30 REPORT: FOR EACH RECORD IN SEARCH PRINT 'PLAYER' AND NAME AND 'IS' AND AGE - AND 'YEARS OLD.' PRINT 'HIS TEAMMATES ARE;' AT 5 REFER: NOTE TEAM MATCH: FIND ALL RECORDS FOR WHICH TEAM=VALUE IN REFER EVERY: FOR EACH RECORD IN MATCH PRINT FIRST.NAME AT 10 AND NAME SKIP 1 LINE END FOR END FOR FINISH: PRINT 'END OF REPORT' END /*
IFDIAL thread example (CMS)
"Example of EXEC to compile and link IFAM2 program (CMS)" and "Example of EXEC to run IFAM2 program (CMS)" below show sample EXECs that can be used to compile and execute an HLI application program in the IFAM2 environment under CMS.
Note: These EXECs might be used with a COBOL program named IFAM2UL (not shown) that uses an IFDIAL connection in a manner similar to the program in Sample program: Compiled IFAM.
See Sample input to IFAM2UL program and Sample output from IFAM2UL program, which might be used for IFAM2UL.
Example of an EXEC that compiles, links, and loads the program
"Example of EXEC to compile and link IFAM2 program (CMS)" below shows an EXEC, IFAM2LNK, that compiles, links, and loads an IFAM2 application running under CMS. IFAM2LNK prompts the user for the name of the COBOL IFAM2 program that is to be compiled and linked. It then loads the program.
Note: M204IFAM TXTLIB must be available on an accessed disk to run this EXEC. See Sample EXEC: M204IFAM (CMS) for an example of the M204IFAM EXEC that must be accessible on the machine.
Example of EXEC to compile and link IFAM2 program (CMS)
&CONTROL OFF NOMSG * * USE THIS EXEC TO COMPILE, LINK, LOAD A COBOL IFAM2 PROGRAM * &ERROR &CONTINUE &IF &INDEX EQ 0 &GOTO -ASKPGM &BEGTYPE ALL ERROR: ENTER PARMS ONLY AS PROMPTED. &END &EXIT 999 &EXIT 0 * -ASKPGM &TYPE ENTER NAME OF THE IFAM2 PROGRAM TO BE COMPILED LINKED &READ VARS &PGM &IF X&PGM EQ X &GOTO -ASKPGM &IF X&PGM EQ XHX &GOTO -HALT * COBOL &PGM GLOBAL TXTLIB M204IFAM COBOLVS COBLIBVS LOAD &PGM IFCM GENMOD &PGM &TYPE EXEC COMPLETE ... GOODBYE &EXIT 0 * -HALT &TYPE EXEC HALTED BY USER REQUEST. &EXIT 998
Example of an EXEC that runs the program
"Example of EXEC to run IFAM2 program (CMS)" below shows an EXEC that starts an IFAM2 COBOL program running in the user machine.
The EXEC assumes that an IFAM2 COBOL program named IFAM2UL has previously been compiled, linked, and stored as IFAM2UL MODULE. IFAM2UL designates input file INPUT and output file REPORT.
Note: The Model 204 service machine must be up and running and have IODEV=39 available for the IFDIAL communication.
Example of EXEC to run IFAM2 program (CMS)
&CONTROL OFF * * SAMPLE IFAM2 EXEC * * THIS EXEC IS USED TO INITIATE THE START OF * AN IFAM2 IFDIAL PROGRAM * * CLEAR EXISTING NON-PERMANENT FILEDEFS * FILEDEF * CLEAR * * DEFINE THE FILES NEEDED BY THE COBOL PROGRAM * FILEDEF REPORT DISK IFAM2UL REPORT A FILEDEF INPUT DISK IFAM2UL INPUT A * IFAM2UL * &TYPE IFAM2 PROGRAM ENDED &TYPE LOOK FOR OUTPUT IN FILE CALLED 'IFAM2UL' 'REPORT'
Example of the M204IFAM EXEC that must be accessible
"Example of M204IFAM EXEC for IFAM2 program (CMS)" below shows an example of M204IFAM EXEC that must be accessible to the IFAM2 COBOL program running in the user machine. Model 204 calls this EXEC when the IFDIAL call is encountered in the program.
The EXEC provides Model 204 with the ID of the service machine and the desired communication method, IUCV. Input into this EXEC is the channel name that could be used by the EXEC author to determine the proper service machine ID in a multiservice machine environment.
Note: This sample does not use the channel information, but it assumes that the service machine ID is M204PROD.
Example of M204IFAM EXEC for IFAM2 program (CMS)
&CONTROL OFF * * M204 SAMPLE IFAM INTERFACE * * THIS EXEC PROCEDURE IS PROVIDED AS A SAMPLE TO AID IN THE * CREATION OF A TAILORED IFAM INTERFACE TO MODEL 204 FOR A * SPECIFIC INSTALLATION. * THE SINGLE PARAMETER TO THE M204IFAM EXEC IS THE CHANNEL * NAME TO WHICH A CONNECTION IS BEING REQUESTED BY THE * APPLICATION PROGRAM &CHANNEL = &1 * ESTABLISH DEFAULT VALUES &TARGET = IDSERV * TO ALLOW THE CONNECTION TO BE ATTEMPTED, THE EXEC MUST STACK * A SINGLE LINE AND EXIT WITH A RETURN CODE OF ZERO. * THE FIRST WORD OF THE LINE (&TARGET) IS THE USERID OF THE * VIRTUAL MACHINE WITH WHICH COMMUNICATION IS NEEDED. * OPTIONALLY, THE SECOND WORD (TYPE) CAN BE IUCV (USE IUCV * ONLY), OR IUCVVMCF (WHICH USES IUCV) * IUCVVMCF IS THE DEFAULT. -ALLOW &STACK LIFO &TARGET TYPE &EXIT 0 * TO REFUSE THE CONNECTION ATTEMPT REQUEST, THE EXEC MUST EXIT * WITH A NON-ZERO RETURN CODE -REFUSE &EXIT 1
Sample input to IFAM2UL program
The following sample input file, INPUT, is a SOUL request that is invoked by the IFAM2UL program (not shown), which is referenced in the CMS EXEC Example of M204IFAM EXEC for IFAM2 program (CMS).
LOGON FRED FREDPSWD OPEN CLIENTS BEGIN PRINT 'REPORT STARTED' SKIP 1 LINE PRINT 'FIRST LINE' END CLOSE CLIENTS LOGOUT
Sample output from IFAM2UL program
The following sample output, REPORT, is generated by the IFAM2UL program (not shown), which is referenced in Example of M204IFAM EXEC for IFAM2 program (CMS).
Note: The report output is based on the INPUT file, shown in the previous section Sample input to IFAM2UL program.
*** M204.0347: PASSWORD *** M204.0353: FRED FRED LOGIN 90 MAY 17 14.14 *** WELCOME TO PRODUCTION M204 SYSTEM *** *** M204.0620: FILE CLIENTS OPENED -- NO UPDATES ALLOWED REPORT STARTED FIRST LINE *** M204.0608: FILE CLOSED: CLIENTS *** M204.0604: CLOSING DEFAULT, USER MUST ESTABLISH NEW DEFAULT