ILE COBOL Programmer's Guide


Accessing User Spaces Using Pointers and APIs

The following example shows how you can use pointers to access user spaces and to chain records together.

POINTA is a program that reads customer names and addresses into a user space, and then displays the information in a list. The program assumes that the customer information exists in a file called POINTACU.

The customer address field is a variable-length field, to allow for lengthy addresses.

Figure 82. Example Using Pointers to Access User Spaces -- DDS


 ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
      A* THIS IS THE CUSTOMER INFORMATION FILE  - POINTACUST
      A
      A
      A          R FSCUST                    TEXT('CUSTOMER MASTER RECORD')
      A            FS_CUST_NO     8S00       TEXT('CUSTOMER NUMBER')
      A                                      ALIAS(FS_CUST_NUMBER)
      A            FS_CUST_NM    20          TEXT('CUSTOMER NAME')
      A                                      ALIAS(FS_CUST_NAME)
      A            FS_CUST_AD   100          TEXT('CUSTOMER ADDRESS')
      A                                      ALIAS(FS_CUST_ADDRESS)
      A                                      VARLEN

Figure 83. Example Using Pointers to Access User Spaces


 5722WDS V5R3M0  030905 LN  IBM ILE COBOL         CBLGUIDE/POINTA     ISERIES1   03/09/15 13:43:25        Page      2
                                     S o u r c e
  STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S COPYNAME   CHG DATE
           000100 PROCESS varchar  (1)
     1     000200 ID DIVISION.
           000300* This program reads in a file of variable length records
           000400*  into a user space.  It then shows the records on
           000500*  the display.
     2     000600 PROGRAM-ID. pointa.
     3     000700 ENVIRONMENT DIVISION.
     4     000800 CONFIGURATION SECTION.
     5     000900 SPECIAL-NAMES. CONSOLE IS CRT,
     7     001000                CRT STATUS IS ws-crt-status.  (2)
     8     001100 INPUT-OUTPUT SECTION.
     9     001200 FILE-CONTROL.
    10     001300     SELECT cust-file ASSIGN TO DATABASE-pointacu
    12     001400            ORGANIZATION IS SEQUENTIAL
    13     001500            FILE STATUS IS ws-file-status.
    14     001600 DATA DIVISION.
    15     001700 FILE SECTION.
    16     001800 FD  cust-file.
    17     001900 01  fs-cust-record.
           002000* copy in field names turning underscores to dashes
           002100*  and using alias names
           002200 COPY DDR-ALL-FORMATS-I OF pointacu.
    18    +000001       05  POINTACU-RECORD PIC X(130).                                        <-ALL-FMTS
          +000002*    I-O FORMAT:FSCUST     FROM FILE POINTACU   OF LIBRARY CBLGUIDE           <-ALL-FMTS
          +000003*                          CUSTOMER MASTER RECORD                             <-ALL-FMTS
    19    +000004       05  FSCUST        REDEFINES POINTACU-RECORD.                           <-ALL-FMTS
    20    +000005           06 FS-CUST-NUMBER        PIC S9(8).                                <-ALL-FMTS
          +000006*                  CUSTOMER NUMBER                                            <-ALL-FMTS
    21    +000007           06 FS-CUST-NAME          PIC X(20).                                <-ALL-FMTS
          +000008*                  CUSTOMER NAME                                              <-ALL-FMTS
    22    +000009           06 FS-CUST-ADDRESS.  (3)                                           <-ALL-FMTS
          +000010*                  (Variable length field)                                    <-ALL-FMTS
    23    +000011                49 FS-CUST-ADDRESS-LENGTH                                     <-ALL-FMTS
          +000012                                    PIC S9(4) COMP-4.                         <-ALL-FMTS
    24    +000013                49 FS-CUST-ADDRESS-DATA                                       <-ALL-FMTS
          +000014                                    PIC X(100).                               <-ALL-FMTS
          +000015*                  CUSTOMER ADDRESS                                           <-ALL-FMTS
    25     002300 WORKING-STORAGE SECTION.
    26     002400 01  ws-file-status.
    27     002500     05 ws-file-status-1 PIC X.
    28     002600        88  ws-file-stat-good   VALUE "0".
    29     002700        88  ws-file-stat-at-end VALUE "1".
    30     002800     05 ws-file-status-2 PIC X.
    31     002900 01  ws-crt-status.  (4)
    32     003000     05 ws-status-1           PIC 9(2).
    33     003100        88 ws-status-1-ok       VALUE 0.
    34     003200        88 ws-status-1-func-key VALUE 1.
    35     003300        88 ws-status-1-error    VALUE 9.
    36     003400     05 ws-status-2           PIC 9(2).
    37     003500        88 ws-func-03           VALUE 3.
    38     003600        88 ws-func-07           VALUE 7.
    39     003700        88 ws-func-08           VALUE 8.
    40     003800     05 ws-status-3           PIC 9(2).
 5722WDS V5R3M0  030905 LN  IBM ILE COBOL                 CBLGUIDE/POINTA          ISERIES1   03/09/15 13:43:25        Page      3
  STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S COPYNAME   CHG DATE
    41     003900 01  ws-params.  (5)
    42     004000     05  ws-space-ptr         POINTER.  (6)
    43     004100     05  ws-space.
    44     004200       10  ws-space-name      PIC X(10) VALUE "MYSPACE".
    45     004300       10  ws-space-lib       PIC X(10) VALUE "QTEMP".
    46     004400     05  ws-attr              PIC X(10) VALUE "PF".
    47     004500     05  ws-init-size         PIC S9(5) VALUE 32000 BINARY.
    48     004600     05  ws-init-char         PIC X     VALUE SPACE.
    49     004700     05  ws-auth              PIC X(10) VALUE "*ALL".
    50     004800     05  ws-text              PIC X(50) VALUE
           004900                              "Customer Information Records".
    51     005000     05  ws-replace           PIC X(10) VALUE "*YES".
    52     005100     05  ws-err-data.  (7)
    53     005200         10 ws-input-l        PIC S9(6) BINARY VALUE 16.
    54     005300         10 ws-output-l       PIC S9(6) BINARY.
    55     005400         10 ws-exception-id   PIC X(7).
    56     005500         10 ws-reserved       PIC X(1).
           005600
    57     005700 77  ws-accept-data           PIC X   VALUE SPACE.
    58     005800   88 ws-acc-blank             VALUE SPACE.
    59     005900   88 ws-acc-create-space      VALUE "Y", "y".
    60     006000   88 ws-acc-use-prv-space     VALUE "N", "n".
    61     006100   88 ws-acc-delete-space      VALUE "Y", "y".
    62     006200   88 ws-acc-save-space        VALUE "N", "n".
           006300
    63     006400 77  ws-prog-indicator        PIC X   VALUE "G".
    64     006500   88  ws-prog-continue        VALUE "G".
    65     006600   88  ws-prog-end             VALUE "C".
    66     006700   88  ws-prog-loop            VALUE "L".
           006800
    67     006900 77  ws-line                  PIC 99.
           007000* error message line
    68     007100 77  ws-error-msg             PIC X(50) VALUE SPACES.
           007200* more address information indicator
    69     007300 77  ws-plus                  PIC X.
           007400* length of address information to display
    70     007500 77  ws-temp-size             PIC 9(2).
           007600
    71     007700 77  ws-current-rec           PIC S9(4) VALUE 1.
    72     007800 77  ws-old-rec               PIC S9(4) VALUE 1.
    73     007900 77  ws-old-space-ptr         POINTER.
           008000* max number of lines to display
    74     008100 77  ws-displayed-lines       PIC S99 VALUE 20.
           008200* line on which to start displaying records
    75     008300 77  ws-start-line            PIC S99 VALUE 5.
           008400* variables to create new record in space
    76     008500 77  ws-addr-inc              PIC S9(4) PACKED-DECIMAL.
    77     008600 77  ws-temp                  PIC S9(4) PACKED-DECIMAL.
    78     008700 77  ws-temp-2                PIC S9(4) PACKED-DECIMAL.
           008800* pointer to previous record
    79     008900 77  ws-cust-prev-ptr         POINTER VALUE NULL.
    80     009000 LINKAGE SECTION.
    81     009100 01 ls-header-record.  (8)
    82     009200    05  ls-hdr-cust-ptr             USAGE POINTER.
           009300* number of records read in from file
 5722WDS V5R3M0  030905 LN  IBM ILE COBOL                 CBLGUIDE/POINTA          ISERIES1   03/09/15 13:43:25        Page      4
  STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S COPYNAME   CHG DATE
    83     009400    05  ls-record-counter           PIC S9(3) BINARY.
    84     009500    05  FILLER                      PIC X(14).  (9)
    85     009600 01 ls-user-space.  (10)
    86     009700     05  ls-customer-rec.
           009800* pointer to previous customer record
    87     009900         10 ls-cust-prev-ptr        USAGE POINTER.
    88     010000         10 ls-cust-rec-length      PIC S9(4) BINARY.
    89     010100         10 ls-cust-name            PIC X(20).
    90     010200         10 ls-cust-number          PIC S9(8).
           010300* total length of this record including filler bytes
           010400*  to make sure next record on 16 byte boundary
    91     010500         10 ls-cust-address-length  PIC S9(4) BINARY.
    92     010600     05  ls-cust-address-data       PIC X(116).
           010700
           010800* Size of ls-user-space is 16 more than actually needed.
           010900* This allows the start address of the next record
           011000* to be established without exceeding the declared size.
           011100* The size is 16 bigger to allow for pointer alignment.
           011200
    93     011300 PROCEDURE DIVISION.
           011400* note no need for "USING" entry on PROC... DIV.
    94     011500 DECLARATIVES.
           011600 cust-file-para SECTION.
           011700     USE AFTER ERROR PROCEDURE ON cust-file.
           011800 cust-file-para-2.
    95     011900     MOVE "Error XX on file pointacu" TO ws-error-msg.
    96     012000     MOVE ws-file-status TO ws-error-msg(7:2).
           012100 END DECLARATIVES.
           012200
           012300 main-program section.
           012400 mainline.
           012500* keep reading initial display until entered data correct
    97     012600     SET ws-prog-loop TO TRUE.
    98     012700     PERFORM initial-display THRU read-initial-display
           012800         UNTIL NOT ws-prog-loop.
           012900* if want to continue with program and want to create
           013000*   customer information area, fill the space with
           013100*   records from the customer file
    99     013200     IF ws-prog-continue AND
           013300        ws-acc-create-space THEN
   100     013400       PERFORM read-customer-file
   101     013500       MOVE 1 TO ws-current-rec
           013600* set ptr to header record
   102     013700       SET ADDRESS OF ls-header-record TO ws-space-ptr
           013800* set to first customer record in space
   103     013900       SET ADDRESS OF ls-user-space TO ls-hdr-cust-ptr
           014000     END-IF.
   104     014100     IF ws-prog-continue THEN
   105     014200       PERFORM main-loop UNTIL ws-prog-end
           014300     END-IF.
           014400 end-program.
   106     014500     PERFORM clean-up.
   107     014600     STOP RUN.
           014700
           014800 initial-display.  (11)
 5722WDS V5R3M0  030905 LN  IBM ILE COBOL                 CBLGUIDE/POINTA          ISERIES1   03/09/15 13:43:25        Page      5
  STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S COPYNAME   CHG DATE
   108     014900     DISPLAY "Create Customer Information Area" AT 0118 WITH
           015000                BLANK SCREEN REVERSE-VIDEO
           015100             "Create customer information area (Y/N)=>   <="
           015200                AT 1015
           015300             "F3=Exit" AT 2202.
   109     015400     IF ws-error-msg NOT = SPACES THEN
   110     015500       DISPLAY ws-error-msg at 2302 with beep highlight
   111     015600       MOVE SPACES TO ws-error-msg
           015700     END-IF.
           015800
           015900 read-initial-display.  (12)
   112     016000     ACCEPT ws-accept-data AT 1056 WITH REVERSE-VIDEO
           016100       ON EXCEPTION
   113     016200         IF ws-status-1-func-key THEN
   114     016300           IF ws-func-03 THEN
   115     016400             SET ws-prog-end TO TRUE
           016500           ELSE
   116     016600             MOVE "Invalid Function Key" TO ws-error-msg
           016700           END-IF
           016800         ELSE
   117     016900           MOVE "Unknown Error" TO ws-error-msg
           017000         END-IF
           017100       NOT ON EXCEPTION
   118     017200         IF ws-acc-create-space THEN
   119     017300           PERFORM create-space THRU set-space-ptrs
   120     017400           SET ws-prog-continue TO TRUE
           017500         ELSE
   121     017600           IF ws-acc-use-prv-space THEN
   122     017700             PERFORM get-space
   123     017800             IF ws-space-ptr = NULL
   124     017900               MOVE "No Customer Information Area" TO ws-error-msg
           018000             ELSE
   125     018100               PERFORM set-space-ptrs
   126     018200               SET ws-prog-continue TO TRUE
           018300             END-IF
           018400           ELSE
   127     018500             MOVE "Invalid Character Entered" TO ws-error-msg
           018600           END-IF
           018700         END-IF
           018800     END-ACCEPT.
           018900
           019000 create-space.
   128     019100     CALL "QUSCRTUS" USING ws-space, ws-attr, ws-init-size,  (13)
           019200                           ws-init-char, ws-auth, ws-text,
           019300                           ws-replace, ws-err-data.
           019400
           019500* checks for errors in creating the space could be added here
           019600
           019700 get-space.
   129     019800     CALL "QUSPTRUS" USING ws-space, ws-space-ptr, ws-err-data.  (14)
           019900
           020000 set-space-ptrs.
           020100* set header record to beginning of space
   130     020200     SET ADDRESS OF ls-header-record  (15)
           020300         ADDRESS OF ls-user-space  (16)
 5722WDS V5R3M0  030905 LN  IBM ILE COBOL                 CBLGUIDE/POINTA          ISERIES1   03/09/15 13:43:25        Page      6
  STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S COPYNAME   CHG DATE
           020400         TO ws-space-ptr.
           020500* set first customer record after header record
   131     020600     SET ADDRESS OF ls-user-space TO  (17)
           020700         ADDRESS OF ls-user-space(LENGTH OF ls-header-record  (18)
           020800                                  + 1:1).
           020900* save ptr to first record in  header record
   132     021000     SET ls-hdr-cust-ptr TO ADDRESS OF ls-user-space.
           021100
           021200 delete-space.
   133     021300     CALL "QUSDLTUS" USING ws-space, ws-err-data.  (19)
           021400
           021500 read-customer-file.
           021600* read all records from customer file and move into space
   134     021700     OPEN INPUT cust-file.
   135     021800     IF ws-file-stat-good THEN
   136     021900       READ cust-file AT END CONTINUE
           022000       END-READ
   138     022100       PERFORM VARYING ls-record-counter FROM 1 BY 1
           022200             UNTIL not ws-file-stat-good
   139     022300         SET  ls-cust-prev-ptr  TO ws-cust-prev-ptr
           022400*  Move information from file into space
   140     022500         MOVE fs-cust-name      TO ls-cust-name
   141     022600         MOVE fs-cust-number    TO ls-cust-number
   142     022700         MOVE fs-cust-address-length  TO ls-cust-address-length
   143     022800         MOVE fs-cust-address-data(1:fs-cust-address-length)
           022900              TO ls-cust-address-data(1:ls-cust-address-length)
           023000*  Save ptr to current record
   144     023100         SET  ws-cust-prev-ptr  TO ADDRESS OF ls-user-space
           023200*  Make sure next record on 16 byte boundary
   145     023300         ADD LENGTH OF ls-customer-rec  (20)
           023400             ls-cust-address-length TO 1 GIVING ws-addr-inc
   146     023500         DIVIDE ws-addr-inc BY 16 GIVING ws-temp
           023600             REMAINDER ws-temp-2
   147     023700         SUBTRACT ws-temp-2 FROM 16 GIVING ws-temp
           023800*  Save total record length in user space
   148     023900         ADD ws-addr-inc TO ws-temp GIVING ls-cust-rec-length
   149     024000         SET ADDRESS OF ls-user-space
           024100          TO ADDRESS OF ls-user-space(ls-cust-rec-length + 1:1)
           024200*  Get next record from file
   150     024300         READ cust-file AT END CONTINUE
           024400         END-READ
           024500       END-PERFORM
           024600*  At the end of the loop have one more record than really
           024700*   have
   152     024800       SUBTRACT 1 FROM ls-record-counter
           024900     END-IF.
   153     025000     CLOSE cust-file.
           025100
           025200 main-loop.  (21)
           025300* write the records to the display until F3 entered
   154     025400     DISPLAY "Customer Information" AT 0124 WITH
           025500                BLANK SCREEN REVERSE-VIDEO
           025600             "Cust     Customer Name        Customer"
           025700                AT 0305
           025800             " Address"
 5722WDS V5R3M0  030905 LN  IBM ILE COBOL                 CBLGUIDE/POINTA          ISERIES1   03/09/15 13:43:25        Page      7
  STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S COPYNAME   CHG DATE
           025900             "Number"   AT 0405
           026000             "F3=Exit" AT 2202.
           026100* if a pending error put on the display
   155     026200     IF ws-error-msg NOT = SPACES THEN
   156     026300       DISPLAY ws-error-msg at 2302 with beep highlight
   157     026400       MOVE SPACES TO ws-error-msg
           026500     END-IF.
           026600* if in the middle of the list put F7 on the display
   158     026700     IF ws-current-rec > 1 THEN  (22)
   159     026800       DISPLAY "F7=Back" AT 2240
           026900     END-IF.
           027000* save the current record
   160     027100     MOVE ws-current-rec TO ws-old-rec.
   161     027200     SET  ws-old-space-ptr TO ADDRESS OF ls-user-space.  (23)
           027300* move each record to the display
   162     027400     PERFORM VARYING ws-line FROM  ws-start-line BY 1
           027500         UNTIL ws-line > ws-displayed-lines or
           027600               ws-current-rec > ls-record-counter
           027700* if address is greater than display width show "+"
   163     027800         IF ls-cust-address-length > 40 THEN
   164     027900           MOVE "+" TO ws-plus
   165     028000           MOVE 40 TO ws-temp-size
           028100         ELSE
   166     028200           MOVE ls-cust-address-length TO ws-temp-size
   167     028300           MOVE SPACE TO ws-plus
           028400         END-IF
   168     028500         DISPLAY ls-cust-number at line ws-line column 5
           028600                 ls-cust-name ls-cust-address-data with
           028700                   size ws-temp-size ws-plus at line
           028800                   ws-line column 78
           028900* get next record in the space
   169     029000         ADD 1 TO ws-current-rec
   170     029100         SET ADDRESS OF ls-user-space
           029200          TO ADDRESS OF ls-user-space
           029300            (ls-cust-rec-length + 1:1)
           029400     END-PERFORM.
           029500* if can go forward put F8 on the display
   171     029600     IF ws-current-rec < ls-record-counter THEN  (22)
   172     029700       DISPLAY "F8=Forward" AT 2250
           029800     END-IF.
           029900* check to see if continue, exit, or get next records or
           030000*   previous records
   173     030100     SET ws-acc-blank to TRUE.
   174     030200     ACCEPT ws-accept-data WITH SECURE  (24)
           030300       ON EXCEPTION
   175     030400         IF ws-status-1-func-key THEN
   176     030500           IF ws-func-03 THEN
   177     030600             SET ws-prog-end TO TRUE
           030700           ELSE
   178     030800            IF ws-func-07 THEN
   179     030900             PERFORM back-screen
           031000            ELSE
   180     031100            IF ws-func-08 THEN
   181     031200             PERFORM forward-screen
           031300            ELSE
 5722WDS V5R3M0  030905 LN  IBM ILE COBOL                 CBLGUIDE/POINTA          ISERIES1   03/09/15 13:43:25        Page      8
  STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S COPYNAME   CHG DATE
   182     031400             MOVE "Invalid Function Key" TO ws-error-msg
   183     031500             MOVE ws-old-rec TO ws-current-rec
   184     031600             SET ADDRESS OF ls-user-space TO ws-old-space-ptr
           031700            END-IF
           031800           END-IF
           031900         ELSE
   185     032000           MOVE "Unknown Error" TO ws-error-msg
   186     032100           MOVE ws-old-rec TO ws-current-rec
   187     032200           SET ADDRESS OF ls-user-space TO ws-old-space-ptr
           032300         END-IF
           032400       NOT ON EXCEPTION
   188     032500         MOVE ws-old-rec TO ws-current-rec
   189     032600         SET ADDRESS OF ls-user-space TO ws-old-space-ptr
           032700     END-ACCEPT.
           032800
           032900 clean-up.
           033000* do clean up for program
           033100* keep reading end display until entered data correct
   190     033200     SET ws-prog-loop to TRUE.
   191     033300     SET ws-acc-blank to TRUE.
   192     033400     PERFORM final-display THRU read-final-display  (25)
           033500         UNTIL NOT ws-prog-loop.
           033600
           033700 final-display.
   193     033800     DISPLAY "Delete Customer Information Area" AT 0118 WITH  (26)
           033900                BLANK SCREEN REVERSE-VIDEO
           034000             "Delete customer information area (Y/N)=>   <="
           034100                AT 1015
           034200             "F3=Exit" AT 2202.
   194     034300     IF ws-error-msg NOT = SPACES THEN
   195     034400       DISPLAY ws-error-msg at 2302 with beep highlight
   196     034500       MOVE SPACES TO ws-error-msg
           034600     END-IF.
           034700
           034800 read-final-display.
   197     034900     ACCEPT ws-accept-data AT 1056 WITH REVERSE-VIDEO
           035000       ON EXCEPTION
   198     035100         IF ws-status-1-func-key THEN
   199     035200           IF ws-func-03 THEN
   200     035300             SET ws-prog-end TO TRUE
           035400           ELSE
   201     035500             MOVE "Invalid Function Key" TO ws-error-msg
           035600           END-IF
           035700         ELSE
   202     035800           MOVE "Unknown Error" TO ws-error-msg
           035900         END-IF
           036000       NOT ON EXCEPTION
   203     036100         IF ws-acc-delete-space THEN
   204     036200           PERFORM delete-space
   205     036300           SET ws-prog-continue TO TRUE
           036400         ELSE
   206     036500           IF ws-acc-save-space THEN
   207     036600             SET ws-prog-continue TO TRUE
           036700           ELSE
   208     036800             MOVE "Invalid Character Entered" TO ws-error-msg
 5722WDS V5R3M0  030905 LN  IBM ILE COBOL                 CBLGUIDE/POINTA          ISERIES1   03/09/15 13:43:25        Page      9
  STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S COPYNAME   CHG DATE
           036900           END-IF
           037000         END-IF
           037100     END-ACCEPT.
           037200
           037300 back-screen.  (27)
   209     037400     IF ws-old-rec <= 1 THEN
   210     037500       MOVE "Top of customer records" TO ws-error-msg
   211     037600       MOVE ws-old-rec TO ws-current-rec  (28)
   212     037700       SET ADDRESS OF ls-user-space TO ws-old-space-ptr
           037800     ELSE
   213     037900       MOVE ws-old-rec TO ws-current-rec  (28)
   214     038000       SET ADDRESS OF ls-user-space TO ws-old-space-ptr
   215     038100       PERFORM VARYING ws-line FROM ws-start-line BY 1
           038200         UNTIL ws-line > ws-displayed-lines or
           038300               ws-current-rec <= 1
           038400* Back up one record at a time
   216     038500         SET ws-cust-prev-ptr TO ls-cust-prev-ptr  (29)
   217     038600         SET ADDRESS OF ls-user-space TO ws-cust-prev-ptr
   218     038700         SUBTRACT 1 FROM ws-current-rec
           038800       END-PERFORM
           038900     END-IF.
           039000
           039100 forward-screen.  (30)
           039200* if current record greater or equal to the max records
           039300*   print error, have reached max records
   219     039400     IF ws-current-rec >= ls-record-counter
   220     039500       MOVE "No more customer records" TO ws-error-msg
   221     039600       MOVE ws-old-rec TO ws-current-rec
   222     039700       SET ADDRESS OF ls-user-space TO ws-old-space-ptr
           039800     ELSE
   223     039900       MOVE ws-current-rec TO ws-old-rec
   224     040000       SET ws-old-space-ptr TO ADDRESS OF ls-user-space
           040100     END-IF.
           040200
                           * * * * *   E N D   O F   S O U R C E   * * * * *

