HP 3000 Manuals HP 3000 Manuals
ORDERS Database Model Program (contd.) Closing the Database (contd.) RPG RPG contains language constructs that make calls to TurboIMAGE/XL intrinsics, rather than having the user code do the intrinsic calls directly. For example, RPG opens all files at the beginning of program execution, thereby calling DBOPEN for any databases named on File Description specifications. Likewise, DBCLOSE is automatically called for databases at the end of program execution. Another example is the RPG CHAIN operation which calls DBFIND and/or DBGET, depending on its usage. A small set of TurboIMAGE/XL intrinsics have no RPG language equivalent and so cannot be accessed at the present time. These include DBERROR, DBEXPLAIN, DBBEGIN, DBEND, and DBMEMO. Because the sample program on which this RPG program is based contains calls to DBERROR and DBEXPLAIN, the RPG version cannot exactly match the functionality of the sample program. Instead, it displays the status value returned by TurboIMAGE/XL when an error occurs.
NOTE Because the Schema Processor, DBSCHEMA, upshifts alphabetic characters, programs must specify data set and data item names in all uppercase characters. Take note of this as RPG does not require that you use uppercase characters.
For information of TurboIMAGE/XL data item lengths and type designators, refer to chapter 3. Tables 3-2 and 3-3 show the TurboIMAGE/XL type designators, sub-item lengths, and data types typically used to process them in RPG. Defining Data Types, Variables, and Intrinsics The first five F-specs implement the OPEN-THE-DATABASE routine of the sample program in RPG. RPG automatically opens all databases (by calling DBOPEN) at the beginning of program execution. F-specs are used to declare how each database/set is to be opened and accessed. In this program, the database is opened with mode 1 (shared modify access) by entry of L in column 66 on the KIMAGE line. This entry also allows user-controlled locking of the database/set/item to occur. The data set is opened for chained sequential read accesses by entry of C in column 67 of the KIMAGE line. If an error occurs during opening of the database, the program will abort. Note that RPG also closes all databases (by calling DBCLOSE) at the end of program execution, so there is no need for the user to call a separate routine to do this. $CONTROL NOINFO,MAP,NAME=RTURBO H L 1 **************************************************************** * Program name: RTURBO * * Description : Example of RPG access to TurboIMAGE/XL * **************************************************************** FSALES IC F 38R 6AI 27 DISC F KIMAGE ORDERSLC F KITEM PURCH-DATE F KLEVEL DO-ALL F KSTATUSSTAT FTERMIN ID F 79 $STDIN FTERMOUT O V 79 $STDLST **************************************************************** * TABLE/ARRAY DECLARATIONS * **************************************************************** E ESC 1 1 1 Escape = 27 **************************************************************** * INPUT RECORD LAYOUTS * **************************************************************** ISALES NS I B 1 40ACCT# I 5 12 STOCK# I 6 13 140QTY I 7 15 180$PRICE I 5 19 220$TAX I 8 23 260$TOTAL I 27 320PDATE I 33 380DDATE ITERMIN NS I 1 8 OPTION Main Body of Program **************************************************************** * CALCULATIONS MAINLINE * **************************************************************** C* Execute GETSAL subroutine, then end program. C* C EXSR GETSAL C SETON LR Retrieving All the Records on a Chain (with Item Level Locking) This subroutine implements the GET-SALES-FOR-DATE routine of the sample program. Chained access is achieved using the CHAIN operation which performs a DBFIND call and a DBGET call on the first execution, and then DBGET calls on subsequent executions for the same search value. Thus a loop is done on the CHAIN operation in order to retrieve all the entries in the data item chain. The routine traps two exceptional conditions: failure to find a chain head, and reaching end-of-chain. **************************************************************** * G E T S A L S U B R O U T I N E * **************************************************************** C GETSAL BEGSR C*-------------------------------------------------------------- C* Display prompt for date and read user input from screen. C* C EXCPT CLEAR C EXCPT GETDAT C READ TERMIN H0 C MOVELOPTION DATE 6 C*-------------------------------------------------------------- C* Do unconditional data item lock on DATE. C* C DATE LOCK SALES 21 C 21 EXSR GETERR C LR GOTO END1 C*-------------------------------------------------------------- C* Loop on CHAIN operation to get all entries in chain. On C* first occurrence of CHAIN for a unique value of DATE, RPG C* calls DBFIND, followed by DBGET. On subsequent uses of C* CHAIN with the same value for DATE, only DBGET is called. C* C SETOF 202122 C LOOP1 TAG C DATE CHAINSALES 2122 C*-------------------------------------------------------------- C* No chain head found. C* C 21 EXCPT CLEAR C 21 EXCPT NOHEAD C 21 READ TERMIN H0 C 21 GOTO SKIP C*-------------------------------------------------------------- C* End-of-chain found. C* C 22 EXCPT EOC C 22 READ TERMIN H0 C 22 GOTO SKIP C*-------------------------------------------------------------- C* Any other error. C* C STAT,1 IFGT 0 C EXSR GETERR C LR GOTO END1 C END C*-------------------------------------------------------------- C* Print headings and data record. C* C N20 EXCPT CLEAR C N20 EXCPT SALHDR C N20 EXCPT LINHDR C N20 SETON 20 C EXCPT SALREC C*-------------------------------------------------------------- C* Loop back to do another CHAIN operation (DBGET). C* C GOTO LOOP1 C SKIP TAG C*-------------------------------------------------------------- C* Unlock the data item. C* C DATE UNLCKSALES 24 C N24 EXSR GETERR C* C END1 ENDSR Obtaining Error Messages and Explanations The following subroutine implements the GET-ERROR-AND-EXPLAIN routine of the sample program. Because RPG as yet does not have access to DBEXPLAIN and DBERROR, this subroutine simply displays the TurboIMAGE/XL error number from the status array and then allows the user to either abort the the program or continue its execution. If the user elects to abort, the LR indicator is set ON and the code which called this subroutine must test for LR and exit immediately to its caller, which in turn must exit to its caller, and so on. **************************************************************** * G E T E R R S U B R O U T I N E * **************************************************************** C GETERR BEGSR C EXCPT ERRBUF C GETOPT TAG C READ TERMIN H0 C OPTION IFEQ "1" C SETON LR C ELSE C OPTION IFEQ "2" C EXCPT ERRCON C ELSE C EXCPT BADOPT C GOTO GETOPT C END C END C* C ENDSR Defining Output **************************************************************** * OUTPUT RECORD LAYOUTS * **************************************************************** O*-------------------------------------------------------------- O* Display message for entry of invalid option. O* OTERMOUT E 1 BADOPT O 23 "Invalid option - please" O 33 " re-enter." O*-------------------------------------------------------------- O* Send 'Home' (Escape h) and 'Clear' (Escape J) to screen. O* O E 1 CLEAR O ESC 1 O 2 "h" O ESC 3 O 4 "J" O*-------------------------------------------------------------- O* Display message for IMAGE End-Of-Chain condition. O* O E 31 EOC O 21 "-----> End of Chain, " O 42 "Hit Enter to Continue" O*-------------------------------------------------------------- O* Display error message. O* O E 1 ERRBUF O 23 "-----------------------" O 30 "-------" O E 1 ERRBUF O 11 "IMAGE ERROR" O STAT,1 21 " *" O 35 " HAS OCCURRED." O E 2 ERRBUF O 23 "-----------------------" O 30 "-------" O E 1 ERRBUF O 23 "---Enter, <1> to Abort." O 43 ".., <2> TO Continue" O*-------------------------------------------------------------- O* Display message for continuing execution after error. O* O E 1 ERRCON O 15 "Continuing....." O*-------------------------------------------------------------- O* Display prompt for input of DATE. O* O E 1 GETDAT O 23 "Enter The DATE of Purch" O 38 "ase as (YYMMDD)" O*-------------------------------------------------------------- O* Display Line Header (dashes). O* O E 1 LINHDR O 23 "-----------------------" O *PLACE 46 O *PLACE 69 O 76 "-------" O*-------------------------------------------------------------- O* Display message that no IMAGE chain head was found. O* O E 1 NOHEAD O 23 "***********************" O 39 "****************" O E 1 NOHEAD O 23 "* No Such Entry in the " O 39 "Sales Dataset *" O E 1 NOHEAD O 23 "* Please Try Again. " O 39 " *" O E 1 NOHEAD O 23 "***********************" O 39 "****************" O E 1 NOHEAD O 23 "Press Enter To Continue" O*-------------------------------------------------------------- O* Display Header line for listing of Sales records. O* O E 1 SALHDR O 13 "Acct-Number " O 28 "Stock-Number " O 33 "QTY " O 40 "Price " O 46 "Tax " O 53 "Total " O 66 "Purch-Date " O 79 "Deliv-Date " O*-------------------------------------------------------------- O* Display Sales record line. O* O E 1 SALREC O ACCT# 10 " 0 " O STOCK# 25 O QTY 31 " 0 " O $PRICE 38 " 0 " O $TAX 43 " 0 " O $TOTAL 51 " 0 " O PDATE Y 62 O DDATE Y 75 ** Following record contains Escape character (ASCII 27) in column 1 <--- ASCII 27