Natural Program
The NATURAL sample program returns one or many records within a range from the Employee file.
For more information on how to use Adabas/Natural programs with the iWay Transaction Adapter for CICS, see Using Adabas/Natural Programs.
On Windows, the Natural sample program is located in:
C:\Program Files\iWay7\etc\samples\cics\natural
The following supporting files are provided:
- cobolfd
- aasnatn_in.cbl - Input record for the service.
- aasnatn_out.cbl - Output record for the service.
- document
- aasnatn.xml - The input XML document.
- src
- aasnatn.natural - The sample natural program.
The text version of the source code file is included below for your review:
/**************************************************************/ /* AASNATN - SAMPLE NATURAL PROGRAM FOR IWAY CICS ADAPTER. */ /* RETURN ONE OR MANY RECORDS WITHIN A RANGE FROM THE */ /* EMPLOYEE FILE. */ /* */ /* NATURAL PROGRAMS RUNNING WITH THE IWAY CICS ADAPTER ARE */ /* INVOKED INDIRECTLY VIA THE PROXY PROGRAM, AASNATC. */ /* */ /* ALL ACCESS TO INPUT/OUTPUT BUFFERS ARE HANDLED BY CALLS TO */ /* THE DATA MOVER PROGRAM, AASSUBC, DESCRIBED BELOW. */ /* */ /* COMMUNICATION WITH THE DATA MOVER PROGRAMS REQUIRE THE */ /* CONTROL BLOCK: */ /* 1 #REQUEST-PARMS */ /* 2 #FUNCTION (A2) GT,PT,LC,LI */ /* 2 #OFFSET (I2) DATA OFFSET OF INPUT/OUTPUT */ /* 2 #LENGTH (I2) LENGTH OF DATA TO GET OR PUT */ /* 2 #RESPONSE-CODE (I4) */ /* 2 #ERR-MESSAGE (A72) */ /* */ /* THE IMPLEMENTED FUNCTIONS ARE: */ /* GT - GET INPUT BY OFFSET. */ /* THE OFFSET MUST BE SET TO 0 FOR THE FIRST CALL ONLY!! */ /* THE OFFSET IS INCREMENTED FOLLOWING EACH CALL BY THE */ /* DATA MOVER PROGRAM */ /* THE LENGTH OF THE REQUESTED DATA MUST BE PROVIDED FOR */ /* EACH CALL. IT SHOULD MATCH THE LENGTH OF THE AREA */ /* PROVIDED TO RECEIVE THE INPUT DATA */ /* IE: MOVE #FUNC-GT TO #FUNCTION */ /* MOVE 8 TO #LENGTH */ /* MOVE 0 TO OFFSET - FIRST CALL ONLY */ /* CALL 'AASSUBC' #FUNCTION #EMP-NUM1 */ /* */ /* WHERE #EMP-NUM1 IS AN EIGHT BYTE FIELD */ /* */ /* PT - PUT OUTPUT BY OFFSET */ /* THE OFFSET MUST BE SET TO 0 FOR THE FIRST CALL ONLY!! */ /* THE OFFSET IS INCREMENTED FOLLOWING EACH CALL BY THE */ /* DATA MOVER PROGRAM */ /* THE LENGTH OF THE REQUESTED DATA MUST BE PROVIDED FOR */ /* EACH CALL. IT SHOULD MATCH THE LENGTH OF THE AREA */ /* PROVIDED CONTAINING THE OUTPUT DATA */ /* IE: MOVE #FUNC-PT TO #FUNCTION */ /* MOVE 8 TO #LENGTH */ /* MOVE 0 TO OFFSET - FIRST CALL ONLY */ /* CALL 'AASSUBC' #FUNCTION #EMP-NUM1 */ /* */ /* WHERE #EMP-NUM1 IS AN EIGHT BYTE FIELD */ /* */
/* LI - GET LENGTH OF INPUT DATA */ /* UPDATES THE #LENGTH FIELD WITH THE TOTAL LENGTH OF */ /* ALL INPUT PARMS. NO OTHER PARMS ARE NEEDED */ /* IE: MOVE #FUNC-LI TO #FUNCTION */ /* CALL 'AASSUBC' #FUNCTION */ /* */ /* */ /* LC - GET LENGTH OF COMMAREA USED TO SEND DATA. */ /* UPDATES THE #LENGTH FIELD WITH THE COMMAREA LENGTH. */ /* NO OTHER PARMS ARE NEEDED */ /* IE: MOVE #FUNC-LC TO #FUNCTION */ /* CALL 'AASSUBC' #FUNCTION */ /* */ /* IMPLEMENTED RESPONSE-CODES: */ /* 0 - OPERATION COMPLETED SUCCESSFULLY */ /* 4 - ENDDATA - OFFSET EXCEEDS END OF INPUT DATA. */ /* INDICATES NO FURTHER INPUT IS AVAILABLE */ /* 8 - ENDBUFF - OFFSET + LENGTH IS GREATER THEN COMMAREA */ /* */ /* NOTE: */ /* ALWAYS USE THE FIRST FIELD OF A GROUP WHEN CALLING */ /* DATA MOVER PROGRAMS. NOTICE ALL CALLS ARE MADE WITH */ /* #FUNCTION NOT #REQUEST-PARMS. */ /* */ /* ALL INPUT PARMS MUST BE PROCESSED BEFORE OUTPUT. */ /*------------------------------------------------------------*/
DEFINE DATA LOCAL 1 #FUNC-TYPE 2 #FUNC-GT (A2) INIT<'GT'> 2 #FUNC-PT (A2) INIT<'PT'> 2 #FUNC-LC (A2) INIT<'LC'> 2 #FUNC-LI (A2) INIT<'LI'> 1 #REQUEST-PARMS 2 #FUNCTION (A2) /*GT,PT,LC,LI 2 #OFFSET (I2) /*DATA OFFSET OF INPUT/OUTPUT 2 #LENGTH (I2) /*LENGTH OF DATA TO GET OR PUT 2 #RESPONSE-CODE (I4) 2 #ERR-MESSAGE (A72) 1 #PARMS 2 #EMP-NUM1 (A8) 2 #EMP-NUM2 (A8) 1 EMPLOY-VIEW VIEW OF EMPLOYEES1 2 PERSONNEL-ID 2 FIRST-NAME 2 NAME 2 MAR-STAT 2 SEX 2 BIRTH 2 DEPT 2 JOB-TITLE 2 CURR-CODE(1:5) 2 SALARY(N9/1:5) 1 #ERROR-PARMS 2 #NATPROG (A8) 2 #NATMSG (A65) 2 #NATERR (A7) END-DEFINE /* USE LI FUNCTION TO THE GET LENGTH OF INPUT PARAMETERS */ MOVE #FUNC-LI TO #FUNCTION CALL 'AASSUBC' #REQUEST-PARMS IF #LENGTH LT 16 /*REQUIRED FOR THIS PROGRAM*/ THEN TERMINATE END-IF /* USE GET FUNCTION TO RETRIEVE DATA PARMS */ MOVE 8 TO #LENGTH MOVE 0 TO #OFFSET MOVE #FUNC-GT TO #FUNCTION CALL 'AASSUBC' #FUNCTION #EMP-NUM1 CALL 'AASSUBC' #FUNCTION #EMP-NUM2 MOVE 0 TO #OFFSET MOVE 147 TO #LENGTH MOVE #FUNC-PT TO #FUNCTION
FIND ALL EMPLOY-VIEW WITH PERSONNEL-ID = #EMP-NUM1 THRU #EMP-NUM2
IF NO RECORDS FOUND
MOVE *PROGRAM TO #NATPROG
MOVE ' REQUESTED EMPLOYEE NUMBERS NOT IN THE DATABASE' TO #NATMSG
MOVE 80 TO #LENGTH
MOVE #FUNC-PT TO #FUNCTION
CALL 'AASSUBC' #FUNCTION #NATPROG
TERMINATE
END-NOREC
CALL 'AASSUBC' #FUNCTION PERSONNEL-ID
END-FIND
ON ERROR
MOVE *PROGRAM TO #NATPROG
DECIDE FOR FIRST CONDITION
WHEN *ERROR-NR = 1106
MOVE ' EMPLOYEE NUMBER IS TOO LARGE. 8 BYTES IS '
TO #NATMSG
MOVE 'THE MAX' TO #NATERR
WHEN *ERROR-NR = 3061
MOVE ' INVALID EMPLOYEE NUMBER RANGE SPECIFIED '
TO #NATMSG
MOVE ' ' TO #NATERR
WHEN NONE
MOVE ' HAS DETECTED THE FOLLOWING ERROR NUMBER: '
TO #NATMSG
MOVE *ERROR-NR TO #NATERR
END-DECIDE
MOVE 80 TO #LENGTH
CALL 'AASSUBC' #FUNCTION #NATPROG
TERMINATE
END-ERROR
END