(2)
CRT STATUS IS specifies a data name into which a status value is placed after the termination of an extended ACCEPT statement. In this example, the STATUS key value is used to determine which function key was pressed.

(3)
fs-cust-address is a variable-length field. To see meaningful names here rather than FILLER, specify *VARCHAR for the CVTOPT parameter of the CRTCBLMOD or CRTBNDCBL commands, or VARCHAR in the PROCESS statement, as shown in (1). For more information about variable-length fields, refer to Declaring Data Items Using SAA Data Types.

(4)
CRT STATUS as mentioned in (2) is defined here.

(5)
The ws-params structure contains the parameters used when calling the APIs to access user spaces.

(6)
ws-space-ptr defines a pointer data item set by the API QUSPTRUS. This points to the beginning of the user space, and is used to set the addresses of items in the Linkage Section.

(7)
ws-err-data is the structure for the error parameter for the user space APIs. Note that the ws-input-l is zero, meaning that any exceptions are signalled to the program, and not passed in the error code parameter. For more information on error code parameters, refer to the CL and APIs section of the Programming category in the iSeries 400 Information Center at this Web site -http://publib.boulder.ibm.com/pubs/html/as400/infocenter.htm.

(8)
The first data structure (ls-header-record) to be defined in the user space.

(9)
FILLER is used to maintain pointer alignment, because it makes Is-header-record a multiple of 16 bytes long.

