Trailing-Edge
-
PDP-10 Archives
-
k20v7d
-
uetp/lib/online.cbl
There are 11 other files named online.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. ONLINE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
OBJECT-COMPUTER. DECSYSTEM-20.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 FILE-NAME PICTURE X(120) DISPLAY-7
VALUE IS 'DSK:SHARED.FIL'.
01 FILE-PASSWORD PICTURE X(5) DISPLAY-7.
01 NUMBER-OF-PAGES PICTURE S9(10) COMPUTATIONAL VALUE IS 2.
01 THE-ERROR PICTURE S9(10) COMPUTATIONAL VALUE IS 0.
01 USER-PRIORITY PICTURE S9(10) COMPUTATIONAL VALUE IS 10.
01 USER-COMMAND PIC XX.
01 ERR-MSGS.
02 F PIC X(25) VALUE
'NO METER'.
02 F PIC X(25) VALUE
'ALREADY HAS A METER'.
02 F PIC X(25) VALUE
'NO CUSTOMER'.
02 F PIC X(25) VALUE
'ALREADY CUSTOMER'.
02 F PIC X(25) VALUE
'NO BRANCH PO'.
02 F PIC X(25) VALUE
'METER CUST LINKED'.
02 F PIC X(25) VALUE
'METER BRANCH LINKED'.
02 F PIC X(25) VALUE
'NO PARENT PO'.
02 F PIC X(25) VALUE
'BRANCH PARENT LINKED'.
02 F PIC X(25) VALUE
'METER CUST NOT LINKED'.
02 F PIC X(25) VALUE
'ALREADY PARENT PO'.
02 F PIC X(25) VALUE
'ALREADY BRANCH PO'.
02 F PIC X(25) VALUE
'DATABASE ERROR'.
01 REMSG REDEFINES ERR-MSGS.
02 EMS PIC X(25) OCCURS 13 TIMES.
01 WORK-TODAY.
02 YYMMDD.
03 YY PIC XX.
03 MM PIC XX.
03 DD PIC XX.
02 HHMMSS.
03 HHMM.
04 HH PIC XX.
04 MN PIC XX.
03 SS PIC XX.
01 DATE-BREAK.
02 DB-MM PIC XX.
02 DB-DD PIC XX.
02 DB-YY PIC XX.
01 DISPLAY-DATE.
02 DD-MM PIC XX.
02 FILLER PIC X VALUE '/'.
02 DD-DD PIC XX.
02 FILLER PIC X VALUE '/'.
02 DD-YY PIC XX.
01 SUB PIC S9(10) COMP.
01 DELIM-SPACE PIC X VALUE SPACE.
01 DELIM-COMMA PIC X VALUE ','.
01 DISPLAY-FOR-TYPE.
02 DFT-T PIC X VALUE 'T'.
02 DFT-TYPE PIC 99.
01 ECH-KEY PIC X VALUE 'N'.
01 INPUT-STRING PIC X(40).
01 SUBTYPE PIC S9(10) COMP.
01 JOB-INFORMATION.
02 JOB-NUMBER PIC S9(10) COMP.
02 TERMINAL-NUMBER PIC S9(10) COMP.
02 APPLICATION PIC X(8) VALUE IS 'ONLINE'.
02 USER-ID PIC X(8).
02 TRANSACTION-COUNT PIC S9(10).
01 COMMUNICATION-RECORD. COPY COMREC.
PROCEDURE DIVISION.
STRT.
* get job information.
DISPLAY 'User identification (8 chars):' WITH NO ADVANCING.
ACCEPT USER-ID.
MOVE SPACES TO COMMUNICATION-RECORD.
MOVE USER-ID TO CR-user-identity.
MOVE APPLICATION TO CR-user-application.
MOVE JOB-NUMBER TO CR-user-job-number.
MOVE TERMINAL-NUMBER TO CR-user-terminal-number.
* initialize the Data Base handler One time
*
*
*
CALL PBDBMS USING COMMUNICATION-RECORD.
*
*
START-PONLIN.
DISPLAY ' ' DISPLAY ' '.
DISPLAY 'TYPE? >' WITH NO ADVANCING.
ACCEPT USER-COMMAND.
IF USER-COMMAND = 'OP' GO TO DO-DATA-BASE-OPEN.
IF USER-COMMAND = 'CL' GO TO DO-DATA-BASE-CLOSE.
IF USER-COMMAND = 'EX' GO TO DO-PONLINE-EXIT.
IF USER-COMMAND = 'ST' GO TO DO-PONLINE-STATS.
IF USER-COMMAND = 'HP' GO TO DO-HELP-PARAGRAPH.
IF USER-COMMAND NOT NUMERIC GO TO TRY-AGAIN.
* Numeric command -- probably a transacton number
MOVE USER-COMMAND TO CR-TRANSACTION-NUMBER.
DETERMINE-TYPE.
IF CR-TRANSACTION-NUMBER GREATER ZERO AND LESS 15
GO TO TRANSACTION-OK.
* IF CR-TRANSACTION-NUMBER NEGATIVE
* GO TO DO-PONLINE-EXIT.
TRY-AGAIN.
DISPLAY 'TRANSACTION TYPE MUST BE BETWEEN 1 AND 14 >' WITH NO ADVANCING.
GO TO START-PONLIN.
DO-DATA-BASE-OPEN.
MOVE 98 TO CR-transaction-number.
CALL DBOPEN USING COMMUNICATION-RECORD.
IF CR-return-code NOT = 0
* THEN
DISPLAY '[Data Base Open Error]'
ELSE
NEXT SENTENCE.
MOVE 0 TO TRANSACTION-COUNT.
GO TO START-PONLIN.
DO-DATA-BASE-CLOSE.
MOVE 99 TO CR-transaction-number.
CALL DBCLOS USING COMMUNICATION-RECORD.
IF CR-return-code NOT = 0
* THEN
DISPLAY '[Data Base Close Error]'
ELSE
NEXT SENTENCE.
GO TO START-PONLIN.
DO-PONLINE-STATS.
ENTER MACRO STATS.
GO TO START-PONLIN.
TRANSACTION-OK.
ADD 1 TO TRANSACTION-COUNT.
* MOVE TODAY TO WORK-TODAY.
* MOVE YYMMDD TO CRB-DATE.
MOVE 010278 TO CRB-DATE.
* MOVE HHMM TO CRB-HHMM.
MOVE 0405 TO CRB-HHMM.
DISPLAY ' ' DISPLAY ' '.
GO TO T01 T02 T03 T04 T05 T06 T07 T08
T09 T10 T11 T12 T13 T14
DEPENDING ON CR-TRANSACTION-NUMBER.
INVALID-TRANSACTION.
GO TO TRY-AGAIN.
T01.
DISPLAY 'Meter, Customer, Branch >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ',' OR ALL ' '
INTO CRB-METER-NUMBER DELIMITER DELIM-COMMA
CRB-CUSTOMER-NUMBER DELIMITER DELIM-COMMA
CRB-BRANCH-PO-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T01 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T02.
DISPLAY 'Meter, Activity, Date >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ',' OR ALL ' '
INTO CRB-METER-NUMBER DELIMITER DELIM-COMMA
CRB-ACTIVITY-CODE DELIMITER DELIM-COMMA
CRB-DATE DELIMITER DELIM-SPACE.
DISPLAY 'T02 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T03.
DISPLAY 'Branch, Parent >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ',' OR ALL ' '
INTO CRB-BRANCH-PO-NUMBER DELIMITER DELIM-COMMA
CRB-PARENT-PO-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T03 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T04.
DISPLAY 'Customer >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ' ' INTO CRB-CUSTOMER-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T04 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T05.
DISPLAY 'Customer, Date >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ',' OR ALL ' '
INTO CRB-CUSTOMER-NUMBER DELIMITER DELIM-COMMA
CRB-DATE DELIMITER DELIM-SPACE.
DISPLAY 'T05 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T06.
DISPLAY 'Meter >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ' ' INTO CRB-METER-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T06 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T07.
DISPLAY 'Meter >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ' ' INTO CRB-METER-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T07 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T08.
DISPLAY 'Customer, Meter >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ',' OR ALL ' '
INTO CRB-CUSTOMER-NUMBER DELIMITER DELIM-COMMA
CRB-METER-NUMBER DELIMITER DELIM-COMMA
CR-TRANSACTION-SUBTYPE DELIMITER DELIM-SPACE.
MOVE 'BBB' TO CRB-ACTIVITY-CODE.
DISPLAY 'T08 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF NOT CR-GOOD-RETURN
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT
GO TO START-PONLIN.
DISPLAY 'CUSTOMER RECORD ' WITH NO ADVANCING.
DISPLAY CRB-CUSTOMER-NUMBER WITH NO ADVANCING.
DISPLAY ' ' WITH NO ADVANCING.
IF CRB-METER-NUMBER = ZERO
DISPLAY ' '
DISPLAY 'METER RECORD DOES NOT EXIST FOR CUSTOMER'
GO TO START-PONLIN.
DISPLAY 'UPDATED ' WITH NO ADVANCING
DISPLAY CRT08-CUSTOMER-UPDATE-COUNT WITH NO ADVANCING
DISPLAY ' TIMES'
DISPLAY 'METER RECORD ' WITH NO ADVANCING
DISPLAY CRB-METER-NUMBER WITH NO ADVANCING
DISPLAY ' ' WITH NO ADVANCING
DISPLAY ' UPDATED ' WITH NO ADVANCING
DISPLAY CRT08-METER-UPDATE-COUNT WITH NO ADVANCING
DISPLAY ' TIMES'
GO TO START-PONLIN.
T09.
DISPLAY 'Meter >' WITH NO ADVANCING
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED ALL ' ' INTO CRB-METER-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T09 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF NOT CR-GOOD-RETURN
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT
GO TO START-PONLIN.
DISPLAY 'METER RECORD ' WITH NO ADVANCING.
DISPLAY CRB-METER-NUMBER WITH NO ADVANCING.
DISPLAY ' ' WITH NO ADVANCING.
DISPLAY ' LAST UPDATED ' WITH NO ADVANCING.
DISPLAY CRB-HHMM.
DISPLAY ' '.
IF CRT09-NUMBER-OF-ACTIVITIES = 0
DISPLAY 'NO ACTIVITY RECORDS'
ELSE
DISPLAY ' ACTIVITY DATE'
DISPLAY ' ACTIVITY CODE'
PERFORM GET-ACTIVITY THRU GAT-EXIT
VARYING SUB FROM 1 BY 1
UNTIL SUB > CRT09-NUMBER-OF-ACTIVITIES.
GO TO START-PONLIN.
GET-ACTIVITY.
DISPLAY ' ' WITH NO ADVANCING.
MOVE CRT09-DATE (SUB) TO DATE-BREAK.
MOVE DB-MM TO DD-MM.
MOVE DB-DD TO DD-DD.
MOVE DB-YY TO DD-YY.
DISPLAY DISPLAY-DATE WITH NO ADVANCING
DISPLAY ' ' WITH NO ADVANCING.
DISPLAY CRT09-ACTIVITY-CODE (SUB).
GAT-EXIT.
EXIT.
T10.
DISPLAY 'Customer >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ' ' INTO CRB-CUSTOMER-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T10 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF NOT CR-GOOD-RETURN
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT
GO TO START-PONLIN.
DISPLAY 'CUSTOMER RECORD ' WITH NO ADVANCING.
DISPLAY CRB-CUSTOMER-NUMBER WITH NO ADVANCING.
DISPLAY ' ' WITH NO ADVANCING.
DISPLAY 'DATE ' WITH NO ADVANCING.
MOVE CRB-DATE TO DATE-BREAK.
MOVE DB-MM TO DD-MM.
MOVE DB-DD TO DD-DD.
MOVE DB-YY TO DD-YY.
DISPLAY DISPLAY-DATE.
IF CRB-METER-NUMBER = ZERO
DISPLAY ' '
DISPLAY 'NO METER FOR CUSTOMER'
GO TO START-PONLIN.
DISPLAY 'METER RECORD ' WITH NO ADVANCING.
DISPLAY CRB-METER-NUMBER WITH NO ADVANCING.
DISPLAY ' ' WITH NO ADVANCING.
DISPLAY ' LAST UPDATED ' WITH NO ADVANCING.
DISPLAY CRB-HHMM.
DISPLAY 'UPDATED ' WITH NO ADVANCING.
DISPLAY CRT10-METER-UPDATE-COUNT WITH NO ADVANCING.
DISPLAY ' TIMES'.
GO TO START-PONLIN.
T11.
DISPLAY 'Branch >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ' ' INTO CRB-BRANCH-PO-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T11 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
DISPLAY 'BRANCH P. O. RECORD ' WITH NO ADVANCING
DISPLAY CRB-BRANCH-PO-NUMBER
DISPLAY 'PARENT P. O. RECORD ' WITH NO ADVANCING
DISPLAY CRB-PARENT-PO-NUMBER
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T12.
DISPLAY 'TYPE 12 IS FOR THE REPORT AND WILL NOT BE RUN ONLINE'.
GO TO START-PONLIN.
T13.
DISPLAY 'Parent >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ' ' INTO CRB-PARENT-PO-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T13 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
T14.
DISPLAY 'Branch >' WITH NO ADVANCING.
ACCEPT INPUT-STRING.
UNSTRING INPUT-STRING DELIMITED BY ALL ' ' INTO CRB-BRANCH-PO-NUMBER DELIMITER DELIM-SPACE.
DISPLAY 'T14 ' WITH NO ADVANCING.
PERFORM DO-THE-TRANSACTION.
IF CR-GOOD-RETURN
GO TO START-PONLIN.
PERFORM NOT-A-GOOD-RETURN THRU NAGR-EXIT.
GO TO START-PONLIN.
NOT-A-GOOD-RETURN.
IF CR-RETURN-CODE = 99
DISPLAY 'Data Base Error - is it Open?]'
GO TO START-PONLIN.
DISPLAY EMS (CR-RETURN-CODE).
NAGR-EXIT.
EXIT.
DO-HELP-PARAGRAPH.
DISPLAY ' ' DISPLAY ' '
DISPLAY 'THE FOLLOWING IS A VALID LIST OF TYPE CODES'
DISPLAY ' T01 -- LINK METER, CUSTOMER AND BRANCH PO RECORDS'.
DISPLAY ' T02 -- CREATE AND LINK METER ACTIVITY RECORD'.
DISPLAY ' T03 -- LINK BRANCH AND PARENT PO RECORDS'.
DISPLAY ' T04 -- DELETE CUSTOMER RECORD'.
DISPLAY ' T05 -- ADD A CUSTOMER RECORD'.
DISPLAY ' T06 -- DELETE METER RECORD'.
DISPLAY ' T07 -- ADD A METER RECORD'.
DISPLAY ' T08 -- VERIFY CUSTOMER AND METER RECORDS '.
DISPLAY ' T09 -- VERIFY METER RECORD '.
DISPLAY ' T10 -- VERIFY CUSTOMER RECORD '.
DISPLAY ' T11 -- VERIFY BRANCH P. O. '.
DISPLAY ' T12 -- GENERATES REPORT -- CANNOT BE RUN ONLINE '.
DISPLAY ' T13 -- ADD A PARENT PO RECORD '.
DISPLAY ' T14 -- ADD A BRANCH PO RECORD '.
DISPLAY ' ' DISPLAY ' '.
GO TO START-PONLIN.
DO-PONLINE-EXIT.
MOVE 99 TO CR-transaction-number
CALL DBCLOS USING COMMUNICATION-RECORD.
IF CR-return-code NOT = 0
* THEN
DISPLAY '[Data Base Close Error]'
ELSE
NEXT SENTENCE.
STOP RUN.
DO-THE-TRANSACTION.
MOVE TRANSACTION-COUNT TO CR-user-transaction-count.
DISPLAY INPUT-STRING.
CALL DBTRAN USING COMMUNICATION-RECORD.
DTT-EXIT. EXIT.