IDENTIFICATION DIVISION. PROGRAM-ID. breakx1. ***************************************************************** * EXAMPLE PROGRAM TO DISPLAY A SCREEN AND ACCEPT THE INPUT * INTERACTIVELY. A SIMPLE CONTROL BREAK TECHNIQUE IS USED * TO PRODUCE TOTALS FOR EACH PATIENT PROCESSED. ***************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. PC. OBJECT-COMPUTER. PC. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT PATIENT-TRANS ASSIGN TO 'A:\PATIENT.dat' ORGANIZATION IS LINE SEQUENTIAL. SELECT PATIENT-ERR ASSIGN TO 'A:\PERROR.dat' ORGANIZATION IS LINE SEQUENTIAL. SELECT PATIENT-RPT ASSIGN TO 'A:\PRPT.dat' ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD PATIENT-TRANS LABEL RECORDS ARE STANDARD RECORD CONTAINS 56 CHARACTERS. 01 TRANS-REC-out. 05 PATIENT-id pic x(9). 05 last-name pic x(20). 05 first-name pic x(10). 05 m-i pic x(1). 05 DATE-OF-SERV PIC X(8). 05 PATIENT-LIABILITY PIC 9(6)V99. FD PATIENT-ERR LABEL RECORDS ARE STANDARD. 01 TRANS-REC-ERR. 02 PATIENT-ERREC PIC X(56). 02 ERROR-MESS PIC X(20). FD PATIENT-RPT LABEL RECORDS ARE STANDARD. 01 RPT-REC PIC X(132). working-storage section. 01 ws-response1 pic x value 'y'. 88 MORE-PATIENTS VALUE 'y', 'Y'. 88 NO-MORE-PATIENTS VALUE 'n', 'N'. 01 ERROR-SWITCH PIC X VALUE 'N'. 01 FIRST-TIME PIC X VALUE 'Y'. 01 ws-response2 pic x(1) value 'n'. 01 ws-serv-date. 05 ws-serv-mm pic xx value spaces. 05 ws-serv-dd pic xx value spaces. 05 ws-serv-cc pic xx value spaces. 05 ws-serv-yy pic xx value spaces. 01 ws-med-code pic x(3) value spaces. 01 med-subscript pic 9(3) value zeroes. 01 detail-count pic 9(3) value zeroes. 01 WS-ERROR-MESSAGE PIC X(12) VALUE SPACES. 01 ERROR-PRESENT PIC X(1) VALUE SPACE. 01 ws-message pic x(30) value spaces. 01 screen-ok pic x value 'n'. 01 C-REPORT-BREAK. 05 PIC X(20) VALUE 'PATIENT: '. 05 REPORT-ID PIC X(9) VALUE SPACES. 05 PIC X(20) VALUE ' TOTAL LIAB: '. 05 REPORT-LIABILITY PIC $Z,ZZZ,ZZ9.99 VALUE ZEROES. *********************************************************** * HERE ARE THE TWO FIELDS REQUIRED TO CREATE A TOTAL FOR * EACH PATIENT: 1) A FIELD TO HOLD THE PREVIOUS PATIENT, AND * 2) A FIELD TO HOLD THE TOTAL FOR EACH PATIENT. REMEMBER TO * INITIALIZE EACH FIELD IN WS. *********************************************************** 01 CONTROL-FIELDS. 05 HOLD-PATIENT-ID PIC X(9) VALUE SPACES. 05 PATIENT-TOTAL-LIABILITY PIC 9(8)V99 VALUE ZEROES. screen section. 01 PATIENT-screen-1 EMPTY-CHECK auto. *********************************************************** * data for the input file. ALL TO FIELDS ON THE * SCREEN MUST BE DEFINED EITHER IN FD OR WS *********************************************************** 05 blank screen. 05 line 1 column 1 value ' '. 05 column 2 pic x(30) from ws-message. 05 line 2 column 1 value 'PATIENT ID: '. 05 column 15 pic x(9) to PATIENT-ID. 05 line 3 column 1 value 'LAST NAME: '. 05 column 15 pic x(20) to last-name. 05 line 4 column 1 value 'FIRST NAME: '. 05 column 15 pic x(10) to first-name. 05 line 5 column 1 value 'MI: '. 05 column 15 pic x(1) to m-i. 05 LINE 6 COLUMN 1 VALUE 'DATE OF SERVICE: '. 05 COLUMN 20 PIC X(8) TO DATE-OF-SERV. 05 LINE 7 COLUMN 1 VALUE 'PATIENT LIABILITY:'. 05 COLUMN 20 PIC $ZZZ,ZZ9.99 TO PATIENT-LIABILITY. 01 PATIENT-screen-2 EMPTY-CHECK auto. *********************************************************** * data for the input file. ALL TO FIELDS ON THE * SCREEN MUST BE DEFINED EITHER IN FD OR WS *********************************************************** 05 blank screen. 05 line 1 column 1 value 'Please verify your input'. 05 line 2 column 1 value 'PATIENT ID: '. 05 column 15 pic x(9) from PATIENT-ID. 05 line 3 column 1 value 'LAST NAME: '. 05 column 15 pic x(20) from last-name. 05 line 4 column 1 value 'FIRST NAME: '. 05 column 15 pic x(10) from first-name. 05 line 5 column 1 value 'MI: '. 05 column 15 pic x(1) from m-i. 05 LINE 6 COLUMN 1 VALUE 'DATE OF SERVICE: '. 05 COLUMN 20 PIC X(8) from DATE-OF-SERV. 05 LINE 7 COLUMN 1 VALUE 'PATIENT LIABILITY:'. 05 COLUMN 20 PIC $ZZZ,ZZ9.99 from PATIENT-LIABILITY. 05 line 15 column 1 value 'Do you accept...'. 05 column 20 pic x(1) to ws-response2. 05 line 16 column 1 value 'ANOTHER PATIENT? '. 05 column 20 pic x(1) to ws-response1. PROCEDURE DIVISION. 100-MAIN-MODULE. perform 101-initialize perform 200-start-a-transaction until NO-MORE-PATIENTS perform 999-finish-up close PATIENT-TRANS, PATIENT-ERR, PATIENT-RPT stop run. 101-initialize. OPEN output PATIENT-TRANS, PATIENT-ERR, PATIENT-RPT. 102-CONTROL-REPORT. * IF FIRST-TIME = 'Y' OR LINE-COUNT > 25 * WRITE RPT-REC FROM CREPORT-TITLE * AFTER ADVANCING PAGE * WRITE RPT-REC FROM CREPORT-COL-HEAD * AFTER ADVANCING LINE ************* MOVE INPUT OR OUTPUT TRANS TO THE FIELDS DEFINED IN CREPORT-DETAIL * WRITE RPT-REC FROM CREPORT-DETAIL * AFTER ADVANCING LINE * PERFORM 103-CONTROL-LOGIC * MOVE ZERO TO LINE-COUNT * ELSE * WRITE RPT-REC FROM CREPORT-DETAIL * AFTER ADVANCING LINE * PERFORM 103-CONTROL-LOGIC * ADD 1 TO LINE-COUNT * END-IF. PERFORM 103-CONTROL-LOGIC. 103-CONTROL-LOGIC. *********************************************************** * THE FOLLOWING BLOCK OF CODE CHECKS FOR A CONTROL BREAK TO * SEE IF THE CURRENT CONTROL FIELD (PATIENT-ID) IS DIFFERENT * FROM THE HOLD PATIENT-ID. IF IT IS, A REPORT LINE WILL BE WRITTEN * TO SHOW THE TOTAL OF THE PATIENT, SET THE PATIENT TOTAL BACK TO * ZERO AND TAKE THE CURRENT PATIENT AND MOVE IT TO THE HOLD FIELD * IF THE PATIENT ID IS THE SAME AS PREVIOUS, ADD THE TOTAL TO THE * PATIENT TOTAL-LIABILITY. *********************************************************** IF PATIENT-ID NOT EQUAL HOLD-PATIENT-ID IF FIRST-TIME = 'Y' MOVE 'N' TO FIRST-TIME MOVE PATIENT-ID TO HOLD-PATIENT-ID ADD PATIENT-LIABILITY TO PATIENT-TOTAL-LIABILITY ELSE MOVE HOLD-PATIENT-ID TO REPORT-ID MOVE PATIENT-TOTAL-LIABILITY TO REPORT-LIABILITY WRITE RPT-REC FROM C-REPORT-BREAK MOVE PATIENT-ID TO HOLD-PATIENT-ID MOVE ZEROES TO PATIENT-TOTAL-LIABILITY ADD PATIENT-LIABILITY TO PATIENT-TOTAL-LIABILITY END-IF ELSE ADD PATIENT-LIABILITY TO PATIENT-TOTAL-LIABILITY END-IF. ********************************************************** ********* display and accept customer SCREEN ********************************************************** 200-start-a-transaction. PERFORM 201-INIT perform until ws-response2 = 'y' or 'Y' perform until screen-ok = 'y' display PATIENT-screen-1 accept PATIENT-screen-1 perform 202-edit-screen end-perform display patient-screen-2 accept patient-screen-2 end-perform ********** routines used for calculations, editting, etc. can be performed here ********** PERFORM 205-EDIT-DOS PERFORM 102-CONTROL-REPORT IF ERROR-SWITCH = 'N' WRITE TRANS-REC-OUT ELSE MOVE TRANS-REC-OUT TO PATIENT-ERREC WRITE TRANS-REC-ERR END-IF. 201-INIT. MOVE 'N' TO ERROR-SWITCH ws-response2 move 'n' to screen-ok. 202-edit-screen. if date-of-serv (5:2) < '01' or date-of-serv (5:2) > '12' move 'invalid date, please re-enter' to ws-message move 'n' to screen-ok else move 'enter another patient' to ws-message move 'y' to screen-ok end-if. 999-finish-up. MOVE HOLD-PATIENT-ID TO REPORT-ID MOVE PATIENT-TOTAL-LIABILITY TO REPORT-LIABILITY WRITE RPT-REC FROM C-REPORT-BREAK.