(10)
The second data structure (ls-user-space) to be defined in the user space.

(11)
initial-display shows the Create Customer Information Area display.

(12)
read-initial-display reads the first display, and determines if the user chooses to continue or end the program. If the user continues the program by pressing Enter, then the program checks ws-accept-data to see if the customer information area is to be created.

(13)
QUSCRTUS is an API used to create user spaces.

(14)
QUSPTRUS is an API used to return a pointer to the beginning of a user space.

(15)
Maps the first data structure (ls-header-record) over the beginning of the user space.

(16)
Maps the second data structure (ls-user-space) over the beginning of the user space.

(17)
Uses ADDRESS OF special register

(18)
Uses ADDRESS OF, not the ADDRESS OF special register, because it is reference modified.

(19)
QUSDLTUS is an API used to delete a user space.

(20)
The following four arithmetic statements calculate the total length of each record, and ensure that each record is a multiple of 16 bytes in length.

(21)
main-loop puts up the Customer Information display.

(22)
These statements determine if the program should display function keys F7 and F8.

(23)
Saves a pointer to the first customer record on the display.

(24)
This ACCEPT statement waits for input from the Customer Information display. Based on the function key pressed, it calls the appropriate paragraph to display the next set of records (forward-screen), or the previous set of records (back-screen), or sets an indicator to end the routine if F3 is pressed.

