HP 3000 Manuals HP 3000 Manuals
COBOL Sample Program
$CONTROL LIST, MAP, VERBS
IDENTIFICATION DIVISION.
PROGRAM-ID. COBOL-EXAMPLE.
*****
***** This application collects employee payroll deduction
***** transactions and places the edited transactions into
***** a file.
*****
***** For this application: Enter key = edit and file
***** transaction;
*****
***** f8 = exit application;
*****
***** all other f keys = redo transaction.
*****
***** Each transaction entered by the operator is subjected to
***** the data edits embedded within the input form.
*****
***** The application continues to collect transactions until
***** either the operator signals to exit or a system error
***** is detected.
*****
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TXN-ENTRY ASSIGN TO "PAYTXN".
DATA DIVISION.
FILE SECTION.
FD TXN-ENTRY
RECORD CONTAINS 200 CHARACTERS
DATA RECORDS ARE TXN-REC.
01 TXN-REC.
05 FILLER PIC X(200).
WORKING-STORAGE SECTION.
01 GLOBALPAK.
05 EXPECTEDVUF PIC X(8).
05 CALLPROTOCOL PIC S9(8) COMP.
05 COMAREALEN PIC S9(8) COMP.
05 COMAREA PIC X(300) VALUE LOW-VALUES.
01 RETURNPAK.
05 RETURNSTATUS PIC S9(8) COMP.
05 SUBLAYERSTATUS PIC S9(8) COMP.
05 RETURNMSGLEN PIC S9(8) COMP.
05 RETURNMSG PIC X(256).
05 LASTITEMTYPE PIC S9(8) COMP.
05 LASTITEMNUM PIC S9(8) COMP.
05 LASTITEMNAME PIC X(32).
05 NUMDATAERRS PIC S9(8) COMP.
05 NUMCHNGFLDS PIC S9(8) COMP.
01 FORMSFILE.
05 FFNAME PIC X(88).
01 TERMPAK.
05 TERMNAME PIC X(88).
05 BYPASSFEATURE PIC S9(8) COMP.
01 SENDPAK.
05 DONTENABLEINPUT PIC S9(8) COMP.
05 WINDOWENH PIC X(8).
05 BYPASSFEATURE PIC S9(8) COMP.
01 FORMPAK.
05 FORMNAME PIC X(32).
05 FORMPOSITION PIC S9(8) COMP.
05 LISTTYPE PIC S9(8) COMP.
05 LISTCOUNT PIC S9(8) COMP.
05 CHNGENTRY OCCURS 3 TIMES.
10 FIELD_ID PIC X(32).
10 CHANGE-TYPE PIC S9(8) COMP.
10 CHANGE-SPEC PIC X(8).
01 MSGFORWINDOW.
05 MSGLEN PIC S9(8) COMP.
05 MSGBUF.
10 MSGAREA PIC X(79).
10 FILLER PIC X(177).
01 DATADESCRPT.
05 DESCRPTTYPE PIC S9(8) COMP.
05 BUFLEN PIC S9(8) COMP.
05 RTNBUFLEN PIC S9(8) COMP.
01 DATABUF.
05 DATAAREA PIC X(200).
01 READPAK.
05 READTIME PIC S9(8) COMP.
05 ENABLEREFORMAT PIC S9(8) COMP.
05 DOREREAD PIC S9(8) COMP.
01 PROMPTPAK.
05 REPAINTDATA PIC S9(8) COMP.
05 WINDOWENH PIC X(8).
05 RESETHILITED PIC S9(8) COMP.
01 DONE-WITH-TRANSACTIONS PIC X.
01 ERROR-LOCATION PIC X(70).
01 DATA-ENTRY-ERRS PIC X.
01 NBR-TXN-COLLECTED PIC 9(4).
01 STOP-NOW PIC X.
01 UNUSED-PARM PIC S9(8) COMP VALUE ZERO.
PROCEDURE DIVISION.
A-000-START-PROGRAM.
MOVE "N" TO STOP-NOW
DONE-WITH-TRANSACTIONS.
MOVE ZERO TO NBR-TXN-COLLECTED.
PERFORM A-100-SETUP-FOR-WORK.
PERFORM A-500-COLLECT-TRANSACTIONS
UNTIL STOP-NOW = "Y"
OR DONE-WITH-TRANSACTIONS = "Y".
PERFORM A-900-CLEANUP-AFTER-WORK.
DISPLAY " ".
DISPLAY "Deduction transactions collected this session = "
NBR-TXN-COLLECTED.
IF STOP-NOW = "Y"
PERFORM Z-900-DISPLAY-SYSTEM-ERROR.
STOP RUN.
A-100-SETUP-FOR-WORK.
***** Init Unused Parm which is used whenever intrinsic input
***** parameter is not active.
MOVE ZERO TO UNUSED-PARM.
***** Setup (and then forget) GlobalPak.
***** Set Expected HP32424A Version.
MOVE "A.00.00" TO EXPECTEDVUF OF GLOBALPAK.
***** Set Language for COBOL.
MOVE ZERO TO CALLPROTOCOL OF GLOBALPAK.
***** Set Comarealen for 300 bytes.
MOVE 300 TO COMAREALEN OF GLOBALPAK.
***** Comarea is already set to low values by value clause.
***** Open the Transaction File.
OPEN OUTPUT TXN-ENTRY.
***** Open the Forms File.
MOVE "PAYROLL.WORK.ADMIN" TO FFNAME OF FORMSFILE.
CALL "HPDOPENFORMS" USING GLOBALPAK
RETURNPAK
FORMSFILE.
IF RETURNSTATUS OF RETURNPAK NOT = 0
MOVE "Y" TO STOP-NOW
MOVE "**** Routine: Setup For Work - Forms File Open"
TO ERROR-LOCATION
PERFORM Z-100-GET-ERROR-MESSAGE.
***** Setup the terminal.
IF STOP-NOW NOT = "Y"
MOVE "HPTERM" TO TERMNAME OF TERMPAK
MOVE ZERO TO BYPASSFEATURE OF TERMPAK
CALL "HPDENABLETERM" USING GLOBALPAK
RETURNPAK
TERMPAK
UNUSED-PARM
IF RETURNSTATUS OF RETURNPAK NOT = 0
MOVE "Y" TO STOP-NOW
MOVE "**** Routine: Setup For Work - Terminal Setup"
TO ERROR-LOCATION
PERFORM Z-100-GET-ERROR-MESSAGE.
A-500-COLLECT-TRANSACTIONS.
*****
***** Setup for and get transaction data entry form.
*****
***** No special Send instructions.
MOVE ZERO TO DONTENABLEINPUT OF SENDPAK.
MOVE SPACES TO WINDOWENH OF SENDPAK.
MOVE ZERO TO BYPASSFEATURE OF SENDPAK.
***** Setup to get and modify data entry form, toggling three
***** fields to "input allowed".
MOVE "DEDUCTION" TO FORMNAME OF FORMPAK.
***** Position form to start at top left of display (home).
MOVE ZERO TO FORMPOSITION OF FORMPAK.
***** Indicate that the fields in the form which will be
***** modified are identified by name.
MOVE 2 TO LISTTYPE OF FORMPAK.
***** Indicate the number of fields to modify.
MOVE 3 TO LISTCOUNT OF FORMPAK.
***** List fields to be modified, indicate modification type,
***** and new value.
MOVE "BADGE_NUMBER" TO FIELD_ID OF CHNGENTRY(1).
MOVE 5 TO CHANGE-TYPE OF CHNGENTRY(1).
MOVE "O" TO CHANGE-SPEC OF CHNGENTRY(1).
MOVE "LAST_NAME" TO FIELD_ID OF CHNGENTRY(2).
MOVE 5 TO CHANGE-TYPE OF CHNGENTRY(2).
MOVE "O" TO CHANGE-SPEC OF CHNGENTRY(2).
MOVE "SUR_NAME" TO FIELD_ID OF CHNGENTRY(3).
MOVE 5 TO CHANGE-TYPE OF CHNGENTRY(3).
MOVE "O" TO CHANGE-SPEC OF CHNGENTRY(3).
***** Setup window message.
MOVE 79 TO MSGLEN OF MSGFORWINDOW.
MOVE "Fill in Deduction Transaction according to worksheet."
TO MSGAREA OF MSGFORWINDOW.
***** Don't copy application data out to display.
MOVE -1 TO DESCRPTTYPE OF DATADESCRPT.
***** Show Form.
CALL "HPDSEND" USING GLOBALPAK
RETURNPAK
SENDPAK
FORMPAK
UNUSED-PARM
MSGFORWINDOW
DATADESCRPT
UNUSED-PARM
UNUSED-PARM
UNUSED-PARM.
IF RETURNSTATUS OF RETURNPAK NOT = 0
MOVE "Y" TO STOP-NOW
MOVE "**** Routine: Collect Transactions - Form display"
TO ERROR-LOCATION
PERFORM Z-100-GET-ERROR-MESSAGE.
***** Setup and loop on transaction until it can be filed.
MOVE "Y" TO DATA-ENTRY-ERRS.
PERFORM B-100-READ-EDIT-AND-FILE
UNTIL DATA-ENTRY-ERRS = "N"
OR STOP-NOW = "Y"
OR DONE-WITH-TRANSACTIONS = "Y".
B-100-READ-EDIT-AND-FILE.
*****
***** Read form.
*****
***** Enable data finishing.
MOVE 1 TO ENABLEREFORMAT OF READPAK.
***** No other special Read instructions.
MOVE ZERO TO READTIME OF READPAK.
MOVE ZERO TO DOREREAD OF READPAK.
***** Indicate that all data in form, up to 200 bytes, is to be
***** copied into application work space.
MOVE 10 TO DESCRPTTYPE OF DATADESCRPT.
MOVE 200 TO BUFLEN OF DATADESCRPT.
***** Read form.
CALL "HPDREAD" USING GLOBALPAK
RETURNPAK
READPAK
UNUSED-PARM
UNUSED-PARM
DATADESCRPT
DATABUF
UNUSED-PARM.
IF RETURNSTATUS OF RETURNPAK < 0
MOVE "Y" TO STOP-NOW
MOVE "**** Routine: Read Edit and File - Terminal Read"
TO ERROR-LOCATION
PERFORM Z-100-GET-ERROR-MESSAGE.
***** Determine if operator wants to stop transaction collection.
IF STOP-NOW NOT = "Y"
AND RETURNSTATUS OF RETURNPAK = 0
IF LASTITEMTYPE OF RETURNPAK = 0
AND LASTITEMNUM OF RETURNPAK = 8
MOVE "Y" TO DONE-WITH-TRANSACTIONS.
***** Determine if edit errors detected.
IF STOP-NOW NOT = "Y"
AND DONE-WITH-TRANSACTIONS NOT = "Y"
IF RETURNSTATUS OF RETURNPAK = 0
MOVE "N" TO DATA-ENTRY-ERRS
ELSE
MOVE "Y" TO DATA-ENTRY-ERRS.
***** Do we have a transaction that can be filed?
IF STOP-NOW NOT = "Y"
AND DONE-WITH-TRANSACTIONS NOT = "Y"
IF DATA-ENTRY-ERRS NOT = "Y"
AND LASTITEMTYPE OF RETURNPAK = 0
AND LASTITEMNUM OF RETURNPAK = 0
***** Write Databuf to Transaction File.
WRITE TXN-REC FROM DATABUF
ADD 1 TO NBR-TXN-COLLECTED.
***** Do we need to prompt the operator to correct errors?
IF STOP-NOW NOT = "Y"
AND DONE-WITH-TRANSACTIONS NOT = "Y"
IF DATA-ENTRY-ERRS = "Y"
IF LASTITEMTYPE OF RETURNPAK = 0
AND LASTITEMNUM OF RETURNPAK = 0
PERFORM B-200-PROMPT-OPERATOR
ELSE
***** Operator pressed some key other than ENTER or
***** EXIT so, clear data error flag to break loop
***** (display refresh results).
MOVE "N" TO DATA-ENTRY-ERRS.
B-200-PROMPT-OPERATOR.
*****
***** Get message text associated with first field flagged
***** with a data error.
*****
MOVE RETURNMSGLEN OF RETURNPAK
TO MSGLEN OF MSGFORWINDOW.
MOVE RETURNMSG OF RETURNPAK
TO MSGBUF OF MSGFORWINDOW.
***** No special Prompt instructions.
MOVE ZERO TO REPAINTDATA OF PROMPTPAK.
MOVE SPACES TO WINDOWENH OF PROMPTPAK.
MOVE ZERO TO RESETHILITED OF PROMPTPAK.
***** Display form with highlighted fields and error message
***** in window.
CALL "HPDPROMPT" USING GLOBALPAK
RETURNPAK
PROMPTPAK
UNUSED-PARM
MSGFORWINDOW
UNUSED-PARM
UNUSED-PARM
UNUSED-PARM.
IF RETURNSTATUS OF RETURNPAK NOT = 0
MOVE "Y" TO STOP-NOW
MOVE "**** Routine: Prompt Operator - Display Updates"
TO ERROR-LOCATION
PERFORM Z-100-GET-ERROR-MESSAGE.
A-900-CLEANUP-AFTER-WORK.
*****
***** Note that this paragraph unconditionally attempts to
***** close the Forms File and Terminal.
*****
CLOSE TXN-ENTRY.
CALL "HPDCLOSEFORMS" USING GLOBALPAK
RETURNPAK
FORMSFILE.
CALL "HPDDISABLETERM" USING GLOBALPAK
RETURNPAK
TERMPAK
UNUSED-PARM.
Z-100-GET-ERROR-MESSAGE.
MOVE SPACES TO MSGAREA OF MSGBUF.
MOVE RETURNMSG OF RETURNPAK
TO MSGBUF.
Z-900-DISPLAY-SYSTEM-ERROR.
DISPLAY "**** Transaction entry facility detected system error at:".
DISPLAY ERROR-LOCATION.
DISPLAY "**** The error message returned is:".
DISPLAY "**** "
MSGAREA OF MSGBUF.