PDP-10 Archive: uetp/lib/online.cbl from BB-J712A-BM

Trailing-Edge - PDP-10 Archives - BB-J712A-BM - 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.
START.
*	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.