(25)
The clean up routine displays the Delete Customer Information Area display until an appropriate key is pressed.

(26)
This statement puts up the Delete Customer Information Area display.

(27)
Each record contains a pointer to the previous customer record. The ADDRESS OF special register points to the current customer record. By changing the ADDRESS OF special register, the current customer record is changed.

back-screen moves the current record pointer backward one record at a time (29), by moving the pointer to the previous customer record into the pointer to the current customer record (ADDRESS OF). Before moving backward one record at a time, the program sets the current customer record to the first record currently displayed (28).

(30)
forward-screen sets ws-old-space-ptr (which points to the first record in the display) to point to the current record (which is after the last record displayed.)

A user space always begins on a 16-byte boundary, so the method illustrated here ensures that all records are aligned. ls-cust-rec-length is also used to chain the records together.

When you run POINTA, you see the following displays:

+--------------------------------------------------------------------------------+
| CMDSTR                          Start Commands                                 |
| Select one of the following:                                                   |
|   Commands                                                                     |
|      1. Start QSH                                                   QSH        |
|      2. Start RPC Binder Daemon                                     RPCBIND    |
|      4. Start AppDict Services/400                                  STRADS     |
|      7. Start AFP Utilities                                         STRAFPU    |
|      8. Start Advanced Print Function                               STRAPF     |
|                                                                                |
|     10. Start BEST/1 Planner                                        STRBEST    |
|     11. Start BGU                                                   STRBGU     |
|     12. Start Calendar Service                                      STRCALSRV  |
|     13. Start COBOL Debug                                           STRCBLDBG  |
|     14. Start CICS/400                                              STRCICS    |
|                                                                        More... |
| Selection or command                                                           |
| ===>call pointa                                                                |
|                                                                                |
| F3=Exit   F4=Prompt   F9=Retrieve   F12=Cancel   F16=Major menu                |
| (C) COPYRIGHT IBM CORP. 1980, 1998.                                            |
| Output file POINTSCREE created in library HORNER.                            + |
+--------------------------------------------------------------------------------+

