Recommended Reading

Sample ADS Code

This is an ADSORPTS ( similar to a compilation listing ) of a small menu program which was written some time ago.

It will give a feel for ads syntax to anyone who has never seen it before.

It is the entry dialog to an application and acts as a menu to other functions.

For ADS users it is worth noting the use of NOSAVE at various points. This removes the overhead of ADS currency save/restore which accounts for most of the increased cpu (and i/o) of ADS compared to DC-COBOL. It also allows this dialog to run retrieval nolock (provided this is allowed by sysgen) even though the invoked dialogs are update.


Sample ADS Code

ADSORPTS S10213      COMPUTER ASSOCIATES INTERNATIONAL
PREMAP PROCESS: RVM980-PP                           VERS.: 0001
     00000100  READY MARC-REGION    USAGE-MODE IS RETRIEVAL.
     00000200  READY RVPARAM-REGION USAGE-MODE IS RETRIEVAL.
     00000300
     00000400  IF FIRST-TIME THEN
     00000500     DO.
     00000600       INITIALIZE RECORDS (RVWRM-MARC-GLOBAL).
     00000700       ACCEPT USER ID           INTO RVWRM-G-USER-ID8.
     00000800       ACCEPT PTERM ID          INTO RVWRM-G-VDU-ID.
     00000900
     00001000       MOVE 'RVB001' TO RV36-PROGRAM-NO.
     00001100       OBTAIN CALC RV36SYS.
     00001200       MOVE RV36-PROGRAM-NO-FILLER-160 TO RVB001-RV36SYS-RVB001.
     00001300       MOVE RVB001-COUNTRY             TO RVMG-MARC-LOC-NAME.
     00001400       MOVE RVB001-ML-REF-LOCN-CD      TO RVMG-MARC-LOC.
     00001500
     00001600       IF RVMG-MARC-LOC EQ '  '  THEN DO
     00001700          MOVE 'XX' TO RVMG-MARC-LOC.
     00001800       END.
     00001900     END.
     00002000
     00002100  MOVE DATE             TO RVWRM-G-DATE-YMD-99.
     00002200  MOVE RVWRM-G-YEAR-99  TO RVWRM-G-YEAR2-99.
     00002300  MOVE RVWRM-G-MONTH-99 TO RVWRM-G-MONTp-99.
     00002400  MOVE RVWRM-G-DAY-99   TO RVWRM-G-DAY2-99.
     00002500  !
     00002600  MOVE TIME             TO RVWRM-G-TIME-HHMMSS-99.
     00002700  MOVE RVWRM-G-TIME-HH  TO RVWRM-G-TIME-HH-99.
     00002800  MOVE RVWRM-G-TIME-MM  TO RVWRM-G-TIME-MM-99.
     00002900  MOVE RVWRM-G-TIME-SS  TO RVWRM-G-TIME-SS-99.
     00003000  !
     00003100  MOVE RVMG-MARC-LOC    TO RVMG-MARC-QLOC.
     00003200  !
     00003300  MOVE SPACES           TO RVMG-MARC-QNAME.
     00003400  !
     00003500  MOVE ZERO             TO RVMG-MARC-FILE-SEQ.
     00003600  MOVE SPACES           TO RVMG-MARC-INTF.
     00003700  MOVE SPACES           TO RVMG-SOURCE-SYSTEM.
     00003800  MOVE 1                TO RVMG-MARC-FILE-VER.
     00003900  MOVE ZERO             TO RVMG-SELECTION.
     00004000  DISPLAY.

RESPONSE PROCESS: RVM980-RPE VERS.: 0001 00000100 IF FIELD RVMG-MARC-QNAME CHANGED THEN 00000200 DO. 00000300 INITIALIZE RECORD (MC01-QUEUE-HDR). 00000400 MOVE RVMG-MARC-QNAME TO MC01-MARC-INTF. 00000500 IF RVMG-MARC-QNAME NE 'ARCHIVED' AND 00000600 RVMG-MARC-QNAME NE 'HOLDOVER' AND 00000700 RVMG-MARC-QNAME NE 'RESTORED' THEN 00000800 MOVE RVMG-MARC-QLOC TO MC01-MARC-LOC. 00000900 FIND CALC MC01-QUEUE-HDR. 00001000 IF DB-REC-NOT-FOUND THEN 00001100 DISPLAY MESSAGE TEXT IS '*** QUEUE NOT FOUND ***'. 00001200 ELSE 00001300 INVOKE NOSAVE 'RVD982'. 00001400 END. 00001500 IF ANY OF ( RVMG-MARC-LOC, 00001600 RVMG-MARC-FILE-SEQ, 00001700 RVMG-MARC-INTF, 00001800 RVMG-SOURCE-SYSTEM, 00001900 RVMG-MARC-FILE-VER ) CHANGED THEN 00002000 DO. 00002100 INITIALIZE RECORD (MC02-FILE-HDR). 00002200 MOVE RVMG-MARC-FILE TO MC02-MARC-FILE. 00002300 FIND CALC MC02-FILE-HDR. 00002400 IF DB-REC-NOT-FOUND THEN 00002500 DISPLAY MESSAGE TEXT IS '*** FILE NOT FOUND ***'. 00002600 ELSE 00002700 OBTAIN OWNER WITHIN MC01-MC02. 00002800 IF MC01-MARC-INTF EQ 'ARCHIVED' THEN 00002900 INVOKE NOSAVE 'RVD984'. 00003000 ELSE 00003100 INVOKE NOSAVE 'RVD986'. 00003200 END. 00003300 IF RVMG-SELECTION EQ 1 THEN 00003400 DO. 00003500 MOVE 'ARCHIVED' TO RVMG-MARC-QNAME. 00003600 INVOKE NOSAVE 'RVD985'. 00003700 END. 00003800 IF RVMG-SELECTION EQ 2 THEN 00003900 DO. 00004000 MOVE SPACES TO RVMG-ACTION. 00004100 MOVE 'HOLDOVER' TO RVMG-MARC-QNAME. 00004200 INVOKE NOSAVE 'RVD983'. 00004300 END. 00004400 IF RVMG-SELECTION EQ 3 THEN 00004500 DO. 00004600 MOVE SPACES TO RVMG-ACTION. 00004700 MOVE 'OUTGOING' TO RVMG-MARC-QNAME. 00004800 INVOKE NOSAVE 'RVD983'. 00004900 END. 00005000 IF RVMG-SELECTION EQ 4 THEN 00005100 DO. 00005200 MOVE SPACES TO RVMG-ACTION. 00005300 MOVE 'RESTORED' TO RVMG-MARC-QNAME. 00005400 INVOKE NOSAVE 'RVD983'. 00005500 END. 00005600 IF RVMG-SELECTION EQ 5 THEN 00005700 INVOKE NOSAVE 'RVD981'. 00005800 IF RVMG-SELECTION EQ 6 THEN 00005900 DO. 00006000 MOVE 'ACK' TO RVMG-ACTION. 00006100 MOVE 'HOLDOVER' TO RVMG-MARC-QNAME. 00006200 INVOKE NOSAVE 'RVD983'. 00006300 END. 00006400 IF RVMG-SELECTION EQ 7 THEN 00006500 DO. 00006600 INVOKE NOSAVE 'RVD987'. 00006700 END. 00006800 DISPLAY MSG TEXT IS 00006900 '*** INVALID SELECTION. ENTER A DISPLAYED VALUE ***'.

Back to sample list

Home



© Copyright IT Doctors.co.uk. 2002