|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 45568 (0xb200)
Types: TextFile
Names: »TEST01.TXT«
└─⟦31a512eaf⟧ Bits:30009429 50004846
└─⟦a415da17f⟧
└─⟦this⟧ »TEST01.TXT«
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST01.
AUTHOR. KYRA.
DATE-WRITTEN. 16-17 MARCH, 1982.
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. MZ-80B.
OBJECT-COMPUTER. MZ-80B.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PATIENT-FILE ASSIGN TO DISK
FILE STATUS IS W01-DISK-STAT
ORGANISATION IS INDEXED
ACCESS IS DYNAMIC.
SELECT PRINT-FILE ASSIGN TO PRINTER.
*
DATA DIVISION.
FILE SECTION.
FD PRINT-FILE
RECORD CONTAINS 132 CHARACTERS
LABEL RECORDS ARE OMITTED
DATA RECORD IS PRINT-REC
LINAGE IS 60 LINES
LINES AT TOP 5
LINES AT BOTTOM 5.
01 PRINT-LINE PIC X(132).
*
FD PATIENT-FILE
LABEL RECORDS ARE STANDARD
DATA RECORD IS PATIENT-REC
VALUE OF FILE-ID "A:PATIENT.FIL"
RECORD KEY IS REC-KEY
RECORD CONTAINS 700 CHARACTERS
BLOCK CONTAINS 5 RECORDS.
01 PATIENT-REC.
03 REC-KEY.
05 ACC-NO PIC 9(3).
05 REC-NO PIC 99.
03 REC-DATE.
05 DAY PIC 99.
05 FILLER PIC X.
05 MONTH PIC 99.
05 FILLER PIC X.
05 YEAR PIC 99.
03 MASTER-DATA.
05 VISIT-COUNT PIC 9(3).
05 NAME-1 PIC X(20).
05 NAME-2 PIC X(20).
05 ADDRESS-1 PIC X(20).
05 ADDRESS-2 PIC X(20).
05 ADDRESS-3 PIC X(20).
05 WORK-PHONE PIC X(12).
05 HOME-PHONE PIC X(12).
05 MED-AID-NAME PIC X(30).
05 MED-AID-NO PIC X(12).
05 DATE-OF-BIRTH PIC X(8).
05 DIAGNOSIS PIC X(30).
05 NEXT-OF-KIN PIC X(30).
05 NOK-WORK-PHONE PIC X(12).
05 NOK-HOME-PHONE PIC X(12).
05 NOK-ADDRESS-1 PIC X(20).
05 NOK-ADDRESS-2 PIC X(20).
05 NOK-ADDRESS-3 PIC X(20).
05 TRANS-DATE PIC X(8).
05 FAILURE-REASON PIC X(20).
05 ELAPSED-TIME PIC 999.
05 GRAFT-REM-DATE PIC X(8).
05 RETRANS-DATE PIC X(8).
05 DATE-OF-DEATH PIC X(8).
05 CAUSE-OF-DEATH PIC X(20).
05 REC-BLOOD-TYPE PIC X(4).
05 REC-HLA-PROF PIC X(10).
05 DON-BLOOD-TYPE PIC X(4).
05 DON-HLA-PROF PIC X(10).
05 DON-BIRTH-DATE PIC X(8).
05 FILLER PIC X(265).
03 VISIT-DATA REDEFINES MASTER DATA.
05 REASON PIC X(20).
05 TEMP1 PIC 99V99.
05 TEMP2 PIC 99V99.
05 TEMP3 PIC 99V99.
05 TEMP4 PIC 99V99.
05 TEMP5 PIC 99V99.
05 BP1 PIC X(5).
05 BP2 PIC X(5).
05 BP3 PIC X(5).
05 BP4 PIC X(5).
05 BP5 PIC X(5).
05 A PIC X(20).
05 B PIC X(20).
05 C PIC X(20).
05 D PIC X(5).
05 E PIC X(5).
05 F PIC X(5).
05 GLUCOSE PIC X(30).
05 DELTA PIC X(7).
05 X PIC X(30).
05 Y PIC X(30).
05 Z PIC X(30).
05 MED1 PIC X(20).
05 DOSE1 PIC X(15).
05 MED2 PIC X(20).
05 DOSE2 PIC X(15).
05 MED3 PIC X(20).
05 DOSE3 PIC X(15).
05 MED4 PIC X(20).
05 DOSE4 PIC X(15).
05 MED5 PIC X(20).
05 DOSE5 PIC X(15).
05 NA PIC X(5).
05 K PIC X(5).
05 CL PIC X(5).
05 HC02 PIC XXX.
05 US PIC XXX.
05 AMY PIC XXX.
05 MG PIC XXX.
05 CA PIC XXX.
05 BIL-TOT PIC X(5).
05 CONJ PIC X(5).
05 SGOT PIC X(5).
05 SGPT PIC XX.
05 AP PIC XX.
05 LDH PIC XXX.
05 TP PIC XXX.
05 ALB PIC X(5).
05 A1 PIC XXX.
05 A2 PIC XXX.
05 A3 PIC XXX.
05 ALPHA PIC X(5).
05 BETA PIC X(5).
05 GAMMA PIC X(5).
05 O2 PIC XX.
05 O2-SAT PIC XXX.
05 BASE-EXS PIC X(10).
05 ACT-BIC PIC X(5).
05 MICRO PIC X(10).
05 SG PIC XX.
05 ISCHEMIA-WARM PIC X(5).
05 ISCHEMIA-COLD PIC X(5).
05 MATCH PIC X(5).
05 REM PIC XXX.
05 IV-PRED PIC XXX.
05 IM-AM PIC XXX.
05 IM-PM PIC XXX.
05 PR-AM PIC XX.
05 PR-PM PIC XX.
05 INT-AM PIC X(5).
05 TOT PIC X(5).
05 OUT-AM PIC X(5).
05 WEIGHT PIC 999.
05 CR PIC XXX.
05 CCR PIC XXX.
05 PLAT PIC X(5).
05 HCT PIC XX.
05 ST PIC XX.
05 E PIC XXX.
05 L PIC X.
05 B PIC X(5).
05 UREA PIC X(5).
05 URINE PIC X(10).
05 NOSE PIC X(5).
05 THROAT PIC X(5).
05 BLD PIC X(10).
05 OTHER PIC X(20).
*
WORKING-STORAGE SECTION.
01 W01-DISK-STAT.
03 W01-STAT-L PIC X.
03 W01-STAT-R PIC X.
01 W02-OPTION PIC X.
01 W03-VISIT-TABLE.
03 W03-VISIT OCCURS 20.
*--CATEGORY 1
05 W03-V-DATE PIC X(8).
05 W03-V-REASON PIC X(20).
05 W03-V-TEMP1 PIC 99V99.
05 W03-V-TEMP2 PIC 99V99.
05 W03-V-TEMP3 PIC 99V99.
05 W03-V-TEMP4 PIC 99V99.
05 W03-V-TEMP5 PIC 99V99.
*--CATEGORY 2
05 W03-V-BP1 PIC X(5).
05 W03-V-BP2 PIC X(5).
05 W03-V-BP3 PIC X(5).
05 W03-V-BP4 PIC X(5).
05 W03-V-BP5 PIC X(5).
05 W03-V-A PIC X(20).
05 W03-V-B PIC X(20).
*--CATEGORY 3
05 W03-V-C PIC X(20).
05 W03-V-D PIC X(5).
05 W03-V-E PIC X(5).
05 W03-V-F PIC X(5).
05 W03-V-GLUCOSE PIC X(30).
*--CATEGORY 4
05 W03-V-X PIC X(30).
05 W03-V-Y PIC X(30).
*--CATEGORY 5
05 W03-V-Z PIC X(30).
05 W03-V-MED1 PIC X(20).
05 W03-V-DOSE1 PIC X(15).
*--CATEGORY 6
05 W03-V-MED2 PIC X(20).
05 W03-V-DOSE2 PIC X(15).
05 W03-V-MED3 PIC X(20).
05 W03-V-DOSE3 PIC X(15).
*--CATEGORY 7
05 W03-V-MED4 PIC X(20).
05 W03-V-DOSE4 PIC X(15).
05 W03-V-MED5 PIC X(20).
05 W03-V-DOSE5 PIC X(15).
*--CATEGORY 8
05 W03-V-NA PIC X(5).
05 W03-V-K PIC X(5).
05 W03-V-CL PIC X(5).
05 W03-V-HCO2 PIC XXX.
05 W03-V-US PIC XXX.
05 W03-V-AMY PIC XXX.
05 W03-V-MG PIC XXX.
05 W03-V-CA PIC XXX.
05 W03-V-BIL-TOT PIC X(5).
05 W03-V-CONJ PIC X(5).
05 W03-V-SGOT PIC X(5).
05 W03-V-SGPT PIC XX.
05 W03-V-AP PIC XX.
05 W03-V-LDH PIC XXX.
05 W03-V-TP PIC XXX.
*--CATEGORY 9
05 W03-V-ALB PIC X(5).
05 W03-V-A1 PIC XXX.
05 W03-V-A2 PIC XXX.
05 W03-V-A3 PIC XXX.
05 W03-V-ALPHA PIC X(5).
05 W03-V-BETA PIC X(5).
05 W03-V-GAMMA PIC X(5).
05 W03-V-O2 PIC XX.
05 W03-V-O2-SAT PIC XXX.
05 W03-V-BASE-EXS PIC X(10).
05 W03-V-ACT-BIC PIC X(5).
05 W03-V-MICRO PIC X(10).
*--CATEGORY 10
05 W03-V-SG PIC XX.
05 W03-V-ISCHEMIA-W PIC X(5).
05 W03-V-ISCHEMIA-C PIC X(5).
05 W03-V-MATCH PIC X(5).
05 W03-V-REM PIC XXX.
05 W03-V-IV-PRED PIC XXX.
05 W03-V-IM-AM PIC XXX.
05 W03-V-IM-PM PIC XXX.
05 W03-V-PR-AM PIC XX.
05 W03-V-PR-PM PIC XX.
05 W03-V-INT-AM PIC X(5).
05 W03-V-TOT PIC X(5).
05 W03-V-OUT-AM PIC X(5).
*--CATEGORY 11
05 W03-V-WEIGHT PIC 999.
05 W03-V-CR PIC XXX.
05 W03-V-CCR PIC XXX.
05 W03-V-PLAT PIC X(5).
05 W03-V-HCT PIC XX.
05 W03-V-ST PIC XX.
05 W03-V-E PIC XXX.
05 W03-V-L PIC X.
05 W03-V-B PIC X(5).
05 W03-V-UREA PIC X(5).
05 W03-V-URINE PIC X(10).
05 W03-V-NOSE PIC X(5).
05 W03-V-THROAT PIC X(5).
*--CATEGORY 12
05 W03-V-BLD PIC X(10).
05 W03-V-OTHER PIC X(20).
01 W04-TAB-SUB PIC 99.
01 W05-ACCEPT-PERIOD PIC 9.
01 W06-PERIOD PIC 9(3).
01 W07-READ-COUNT PIC 9(3).
01 W08-ANSWER PIC X.
01 W09-CATEGORY PIC 9.
01 W10-INVALID PIC X.
*
SCREEN SECTION.
01 SCREEN-DISPLAY-A.
03 SCREEN-A1
BLANK SCREEN
LINE NUMBER IS 1
COLUMN NUMBER IS 20
VALUE IS "PATIENT INFORMATION".
03 SCREEN-A2
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 20
VALUE IS "-------------------".
03 SCREEN-A3
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 20
VALUE IS "1 - ADD MASTER DATA".
03 SCREEN-A4
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 20
VALUE IS "2 - ADD VISIT DATA".
03 SCREEN-A5
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 20
VALUE IS "3 - AMEND VISIT DATA".
03 SCREEN-A6
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 20
VALUE IS "4 - PRINT VISIT DATA".
03 SCREEN-A7
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 20
VALUE IS "5 - END PROGRAM".
03 SCREEN-A8
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 20
VALUE IS "PLEASE SELECT OPTION : ".
03 SCREEN-A9
COLUMN NUMBER IS 33
PICTURE IS X TO W02-OPTION.
*
01 SCREEN-DISPLAY-B.
03 SCREEN-B1
BLANK SCREEN
LINE NUMBER IS 1
COLUMN NUMBER IS 20
VALUE IS "PATIENT MASTER DATA".
03 SCREEN-B2
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 20
VALUE IS "-------------------".
03 SCREEN-B3
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "KEY :".
03 SCREEN-B4
COLUMN NUMBER IS 29
PIC 9(5) FROM REC-KEY TO REC-KEY
AUTO.
03 SCREEN-B5
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "DATE :".
03 SCREEN-B6
COLUMN NUMBER IS 29
PIC 99 FROM DAY TO DAY
AUTO.
03 SCREEN-B7
COLUMN NUMBER IS 31
VALUE IS "/".
03 SCREEN-B8
COLUMN NUMBER IS 32
PIC 99 FROM MONTH TO MONTH
AUTO.
03 SCREEN-B9
COLUMN NUMBER IS 34
VALUE IS "/".
03 SCREEN-B10
COLUMN NUMBER IS 35
PIC 99 FROM YEAR TO YEAR
AUTO.
03 SCREEN-B11
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "SURNAME :".
03 SCREEN-B12
COLUMN NUMBER IS 29
PIC X(20) FROM NAME-1 TO NAME-1
AUTO.
03 SCREEN-B13
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "FIRST NAMES :".
03 SCREEN-B14
COLUMN NUMBER IS 29
PIC X(20) FROM NAME-2 TO NAME-2
AUTO.
03 SCREEN-B15
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "ADDRESS :".
03 SCREEN-B16
COLUMN NUMBER IS 29
PIC X(20) FROM ADDRESS-1 TO ADDRESS-1
AUTO.
03 SCREEN-B17
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 28
VALUE IS ":".
03 SCREEN-B18
COLUMN NUMBER IS 29
PIC X(20) FROM ADDRESS-2 TO ADDRESS-2
AUTO.
03 SCREEN-B19
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 28
VALUE IS ":".
03 SCREEN-B20
COLUMN NUMBER IS 29
PIC X(20) FROM ADDRESS-3 TO ADDRESS-3
AUTO.
03 SCREEN-B21
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "PHONE NUMBERS - HOME :".
03 SCREEN-B22
COLUMN NUMBER IS 29
PIC X(12) FROM HOME-PHONE TO HOME-PHONE
AUTO.
03 SCREEN-B23
COLUMN NUMBER IS 46
VALUE IS "WORK: ".
03 SCREEN-B24
COLUMN NUMBER IS 52
PIC X(12) FROM WORK-PHONE TO WORK-PHONE
AUTO.
03 SCREEN-B25
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "MEDICAL AID - NAME :".
03 SCREEN-B26
COLUMN NUMBER IS 29
PIC X(30) FROM MED-AID-NAME TO MED-AID-NAME
AUTO.
03 SCREEN-B27
COLUMN NUMBER IS 60
VALUE IS "NUMBER:".
03 SCREEN-B28
COLUMN NUMBER IS 67
PIC X(12) FROM MED-AID-NO TO MED-AID-NO
AUTO.
03 SCREEN-B29
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "DATE OF BIRTH :".
03 SCREEN-B30
COLUMN NUMBER IS 29
PIC X(8) FROM DATE-OF-BIRTH TO DATE-OF-BIRTH
AUTO.
03 SCREEN-B31
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "DIAGNOSIS :".
03 SCREEN-B32
COLUMN NUMBER IS 29
PIC X(30) FROM DIAGNOSIS TO DIAGNOSIS
AUTO.
03 SCREEN-B33
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "NEXT OF KIN :".
03 SCREEN-B34
COLUMN NUMBER IS 29
PIC X(30) FROM NEXT-OF-KIN TO NEXT-OF-KIN
AUTO.
03 SCREEN-B35
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "NOK'S PHONE NUMBERS - HOME:".
03 SCREEN-B36
COLUMN NUMBER IS 29
PIC X(12) FROM NOK-HOME-PHONE TO NOK-HOME-PHONE
AUTO.
03 SCREEN-B37
COLUMN NUMBER IS 46
VALUE IS "WORK : ".
03 SCREEN-B38
COLUMN NUMBER IS 52
PIC X(12) FROM NOK-WORK-PHONE TO NOK-WORK-PHONE
AUTO.
03 SCREEN-B39
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "NOK'S ADDRESS :".
03 SCREEN-B40
COLUMN NUMBER IS 29
PIC X(20) FROM NOK-ADDRESS-1 TO NOK-ADDRESS-1
AUTO.
03 SCREEN-B41
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 28
VALUE IS ":".
03 SCREEN-B42
COLUMN NUMBER IS 29
PIC X(20) FROM NOK-ADDRESS-2 TO NOK-ADDRESS-2
AUTO.
03 SCREEN-B43
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 28
VALUE IS ":".
03 SCREEN-B44
COLUMN NUMBER IS 29
PIC X(20) FROM NOK-ADDRESS-3 TO NOK-ADDRESS-3
AUTO.
03 SCREEN-B45
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "TRANSPLANT DATE :".
03 SCREEN-B46
COLUMN NUMBER IS 29
PIC X(8) FROM TRANS-DATE TO TRANS-DATE
AUTO.
03 SCREEN-B47
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "REASON FOR FAILURE :".
03 SCREEN-B48
COLUMN NUMBER IS 29
PIC X(20) FROM FAILURE-REASON TO FAILURE-REASON
AUTO.
03 SCREEN-B49
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "ELAPSED TIME :".
03 SCREEN-B50
COLUMN NUMBER IS 29
PIC 999 FROM ELAPSED-TIME TO ELAPSED-TIME
AUTO.
03 SCREEN-B51
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "GRAFT REMOVAL DATE :".
03 SCREEN-B52
COLUMN NUMBER IS 29
PIC X(8) FROM GRAFT-REM-DATE TO GRAFT-REM-DATE
AUTO.
03 SCREEN-B53
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "DATE OF DEATH :".
03 SCREEN-B54
COLUMN NUMBER IS 29
PIC X(8) FROM DATE-OF-DEATH TO DATE-OF-DEATH
AUTO.
03 SCREEN-B55
COLUMN NUMBER IS 36
VALUE IS "CAUSE OF DEATH:".
03 SCREEN-B56
COLUMN NUMBER IS 53
PIC X(20) FROM CAUSE-OF-DEATH TO CAUSE-OF-DEATH
AUTO.
03 SCREEN-B57
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "RECIPIENT'S BLOOD TYPE :".
03 SCREEN-B58
COLUMN NUMBER IS 29
PIC X(4) FROM REC-BLOOD-TYPE TO REC-BLOOD-TYPE
AUTO.
03 SCREEN-B59
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "RECIPIENT'S HLA PROFILE :".
03 SCREEN-B60
COLUMN NUMBER IS 29
PIC X(10) FROM REC-HLA-PROF TO REC-HLA-PROF
AUTO.
03 SCREEN-B61
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "DONOR'S BLOOD TYPE :".
03 SCREEN-B62
COLUMN NUMBER IS 29
PIC X(4) FROM DON-BLOOD-TYPE TO DON-BLOOD-TYPE
AUTO.
03 SCREEN-B63
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "DONOR'S HLA PROFILE :".
03 SCREEN-B64
COLUMN NUMBER IS 29
PIC X(10) FROM DON-HLA-PROF TO DON-HLA-PROF
AUTO.
03 SCREEN-B65
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
VALUE IS "DONOR'S BIRTH DATE :".
03 SCREEN-B66
COLUMN NUMBER IS 29
PIC X(8) FROM DON-BIRTH-DATE TO DON-BIRTH-DATE
AUTO.
*
01 SCREEN-DISPLAY-C.
03 SCREEN-C1
BLANK SCREEN
LINE NUMBER IS 1
COLUMN NUMBER IS 20
VALUE IS "PATIENT VISITS".
03 SCREEN-C2
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 20
VALUE IS "--------------".
03 SCREEN-C3
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "KEY øDATE øREASON".
03 SCREEN-C4
COLUMN NUMBER IS 37
VALUE IS "øTEMP1øTEMP2øTEMP3øTEMP4øTEMP5".
03 SCREEN-C5
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC 9(5) FROM REC-KEY TO REC-KEY
AUTO.
03 SCREEN-C6
COLUMN NUMBER IS 8
PIC 99 FROM DAY TO DAY
AUTO.
03 SCREEN-C7
COLUMN NUMBER IS 10
VALUE IS "/".
03 SCREEN-C8
COLUMN NUMBER IS 11
PIC 99 FROM MONTH TO MONTH
AUTO.
03 SCREEN-C9
COLUMN NUMBER IS 13
VALUE IS "/".
03 SCREEN-C10
COLUMN NUMBER IS 14
PIC 99 FROM YEAR TO YEAR
AUTO.
03 SCREEN-C11
COLUMN NUMBER IS 17
PIC X(20) FROM REASON TO REASON
AUTO.
03 SCREEN-C12
COLUMN NUMBER IS 38
PIC 99.99 FROM TEMP1 TO TEMP1
AUTO.
03 SCREEN-C13
COLUMN NUMBER IS 44
PIC 99.99 FROM TEMP2 TO TEMP2
AUTO.
03 SCREEN-C14
COLUMN NUMBER IS 50
PIC 99.99 FROM TEMP3 TO TEMP3
AUTO.
03 SCREEN-C15
COLUMN NUMBER IS 56
PIC 99.99 FROM TEMP4 TO TEMP4
AUTO.
03 SCREEN-C16
COLUMN NUMBER IS 62
PIC 99.99 FROM TEMP5 TO TEMP5
AUTO.
03 SCREEN-C17
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE "BP1 øBP2 øBP3 øBP4 øBP5 øA".
03 SCREEN-C18
COLUMN NUMBER IS 52
VALUE IS "øB".
03 SCREEN-C19
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(5) FROM BP1 TO BP1
AUTO.
03 SCREEN-C20
COLUMN NUMBER IS 8
PIC X(5) FROM BP2 TO BP2
AUTO.
03 SCREEN-C21
COLUMN NUMBER IS 14
PIC X(5) FROM BP3 TO BP3
AUTO.
03 SCREEN-C22
COLUMN NUMBER IS 20
PIC X(5) FROM BP4 TO BP4
AUTO.
03 SCREEN-C23
COLUMN NUMBER IS 26
PIC X(5) FROM BP5 TO BP5
AUTO.
03 SCREEN-B24
COLUMN NUMBER IS 32
PIC X(20) FROM A TO A
AUTO.
03 SCREEN-B25
COLUMN NUMBER IS 53
PIC X(20) FROM B TO B
AUTO.
03 SCREEN-B26
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "C".
03 SCREEN-B27
COLUMN NUMBER IS 22
VALUE IS "øD øE øF øGLUCOSE".
03 SCREEN-B28
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(20) FROM C TO C
AUTO.
03 SCREEN-B29
COLUMN NUMBER IS 23
PIC X(5) FROM D TO D
AUTO.
03 SCREEN-B30
COLUMN NUMBER IS 29
PIC X(5) FROM E TO E
AUTO.
03 SCREEN-B31
COLUMN NUMBER IS 35
PIC X(5) FROM F TO F
AUTO.
03 SCREEN-B32
COLUMN NUMBER IS 41
PIC X(30) FROM GLUCOSE TO GLUCOSE
AUTO.
03 SCREEN-B33
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "DELTA øX".
03 SCREEN-B34
COLUMN NUMBER IS 40
VALUE IS "øY".
03 SCREEN-B35
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(7) FROM DELTA TO DELTA
AUTO.
03 SCREEN-B36
COLUMN NUMBER IS 10
PIC X(30) FROM X TO X
AUTO.
03 SCREEN-B37
COLUMN NUMBER IS 41
PIC X(30) FROM Y TO Y
AUTO.
03 SCREEN-B38
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "Z".
03 SCREEN-B39
COLUMN NUMBER IS 32
VALUE IS"øMED1 øDOSE1".
03 SCREEN-B40
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(30) FROM Z TO Z
AUTO.
03 SCREEN-B41
COLUMN NUMBER IS 33
PIC X(20) FROM MED1 TO MED1
AUTO.
03 SCREEN-B42
COLUMN NUMBER IS 54
PIC X(15) FROM DOSE1 TO DOSE1
AUTO.
03 SCREEN-B43
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "MED2 øDOSE2".
03 SCREEN-B44
COLUMN NUMBER IS 38
VALUE IS "øMED3 øDOSE3".
03 SCREEN-B45
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(20) FROM MED2 TO MED2
AUTO.
03 SCREEN-B46
COLUMN NUMBER IS 23
PIC X(15) FROM DOSE2 TO DOSE2
AUTO.
03 SCREEN-B47
COLUMN NUMBER IS 39
PIC X(20) FROM MED3 TO MED3
AUTO.
03 SCREEN-B48
COLUMN NUMBER IS 60
PIC X(15) FROM DOSE3 TO DOSE3
AUTO.
03 SCREEN-B49
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "MED4 øDOSE4".
03 SCREEN-B50
COLUMN NUMBER IS 38
VALUE IS "øMED5 øDOSE5".
03 SCREEN-B51
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(20) FROM MED4 TO MED4
AUTO.
03 SCREEN-B52
COLUMN NUMBER IS 23
PIC X(15) FROM DOSE4 TO DOSE4
AUTO.
03 SCREEN-B53
COLUMN NUMBER IS 39
PIC X(20) FROM MED5 TO MED5
AUTO.
03 SCREEN-B54
COLUMN NUMBER IS 60
PIC X(15) FROM DOSE5 TO DOSE5
AUTO.
03 SCREEN-B55
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "NA øK øCL øHCO2øUS øAMYøMG øCA ø".
03 SCREEN-B56
COLUMN NUMBER IS 41
VALUE IS "BIL-TOTøCONJ øSGOT øSGPTøAPøLDHøTP".
03 SCREEN-B57
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(5) FROM NA TO NA
AUTO.
03 SCREEN-B58
COLUMN NUMBER IS 8
PIC X(5) FROM K TO K
AUTO.
03 SCREEN-B59
COLUMN NUMBER IS 14
PIC X(5) FROM CL TO CL
AUTO.
03 SCREEN-B60
COLUMN NUMBER IS 20
PIC X(3) FROM HCO2 TO HCO2
AUTO.
03 SCREEN-B61
COLUMN NUMBER IS 25
PIC X(3) FROM US TO US
AUTO.
03 SCREEN-B62
COLUMN NUMBER IS 29
PIC X(3) FROM AMY TO AMY
AUTO.
03 SCREEN-B63
COLUMN NUMBER IS 33
PIC X(3) FROM MG TO MG
AUTO.
03 SCREEN-B64
COLUMN NUMBER IS 37
PIC X(3) FROM CA TO CA
AUTO.
03 SCREEN-B65
COLUMN NUMBER IS 41
PIC X(5) FROM BIL-TOT TO BIL-TOT
AUTO.
03 SCREEN-B66
COLUMN NUMBER IS 49
PIC X(5) FROM CONJ TO CONJ
AUTO.
03 SCREEN-B67
COLUMN NUMBER IS 55
PIC X(5) FROM SGOT TO SGOT
AUTO.
03 SCREEN-B68
COLUMN NUMBER IS 61
PIC XX FROM SGPT TO SGPT
AUTO.
03 SCREEN-B69
COLUMN NUMBER IS 66
PIC XX FROM AP TO AP
AUTO.
03 SCREEN-B70
COLUMN NUMBER IS 69
PIC X(3) FROM LDH TO LDH
AUTO.
03 SCREEN-B71
COLUMN NUMBER IS 73
PIC X(3) FROM TP TO TP
AUTO.
03 SCREEN-B72
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "ALB øA1 øA2 øA3 øALPHAøBETA øGAMMAø".
03 SCREEN-B73
COLUMN NUMBER IS 38
VALUE IS "O2øO2-SATøBASE-EXS øACT-BICøMICRO".
03 SCREEN-B74
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(5) FROM ALB TO ALB
AUTO.
03 SCREEN-B75
COLUMN NUMBER IS 8
PIC X(3) FROM A1 TO A1
AUTO.
03 SCREEN-B76
COLUMN NUMBER IS 12
PIC X(3) FROM A2 TO A2
AUTO.
03 SCREEN-B77
COLUMN NUMBER IS 16
PIC X(3) FROM A3 TO A3
AUTO.
03 SCREEN-B78
COLUMN NUMBER IS 20
PIC X(5) FROM ALPHA TO ALPHA
AUTO.
03 SCREEN-B79
COLUMN NUMBER IS 26
PIC X(5) FROM BETA TO BETA
AUTO.
03 SCREEN-B80
COLUMN NUMBER IS 32
PIC X(5) FROM GAMMA TO GAMMA
AUTO.
03 SCREEN-B81
COLUMN NUMBER IS 38
PIC XX FROM O2 TO O2
AUTO.
03 SCREEN-B82
COLUMN NUMBER IS 41
PIC X(3) FROM O2-SAT TO O2-SAT
AUTO.
03 SCREEN-B83
COLUMN NUMBER IS 48
PIC X(10) FROM BASE-EXS TO BASE-EXS
AUTO.
03 SCREEN-B84
COLUMN NUMBER IS 59
PIC X(5) FROM ACT-BIC TO ACT-BIC
AUTO.
03 SCREEN-B85
COLUMN NUMBER IS 67
PIC X(10) FROM MICRO TO MICRO
AUTO.
03 SCREEN-B86
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "SGøISCH-WøISCH-CøMATCHøREMøIV-PREDø".
03 SCREEN-B87
COLUMN NUMBER IS 37
VALUE IS "IM-AMøIM-PMøPR-AMøPR-PMøINT-AMøTOT ø".
03 SCREEN-B88
COLUMN NUMBER IS 73
VALUE IS "OUT-AM".
03 SCREEN-B89
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC XX FROM SG TO SG
AUTO.
03 SCREEN-B90
COLUMN NUMBER IS 5
PIC X(5) FROM ISCHEMIA-WARM TO ISCHEMIA-WARM
AUTO.
03 SCREEN-B91
COLUMN NUMBER IS 12
PIC X(5) FROM ISCHEMIA-COLD TO ISCHEMIA-COLD
AUTO.
03 SCREEN-B92
COLUMN NUMBER IS 19
PIC X(5) FROM MATCH TO MATCH
AUTO.
03 SCREEN-B93
COLUMN NUMBER IS 25
PIC X(3) FROM REM TO REM
AUTO.
03 SCREEN-B94
COLUMN NUMBER IS 29
PIC X(3) FROM IV-PRED TO IV-PRED
AUTO.
03 SCREEN-B95
COLUMN NUMBER IS 37
PIC X(3) FROM IM-AM TO IM-AM
AUTO.
03 SCREEN-B96
COLUMN NUMBER IS 43
PIC X(3) FROM IM-PM TO IM-PM
AUTO.
03 SCREEN-B97
COLUMN NUMBER IS 49
PIC XX FROM PR-AM TO PR-AM
AUTO.
03 SCREEN-B98
COLUMN NUMBER IS 55
PIC XX FROM PR-PM TO PR-PM
AUTO.
03 SCREEN-B99
COLUMN NUMBER IS 61
PIC X(5) FROM INT-AM TO INT-AM
AUTO.
03 SCREEN-B100
COLUMN NUMBER IS 68
PIC X(5) FROM TOT TO TOT
AUTO.
03 SCREEN-B101
COLUMN NUMBER IS 74
PIC X(5) FROM OUT-AM TO OUT-AM
AUTO.
03 SCREEN-B102
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "WEIGHTøCR øCCRøPLAT øHCTøSTøE øLøB".
03 SCREEN-B103
COLUMN NUMBER IS 41
VALUE IS "øUREA øURINE øNOSE øTHROAT".
03 SCREEN-B104
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC 999 FROM WEIGHT TO WEIGHT
AUTO.
03 SCREEN-B105
COLUMN NUMBER IS 9
PIC X(3) FROM CR TO CR
AUTO.
03 SCREEN-B106
COLUMN NUMBER IS 13
PIC X(3) FROM CCR TO CCR
AUTO.
03 SCREEN-B107
COLUMN NUMBER IS 17
PIC X(5) FROM PLAT TO PLAT
AUTO.
03 SCREEN-B108
COLUMN NUMBER IS 23
PIC XX FROM HCT TO HCT
AUTO.
03 SCREEN-B109
COLUMN NUMBER IS 27
PIC XX FROM ST TO ST
AUTO.
03 SCREEN-B110
COLUMN NUMBER IS 30
PIC X(3) FROM E TO E
AUTO.
03 SCREEN-B111
COLUMN NUMBER IS 34
PIC X FROM L TO L
AUTO.
03 SCREEN-B112
COLUMN NUMBER IS 36
PIC X(5) FROM B TO B
AUTO.
03 SCREEN-B113
COLUMN NUMBER IS 42
PIC X(5) FROM UREA TO UREA
AUTO.
03 SCREEN-B114
COLUMN NUMBER IS 48
PIC X(10) FROM URINE TO URINE
AUTO.
03 SCREEN-B115
COLUMN NUMBER IS 59
PIC X(5) FROM NOSE TO NOSE
AUTO.
03 SCREEN-B116
COLUMN NUMBER IS 65
PIC X(5) FROM THROAT TO THROAT
AUTO.
03 SCREEN-B117
LINE NUMBER IS PLUS 2
COLUMN NUMBER IS 2
VALUE IS "BLD øOTHER".
03 SCREEN-B118
LINE NUMBER IS PLUS 1
COLUMN NUMBER IS 2
PIC X(10) FROM BLD TO BLD
AUTO.
03 SCREEN-B119
COLUMN NUMBER IS 13
PIC X(20) FROM OTHER TO OTHER
AUTO.
*
*
*
PROCEDURE DIVISION.
CONTROL.
DISPLAY SCREEN-DISPLAY-A.
ACCEPT W02-OPTION WITH AUTO-SKIP.
PERFORM PROCESS
UNTIL W02-OPTION = "5".
STOP RUN.
*
*
*
PROCESS.
IF W02-OPTION = "1"
PERFORM ADD-MASTER.
IF W02-OPTION = "2"
PERFORM ADD-VISIT.
IF W02-OPTION = "3"
PERFORM AMEND-VISIT.
IF W02-OPTION = "4"
PERFORM DISPLAY-DATA.
DISPLAY SCREEN-DISPLAY-A.
ACCEPT W02-OPTION WITH AUTO-SKIP.
*
*
*
ADD-MASTER.
OPEN PATIENT-FILE OUTPUT.
DISPLAY SCREEN-DISPLAY-B.
ACCEPT SCREEN-DISPLAY-B.
WRITE PATIENT-HEADER.
*
*
*
INIT-TABLE.
MOVE ZEROES TO W03-V-TEMP1 (W04-TAB-SUB)
W03-V-TEMP2 (W04-TAB-SUB)
W03-V-TEMP3 (W04-TAB-SUB)
W03-V-TEMP4 (W04-TAB-SUB)
W03-V-TEMP5 (W04-TAB-SUB)
W03-V-WEIGHT (W04-TAB-SUB).
MOVE SPACES TO W03-V-DATE (W04-TAB-SUB)
W03-V-REASON (W04-TAB-SUB)
W03-V-BP1 (W04-TAB-SUB)
W03-V-BP2 (W04-TAB-SUB)
W03-V-BP3 (W04-TAB-SUB)
W03-V-BP4 (W04-TAB-SUB)
W03-V-BP5 (W04-TAB-SUB)
W03-V-A (W04-TAB-SUB)
W03-V-B (W04-TAB-SUB)
W03-V-C (W04-TAB-SUB)
W03-V-D (W04-TAB-SUB)
W03-V-E (W04-TAB-SUB)
W03-V-F (W04-TAB-SUB)
W03-V-GLUCOSE (W04-TAB-SUB)
W03-V-X (W04-TAB-SUB)
W03-V-Y (W04-TAB-SUB)
W03-V-Z (W04-TAB-SUB)
W03-V-MED1 (W04-TAB-SUB)
W03-V-DOSE1 (W04-TAB-SUB)
W03-V-MED1 (W04-TAB-SUB)
W03-V-DOSE2 (W04-TAB-SUB)
W03-V-MED3 (W04-TAB-SUB)
W03-V-DOSE3 (W04-TAB-SUB)
W03-V-MED4 (W04-TAB-SUB)
W03-V-DOSE4 (W04-TAB-SUB)
W03-V-MED5 (W04-TAB-SUB)
W03-V-DOSE5 (W04-TAB-SUB)
W03-V-NA (W04-TAB-SUB)
W03-V-K (W04-TAB-SUB)
W03-V-CL (W04-TAB-SUB)
W03-V-HCO2 (W04-TAB-SUB)
W03-V-US (W04-TAB-SUB)
W03-V-AMY (W04-TAB-SUB)
W03-V-MG (W04-TAB-SUB)
W03-V-CA (W04-TAB-SUB)
W03-V-BIL-TOT (W04-TAB-SUB)
W03-V-CONJ (W04-TAB-SUB)
W03-V-SGOT (W04-TAB-SUB)
W03-V-SGPT (W04-TAB-SUB)
W03-V-AP (W04-TAB-SUB)
W03-V-LDH (W04-TAB-SUB)
W03-V-TP (W04-TAB-SUB)
W03-V-ALB (W04-TAB-SUB)
W03-V-A1 (W04-TAB-SUB)
W03-V-A2 (W04-TAB-SUB)
W03-V-A3 (W04-TAB-SUB)
W03-V-ALPHA (W04-TAB-SUB)
W03-V-BETA (W04-TAB-SUB)
W03-V-GAMMA (W04-TAB-SUB)
W03-V-O2 (W04-TAB-SUB)
W03-V-O2-SAT (W04-TAB-SUB)
W03-V-BASE-EXS (W04-TAB-SUB)
W03-V-ACT-BIC (W04-TAB-SUB)
W03-V-MICRO (W04-TAB-SUB)
W03-V-SG (W04-TAB-SUB)
W03-V-ISCHEMIA-W (W04-TAB-SUB)
W03-V-ISCHEMIA-C (W04-TAB-SUB)
W03-V-MATCH (W04-TAB-SUB)
W03-V-REM (W04-TAB-SUB)
W03-V-IV-PRED (W04-TAB-SUB)
W03-V-IM-AM (W04-TAB-SUB)
W03-V-IM-PM (W04-TAB-SUB)
W03-V-PR-AM (W04-TAB-SUB)
W03-V-PR-PM (W04-TAB-SUB)
W03-V-INT-AM (W04-TAB-SUB)
W03-V-TOT (W04-TAB-SUB)
W03-V-OUT-AM (W04-TAB-SUB)
W03-V-WEIGHT (W04-TAB-SUB)
W03-V-CR (W04-TAB-SUB)
W03-V-CCR (W04-TAB-SUB)
W03-V-PLAT (W04-TAB-SUB)
W03-V-HCT (W04-TAB-SUB)
W03-V-ST (W04-TAB-SUB)
W03-V-E (W04-TAB-SUB)
W03-V-L (W04-TAB-SUB)
W03-V-B (W04-TAB-SUB)
W03-V-UREA (W04-TAB-SUB)
W03-V-URINE (W04-TAB-SUB)
W03-V-NOSE (W04-TAB-SUB)
W03-V-THROAT (W04-TAB-SUB)
W03-V-BLD (W04-TAB-SUB)
W03-V-OTHER (W04-TAB-SUB).
ADD 1 TO W04-TAB-SUB.
*
*
*
CHECK-DATE.
IF DAY < 1 OR > 31
MOVE "1" TO W10-INVALID
GO TO C-1
ELSE
MOVE "0" TO W10-INVALID.
IF MONTH < 1 OR > 12
MOVE "1" TO W10-INVALID
GO TO C-1
ELSE
MOVE "0" TO W10-INVALID.
C-1.
IF W10-INVALID = "1"
DISPLAY (LIN 10,COL 10) "INVALID DATE - "
DISPLAY (LIN 10,COL 25) "PLEASE RE-ENTER ".
*
*
*
9999 NOK-ADDRESS-3 PIC X(20).
«eof»