+--------------------------------------------------------------------------------+
|                   Create Customer Information Area                             |
|                                                                                |
|                                                                                |
|                                                                                |
|               Create customer information area (Y/N)=> y <=                    |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|  F3=Exit                                                                       |
|                                                                                |
|                                                                                |
+--------------------------------------------------------------------------------+
+--------------------------------------------------------------------------------+
|                      Customer Information                                      |
|  Cust     Customer Name        Customer  Address                               |
|  Number                                                                        |
|  00000001 Bakery Unlimited     30 Bake Way, North York                         |
|  00000002 Window World         150 Eglinton Ave E., North York, Ontario        |
|  00000003 Jons Clothes         101 Park St, North Bay, Ontario, Canada         |
|  00000004 Pizza World          254 Main Street, Toronto, Ontario          +    |
|  00000005 Marv's Auto Body     9 George St, Peterborough, Ontario, Cana   +    |
|  00000006 Jack's Snacks        23 North St, Timmins, Ontario, Canada           |
|  00000007 Video World          14 Robson St, Vancouver, B.C, Canada            |
|  00000008 Pat's Daycare        8 Kingston Rd, Pickering, Ontario, Canad   +    |
|  00000009 Mary's Pies          3 Front St, Toronto, Ontario, Canada            |
|  00000010 Carol's Fashions     19 Spark St, Ottawa, Ontario, Canada            |
|  00000011 Grey Optical         5 Lundy's Lane, Niagara Falls, Ont. Cana   +    |
|  00000012 Fred's Forage        33 Dufferin St, Toronto, Ontario, Canada   +    |
|  00000013 Dave's Trucking      15 Water St, Guelph, Ontario, Canada            |
|  00000014 Doug's Music         101 Queen St. Toronto, Ontario, Canada     +    |
|  00000015 Anytime Copiers      300 Warden Ave, Scarborough, Ontario, Ca   +    |
|  00000016 Rosa's Ribs          440 Avenue Rd, Toronto, Ontario, Canada         |
|F3=Exit                                         F8=Forward                      |
+--------------------------------------------------------------------------------+
+--------------------------------------------------------------------------------+
|                      Customer Information                                      |
|  Cust     Customer Name        Customer  Address                               |
|  Number                                                                        |
|  00000017 Picture It           33 Kingston Rd, Ajax, Ontario, Canada           |
|  00000018 Paula's Flowers      144 Pape Ave, Toronto, Ontario, Canada          |
|  00000019 Mom's Diapers        101 Ford St, Toronto, Ontario, Canada           |
|  00000020 Chez Francois        1202 Rue Ste Anne, Montreal, PQ, Canada         |
|  00000021 Vetements de Louise  892 Rue Sherbrooke, Montreal E, PQ, Cana   +    |
|  00000022 Good Eats            355 Lake St, Port Hope, Ontario, Canada         |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|F3=Exit                               F7=Back                                   |
|                                                                                |
|                                                                                |
+--------------------------------------------------------------------------------+
+--------------------------------------------------------------------------------+
|                      Customer Information                                      |
|  Cust     Customer Name        Customer  Address                               |
|  Number                                                                        |
|  00000001 Bakery Unlimited     30 Bake Way, North York                         |
|  00000002 Window World         150 Eglinton Ave E., North York, Ontario        |
|  00000003 Jons Clothes         101 Park St, North Bay, Ontario, Canada         |
|  00000004 Pizza World          254 Main Street, Toronto, Ontario          +    |
|  00000005 Marv's Auto Body     9 George St, Peterborough, Ontario, Cana   +    |
|  00000006 Jack's Snacks        23 North St, Timmins, Ontario, Canada           |
|  00000007 Video World          14 Robson St, Vancouver, B.C, Canada            |
|  00000008 Pat's Daycare        8 Kingston Rd, Pickering, Ontario, Canad   +    |
|  00000009 Mary's Pies          3 Front St, Toronto, Ontario, Canada            |
|  00000010 Carol's Fashions     19 Spark St, Ottawa, Ontario, Canada            |
|  00000011 Grey Optical         5 Lundy's Lane, Niagara Falls, Ont. Cana   +    |
|  00000012 Fred's Forage        33 Dufferin St, Toronto, Ontario, Canada   +    |
|  00000013 Dave's Trucking      15 Water St, Guelph, Ontario, Canada            |
|  00000014 Doug's Music         101 Queen St. Toronto, Ontario, Canada     +    |
|  00000015 Anytime Copiers      300 Warden Ave, Scarborough, Ontario, Ca   +    |
|  00000016 Rosa's Ribs          440 Avenue Rd, Toronto, Ontario, Canada         |
|F3=Exit                                         F8=Forward                      |
+--------------------------------------------------------------------------------+
+--------------------------------------------------------------------------------+
|                        Delete Customer Information Area                        |
|                                                                                |
|                                                                                |
|                                                                                |
|                   Delete customer information area (Y/N)=> y <=                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|F3=Exit                                                                         |
|                                                                                |
|                                                                                |
+--------------------------------------------------------------------------------+
+--------------------------------------------------------------------------------+
| CMDSTR                          Start Commands                                 |
| Select one of the following:                                                   |
|   Commands                                                                     |
|      1. Start QSH                                                   QSH        |
|      2. Start RPC Binder Daemon                                     RPCBIND    |
|      4. Start AppDict Services/400                                  STRADS     |
|      7. Start AFP Utilities                                         STRAFPU    |
|      8. Start Advanced Print Function                               STRAPF     |
|     10. Start BEST/1 Planner                                        STRBEST    |
|     11. Start BGU                                                   STRBGU     |
|     12. Start Calendar Service                                      STRCALSRV  |
|     13. Start COBOL Debug                                           STRCBLDBG  |
|     14. Start CICS/400                                              STRCICS    |
|                                                                        More... |
| Selection or command                                                           |
| ===> endcpyscn                                                                 |
|                                                                                |
| F3=Exit   F4=Prompt   F9=Retrieve   F12=Cancel   F16=Major menu                |
| (C) COPYRIGHT IBM CORP. 1980, 1998.                                            |
+--------------------------------------------------------------------------------+


[ Top of Page | Previous Page | Next Page | Table of Contents | Index ]