diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.card b/software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.card new file mode 100644 index 0000000..58e4d4f --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.card @@ -0,0 +1,829 @@ +?COMPILE MRS081/NEW ALGOL GO +?DATA CARD +$CARD LIST SINGLE + BEGIN + COMMENT CONGENITAL HEART DISEASE DIAGNOSIS PROGRAM. + FROM A SET OF CLINICAL SYMPTOMS, THE PROBABILITIES + FOR EACH OF THE 33 CONGENITAL HEART DISEASES BEING + PRESENT IN THE PATIENT UNDER CONSIDERATION IS + CALCULATED AND THOSE GREATER THAN ONE PERCENT + ARE PRINTED OUT TOGETHER WITH DISEASE IDENTIFICATION + AND CASE INFORMATION. + + FRED B FIELDING + SAN FRANCISCO DISTRICT OFFICE + + CARD SEQUENCE CODE FOR THE PROGRAM STARTS WITH + CHDD0001 AND ROW 01-1 FOR SYMPTOM-DISEASE MATRIX. + FIRST RELEASE 05 - 31 - 61; + + + INTEGER CASENO, CASEIN, SHEET, XRAY, EQUATION, + MO, DAY, YEAR, LAST, + E, J, K, P, X, + TOTE, TOTP, TOTX, OUTSHEET, + T22, T2021, T4243, T4445, T6789; + + REAL SUM; + + INTEGER ARRAY SYE[1:20], SYP[1:20], TE[1:50], TP[1:50], + ROW[1:51], MX[1:10], M[1:33,1:18]; + + REAL ARRAY FTROW[1:50], FTMX[1:10], PYKX[1:33], PYX[1:33]; + + LABEL NEWCASE, CARD1, CARD2, EQTEST, XP9, TAL9, EQ10, + CARD3, XP10, X1TO3, X4TO7, X26, LAB5, BNORWH, BROWN, + X17TO19, X20, WHITE, X40, X2369, FLTMX, TAL10, + NORM, PRINT, TALPT, EOF, + Y01, Y02, Y03, Y04, Y05, Y06, Y07, Y08, Y09, Y10, + Y11, Y12, Y13, Y14, Y15, Y16, Y17, Y18, Y19, Y20, + Y21, Y22, Y23, Y24, Y25, Y26, Y27, Y28, Y29, Y30, + Y31, Y32, Y33; + + SWITCH SWOUT:= Y01,Y02,Y03,Y04,Y05,Y06,Y07,Y08,Y09, + Y10,Y11,Y12,Y13,Y14,Y15,Y16,Y17,Y18,Y19,Y20,Y21, + Y22,Y23,Y24,Y25,Y26,Y27,Y28,Y29,Y30,Y31,Y32,Y33; + + FILE IN CARD(1, 10); + FILE OUT LINE 17(1,17); + + LIST MATRIX(FOR K:= 1 STEP 1 UNTIL 33 DO + FOR J:= 1 STEP 1 UNTIL 18 DO M[K,J]), + KASE(CASENO, CASEIN, SHEET, XRAY, EQUATION, + MO, DAY, YEAR, LAST), + IDOUT(CASENO, CASEIN, MO, DAY, YEAR), + PRESENT(FOR P:= 1 STEP 1 UNTIL 20 DO SYP[P]), + POUT(FOR P:= 1 STEP 1 UNTIL TOTP DO SYP[P]), + EXCLUDE(FOR E:= 1 STEP 1 UNTIL 20 DO SYE[E]), + EOUT(FOR E:= 1 STEP 1 UNTIL TOTE+1 DO SYE[E]), + SHOUT(OUTSHEET), + EQOUT(EQUATION), + ANS(FOR X:= K DO PYX[X]); + + FORMAT OUT IDFORM(X5,"CASE NUMBER",I7,X5,"PATIENT",X2,A3,X5, + "DATE",X1,3(I3)), + PFORM(/,X5,"SYMPTOMS PRESENT",X4,20(I4)), + EFORM(/,X5,"SYMPTOMS OMITTED",X4,20(I4)), + SHFORM(/,X5,"SYMPTOMS USED",X3,A2), + EQFORM(X5,"EQUATION USED",I5), + HEAD(X15,"DISEASE",X5,"PROBABILITY"), + + FORM1(X8,"Y01",X7,"N",F16.4), + FORM2(X8,"Y02",X5,"A S D",F14.4), + FORM3(X8,"Y03",X2,"A S D - P S",F11.4), + FORM4(X8,"Y04",X2,"A S D - P H",F11.4), + FORM5(X8,"Y05",X4,"C E C D",F13.4), + FORM6(X8,"Y06",X3,"P A P V C",F12.4), + FORM7(X8,"Y07",X3,"T A P V C",F12.4), + FORM8(X8,"Y08",X6,"T A",F15.4), + FORM9(X8,"Y09",X5,"EBST.",F14.4), + FORM10(X8,"Y10",X1,"V S D - V P S",F10.4), + FORM11(X8,"Y11",X1,"V S D - I P S",F10.4), + FORM12(X8,"Y12",X5,"V P S",F14.4), + FORM13(X8,"Y13",X5,"I P S",F14.4), + FORM14(X8,"Y14",X3,"P. ATRES.",F12.4), + FORM15(X8,"Y15",X2,"COARCT. P A",F11.4), + FORM16(X8,"Y16",X6,"P H",F15.4), + FORM17(X8,"Y17",X5,"A P W",F14.4), + FORM18(X8,"Y18",X5,"P D A",F14.4), + FORM19(X8,"Y19",X2,"P A-V FIST.",F11.4), + FORM20(X8,"Y20",X6,"M S",F15.4), + FORM21(X8,"Y21",X4,"MYOC. D",F13.4), + FORM22(X8,"Y22",X2,"A O COR. A",F12.4), + FORM23(X8,"Y23",X2,"A S - VALV.",F11.4), + FORM24(X8,"Y24",X2,"A S - SUB.",F12.4), + FORM25(X8,"Y25",X3,"COARCT. A",F12.4), + FORM26(X8,"Y26",X4,"TRUNC.",F14.4), + FORM27(X8,"Y27",X3,"TRANSP.",F14.4), + FORM28(X8,"Y28",X3,"C TRANSP.",F12.4), + FORM29(X8,"Y29",X4,"AB. A O",F13.4), + FORM30(X8,"Y30",X5,"V S D",F14.4), + FORM31(X8,"Y31",X2,"V S D - P H",F11.4), + FORM32(X8,"Y32",X2,"P D A - P H",F11.4), + FORM33(X8,"Y33",X1,"T A - TRANSP.",F10.4); + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + PROCEDURE UNPACK(M, SHEET, XRAY, EQUATION, ROW); + VALUE SHEET, XRAY, EQUATION; + INTEGER SHEET, XRAY, EQUATION; + INTEGER ARRAY M[1], ROW[1]; + BEGIN + INTEGER + ROWX; + + PROCEDURE UPACK(M, MX, ROW, ROWX, COUNT); + VALUE MX, ROWX, COUNT; + INTEGER MX, ROWX, COUNT; + INTEGER ARRAY M[1], ROW[1]; + BEGIN + DO BEGIN + ROW[ROWX]:= (M[MX] DIV 1000000) MOD 1000; + ROW[ROWX+1]:= (M[MX] DIV 1000) MOD 1000; + ROW[ROWX+2]:= M[MX] MOD 1000; + ROWX:= ROWX+3; + MX:= MX+1; + COUNT:= COUNT-1; + END + UNTIL COUNT < 0; % MODELS 220 DFL/BRP INSTRUCTION + END UPACK; + + ROWX:= 1; + IF EQUATION ! 10 THEN + UPACK(M, 2, ROW, ROWX, 16) + ELSE + BEGIN + UPACK(M, 2, ROW, ROWX, 4); + ROWX:= ROWX+21; % ROWX=22 + UPACK(M, 9, ROW, ROWX, 5); + ROWX:= ROWX+27; % ROWX=49 + UPACK(M, 18, ROW, ROWX, 0); + IF SHEET ! 1 THEN + BEGIN + UPACK(M, 7, ROW, ROWX-33, 1); % ROWX=16 + ROW[ROWX]:= 0; + END + ELSE + BEGIN + ROW[19]:= (M[8] DIV 1000000) MOD 1000; + ROWX:= ROWX-9; % ROWX=40 + UPACK(M, 15, ROW, ROWX, 2); + END; + END; + END UNPACK; + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + MONITOR LINE(PYKX, PYX, K, SUM); + + COMMENT READ DATA FOR SYMPTOM-DISEASE MATRIX.; + READ(CARD, /, MATRIX); + + COMMENT THE PROGRAM BEGINS HERE. THE FIRST TWO INPUT CARDS + ARE READ, THE FIRST TWO LINES OF OUTPUT ARE PRINTED, + THE NUMBER OF SYMPTOMS ARE CALCULATED, + AND THE EQUATION TYPE DETERMINED.; + + NEWCASE: FOR P:= 1 STEP 1 UNTIL 20 DO + SYP[P]:= 0; + FOR J:= 1 STEP 1 UNTIL 50 DO + TP[J]:= ROW[J]:= 0; + FOR J:= 1 STEP 1 UNTIL 50 DO + FTROW[J]:= 0.0; + + CARD1: READ(CARD, /, KASE) [EOF]; + WRITE(LINE[PAGE]); + WRITE(LINE, IDFORM, IDOUT); + CARD2: READ(CARD, /, PRESENT); + P:= 1; + FOR J:= 1 STEP 1 UNTIL 50 DO + BEGIN + IF SYP[P] = J THEN + BEGIN + TP[J]:= 1; + P:= P+1 + END; + END; + + TOTP:= P - 1; + WRITE(LINE, PFORM, POUT); + K:= 1; + IF SHEET = 1 THEN + BEGIN + OUTSHEET:= "W "; + GO TO EQTEST + END; + OUTSHEET:= "B "; + + EQTEST: IF EQUATION = 10 THEN + GO TO EQ10; + + COMMENT CALCULATE PROBABILITIES USING EQUATION 9.; + + COMMENT ONE ROW OF THE MATRIX IS UNPACKED AND THE + INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED.; + + XP9: UNPACK(M[K,*], SHEET, XRAY, EQUATION, ROW[*]); + FOR J:= 8 STEP 1 UNTIL 16, 24, 25, + 30 STEP 1 UNTIL 33, 38, 39, 50 DO + BEGIN + IF TP[J] = 1 THEN + ROW[J]:= 1000 - ROW[J] + END; + + COMMENT THE ROW-PRODUCT IS CALCULATED AND ZEROES TESTED FOR.; + PYKX[K]:= M[K,1]; + FOR P:= 1 STEP 1 UNTIL TOTP DO + BEGIN + IF ROW[SYP[P]] = 0 THEN + BEGIN + PYKX[K]:= 0.0; + GO TO TAL9 + END; + FTROW[P]:= ROW[SYP[P]] + END; + + FOR P:= 1 STEP 1 UNTIL TOTP DO + PYKX[K]:= PYKX[K]|FTROW[P]; + + TAL9: K:= K+1; + IF K { 33 THEN + GO TO XP9; + GO TO NORM; + + + COMMENT CALCULATE PROBABILITIES USING EQUATION 10.; + + EQ10: FOR J:= 1 STEP 1 UNTIL 50 DO + TE[J]:= 0; + FOR E:= 1 STEP 1 UNTIL 20 DO + SYE[E]:= 0; + FOR X:= 1 STEP 1 UNTIL 10 DO + MX[X]:= 0; + FOR X:= 1 STEP 1 UNTIL 10 DO + FTMX[X]:= 0.0; + + COMMENT THE THIRD INPUT CARD IS READ, THE THIRD LINE OF + OUTPUT IS PRINTED, AND THE NUMBER OF SYMPTOMS + TO BE OMITTED FOR THIS CASE IS CALCULATED.; + + CARD3: READ(CARD, /, EXCLUDE); + E:= 1; + FOR J:= 1 STEP 1 UNTIL 50 DO + BEGIN + IF SYE[E] = J THEN + BEGIN + TE[J]:= 1; + E:= E+1 + END; + END; + + TOTE:= E-1; + WRITE(LINE, EFORM, EOUT); + TOTX:= SHEET+8; + + COMMENT ONE ROW OF THE MATRIX IS UNPACKED, THE + INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED, + AND THE SYMPTOMS OMITTED FOR THIS CASE DELETED.; + + XP10: UNPACK(M[K,*], SHEET, XRAY, EQUATION, ROW[*]); + FOR J:= 8 STEP 1 UNTIL 15, 24, 25, + 30 STEP 1 UNTIL 33, 38, 39, 50 DO + BEGIN + IF TP[J] = 1 THEN + ROW[J]:= 1000 - ROW[J]; + IF ROW[J] = 0 THEN + BEGIN + PYKX[K]:= 0.0; + GO TO TAL10 + END; + IF TE[J] = 1 THEN + ROW[J]:= 0 + END; + + COMMENT THE ROW-PRODUCT IS CALCULATED FOR THOSE INDEPENDENT + SYMPTOMS COMMON TO BOTH SHEETS, ZERO VALUES TESTED + FOR, AND EACH ELEMENT SCALED.; + + PYKX[K]:= M[K,1]; + FOR J:= 8 STEP 1 UNTIL 15, 24, 25, + 30 STEP 1 UNTIL 33, 38, 39, 50 DO + BEGIN + FTROW[J]:= ROW[J]; + FTROW[J]:= FTROW[J]/100.0; + IF FTROW[J] ! 0.0 THEN + PYKX[K]:= PYKX[K]|FTROW[J] + END; + + + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY + EXCLUSIVE SYMPTOM-SETS COMMON TO BOTH BROWN AND + WHITE SYMPTOM CHECK SHEETS PER TABLE V.; + + X1TO3: MX[1]:= ROW[SYP[1]]; + X4TO7: IF TE[4] = 1 THEN + BEGIN + MX[2]:= 100; + GO TO X26 + END; + IF SYP[2] { 7 THEN + BEGIN + MX[2]:= ROW[SYP[2]]; + GO TO X26 + END; + MX[2]:= 1000 - ROW[4] - ROW[5] - ROW[6] - ROW[7]; + + X26: X:= 3; + FOR J:= 26, 28, 34, 36 DO + BEGIN + IF TE[J] = 1 THEN + BEGIN + MX[X]:= 100; + GO TO LAB5 + END; + IF TP[J] = TP[J+1] THEN + BEGIN + MX[X]:= 1000 - ROW[J] - ROW[J+1]; + GO TO LAB5 + END; + IF TP[J] = 1 THEN + BEGIN + MX[X]:= ROW[J]; + GO TO LAB5 + END; + MX[X]:= ROW[J+1]; + LAB5: X:= X+1 + END; + + BNORWH: IF SHEET = 1 THEN + GO TO WHITE; + + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY + EXCLUSIVE SYMPTOM-SETS FOR THE BROWN SHEET OPTION.; + + BROWN: IF TP[16] = 1 THEN + ROW[16]:= 1000 - ROW[16]; + IF ROW[16] = 0 THEN + BEGIN + PYKX[K]:= 0.0; + GO TO TAL10 + END; + IF TE[16] = 1 THEN + BEGIN + ROW[16]:= 0; + GO TO X17TO19 + END; + + BEGIN + FTROW[16]:= ROW[16]; + PYKX[K]:= PYKX[K]|FTROW[16] / 100.0 + END; + + X17TO19: IF TE[17] = 1 THEN + BEGIN + MX[7]:= 100; + GO TO X20 + END; + IF TP[17] = TP[18] AND TP[18] = TP[19] THEN + BEGIN + MX[7]:= (1000-ROW[17])|(1000-ROW[18])| + (1000-ROW[19]); + GO TO X20 + END; + IF TP[19] = 1 THEN + BEGIN + MX[7]:= ROW[19]; + GO TO X20 + END; + IF TP[17] = 0 THEN + BEGIN + MX[7]:= ROW[18]|(1000 - ROW[17]); + GO TO X20 + END; + IF TP[18] = 0 THEN + BEGIN + MX[7]:= ROW[17]|(1000 - ROW[18]); + GO TO X20 + END; + MX[7]:= ROW[17]|ROW[18]; + + X20: IF TE[20] = 1 THEN + BEGIN + MX[8]:= 100; + GO TO FLTMX + END; + + T2021:= (1000 - ROW[20] - ROW[21]); + T22:= (1000 - ROW[22]); + + IF (TP[20] = TP[21]) AND (TP[21] = TP[22]) + AND (TP[22] = TP[23]) THEN + BEGIN + MX[8]:= T2021|T22|(1000 - ROW[23]); + GO TO FLTMX + END; + IF TP[20] = 1 THEN + BEGIN + IF TP[22] = 1 THEN + BEGIN + MX[8]:= ROW[20]|ROW[22]; + GO TO FLTMX + END; + MX[8]:= ROW[20]|T22; + GO TO FLTMX + END; + + IF TP[21] = 1 THEN + BEGIN + IF TP[22] = 1 THEN + BEGIN + MX[8]:= ROW[21]|ROW[22]; + GO TO FLTMX + END; + MX[8]:= ROW[21]|T22; + GO TO FLTMX + END; + IF TP[22] = 1 THEN + BEGIN + MX[8]:= ROW[22]|T2021; + GO TO FLTMX + END; + MX[8]:= ROW[23]; + GO TO FLTMX; + + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY + EXCLUSIVE SYMPTOM-SETS FOR THE WHITE SHEET OPTION.; + + WHITE: IF (TE[19] = TE[42])AND (TE[42] = TE[44]) + AND (TE[44] = 1)THEN + BEGIN + MX[7]:= 100; + GO TO X40 + END; + + T4243:= (1000 - ROW[42] - ROW[43]); + T4445:= (1000 - ROW[44] - ROW[45]); + + IF (TP[19] = TP[42]) AND (TP[42] = TP[43]) + AND (TP[43] = TP[44]) AND (TP[44] = TP[45]) THEN + BEGIN + MX[7]:= (1000 - ROW[19])|T4243|T4445; + GO TO X40 + END; + IF TP[19] = 1 THEN + BEGIN + MX[7]:= ROW[19]; + GO TO X40 + END; + IF TP[42] = 1 THEN + BEGIN + IF TP[44] = 1 THEN + BEGIN + MX[7]:= ROW[42]|ROW[44]; + GO TO X40 + END; + IF TP[45] = 1 THEN + BEGIN + MX[7]:= ROW[42]|ROW[45]; + GO TO X40 + END; + MX[7]:= ROW[42]|T4445; + GO TO X40 + END; + + IF TP[43] = 1 THEN + BEGIN + IF TP[44] = 1 THEN + BEGIN + MX[7]:= ROW[43]|ROW[44]; + GO TO X40 + END; + IF TP[45] = 1 THEN + BEGIN + MX[7]:= ROW[43]|ROW[45]; + GO TO X40 + END; + MX[7]:= ROW[43]|T4445; + GO TO X40 + END; + + IF TP[44] = 1 THEN + BEGIN + MX[7]:= ROW[44]|T4243; + GO TO X40 + END; + MX[7]:= ROW[45]|T4243; + + X40: IF TE[40] = 1 THEN + BEGIN + MX[8]:= 100; + GO TO X2369 + END; + + IF TP[40] = TP[41] THEN + BEGIN + MX[8]:= 1000 - ROW[40] - ROW[41]; + GO TO X2369 + END; + + IF TP[40] = 1 THEN + BEGIN + MX[8]:= ROW[40]; + GO TO X2369 + END; + MX[8]:= ROW[41]; + + X2369: IF (TE[22] = TE[46]) AND (TE[46] = 1) THEN + BEGIN + MX[9]:= 100; + GO TO FLTMX + END; + + T22:= 1000 - ROW[22]; + T6789:= 1000 - ROW[46] - ROW[47] - ROW[48] - ROW[49]; + + IF (TP[22] = TP[23]) AND (TP[23] = TP[46]) + AND (TP[46] = TP[47]) AND (TP[47] = TP[48]) + AND (TP[48] = TP[49]) THEN + BEGIN + MX[9]:= T22|(1000 - ROW[23])|T6789; + GO TO FLTMX + END; + + IF TP[22] = 1 THEN + BEGIN + FOR J:= 46 STEP 1 UNTIL 49 DO + BEGIN + IF TP[J] = 1 THEN + BEGIN + MX[9]:= ROW[J]|ROW[22]; + GO TO FLTMX + END; + END; + MX[9]:= ROW[22]|T6789; + GO TO FLTMX + END; + + FOR J:= 46 STEP 1 UNTIL 49 DO + BEGIN + IF TP[J] = 1 THEN + BEGIN + MX[9]:= ROW[J]|T22; + GO TO FLTMX + END; + END; + + MX[9]:= ROW[23]; + GO TO FLTMX; + + FLTMX: FOR X:= 1 STEP 1 UNTIL TOTX DO + BEGIN + FTMX[X]:= MX[X]; + FTMX[X]:= FTMX[X]/100.00 + END; + + FOR X:= 1 STEP 1 UNTIL TOTX DO + PYKX[K]:= PYKX[K]|FTMX[X]; + + COMMENT AT THIS POINT, THE ROW-PRODUCT HAS BEEN COMPUTED + AND A TEST IS MADE TO DETERMINE WHETHER THERE + ARE MORE ROWS YET TO BE PROCESSED, OR TO PRINT-OUT.; + + TAL10: K:= K+1; + IF K { 33 THEN + GO TO XP10; + GO TO NORM; + + COMMENT THE ROW-PROBABILITIES ARE FIRST NORMALIZED TO GIVE A + TRUE PERCENTAGE FIGURE AND LINES 4 - 6 ARE PRINTED.; + + NORM: SUM:= 0.0; + WRITE(LINE, SHFORM, SHOUT); + FOR K:= 1 STEP 1 UNTIL 33 DO + SUM:= SUM + PYKX[K]; + WRITE(LINE, EQFORM, EQOUT); + FOR K:= 1 STEP 1 UNTIL 33 DO + PYX[K]:= PYKX[K] / SUM; + + WRITE(LINE, HEAD); + + COMMENT THE PROBABILITIES ARE NOW PRINTED WHICH ARE ONE + PERCENT OR GREATER TOGETHER WITH DISEASE I. D. .; + + K:= 1; + PRINT: IF PYX[K] < 0.01 THEN + GO TO TALPT; + + GO TO SWOUT[K]; + Y01: WRITE(LINE, FORM1, ANS); + GO TO TALPT; + Y02: WRITE(LINE, FORM2, ANS); + GO TO TALPT; + Y03: WRITE(LINE, FORM3, ANS); + GO TO TALPT; + Y04: WRITE(LINE, FORM4, ANS); + GO TO TALPT; + Y05: WRITE(LINE, FORM5, ANS); + GO TO TALPT; + Y06: WRITE(LINE, FORM6, ANS); + GO TO TALPT; + Y07: WRITE(LINE, FORM7, ANS); + GO TO TALPT; + Y08: WRITE(LINE, FORM8, ANS); + GO TO TALPT; + Y09: WRITE(LINE, FORM9, ANS); + GO TO TALPT; + Y10: WRITE(LINE, FORM10, ANS); + GO TO TALPT; + Y11: WRITE(LINE, FORM11, ANS); + GO TO TALPT; + Y12: WRITE(LINE, FORM12, ANS); + GO TO TALPT; + Y13: WRITE(LINE, FORM13, ANS); + GO TO TALPT; + Y14: WRITE(LINE, FORM14, ANS); + GO TO TALPT; + Y15: WRITE(LINE, FORM15, ANS); + GO TO TALPT; + Y16: WRITE(LINE, FORM16, ANS); + GO TO TALPT; + Y17: WRITE(LINE, FORM17, ANS); + GO TO TALPT; + Y18: WRITE(LINE, FORM18, ANS); + GO TO TALPT; + Y19: WRITE(LINE, FORM19, ANS); + GO TO TALPT; + Y20: WRITE(LINE, FORM20, ANS); + GO TO TALPT; + Y21: WRITE(LINE, FORM21, ANS); + GO TO TALPT; + Y22: WRITE(LINE, FORM22, ANS); + GO TO TALPT; + Y23: WRITE(LINE, FORM23, ANS); + GO TO TALPT; + Y24: WRITE(LINE, FORM24, ANS); + GO TO TALPT; + Y25: WRITE(LINE, FORM25, ANS); + GO TO TALPT; + Y26: WRITE(LINE, FORM26, ANS); + GO TO TALPT; + Y27: WRITE(LINE, FORM27, ANS); + GO TO TALPT; + Y28: WRITE(LINE, FORM28, ANS); + GO TO TALPT; + Y29: WRITE(LINE, FORM29, ANS); + GO TO TALPT; + Y30: WRITE(LINE, FORM30, ANS); + GO TO TALPT; + Y31: WRITE(LINE, FORM31, ANS); + GO TO TALPT; + Y32: WRITE(LINE, FORM32, ANS); + GO TO TALPT; + Y33: WRITE(LINE, FORM33, ANS); + GO TO TALPT; + + TALPT: K:= K+1; + IF K { 33 THEN + GO TO PRINT; + + COMMENT PROGRAM REPEATS TO BEGINNING IF THERE ARE MORE + CASES TO BE RUN, AND HALTS IF NOT. THE INITIALS + H W APPEAR IN THE A-REG. UPON COMPLETION.; + + IF LAST = 0 THEN + GO TO NEWCASE; + COMMENT STOP 7270061216; + COMMENT GO TO NEWCASE; + EOF: + END. +?DATA CARD + 100, /ROW 01@1 + 010490500,010000010,000990990,900970950,950970950,990700020,/ROW 01@2 + 070000800,010050990,999010010,150050900,970990990,010020020,/ROW 01@3 + 020980980,010000020,700040030,000000800,050900000, /ROW 01@4 + 081, /ROW 02@1 + 100500500,020010020,000990650,500950980,600990980,980300200,/ROW 02@2 + 020050900,020020990,990010010,600010200,990990990,700050050,/ROW 02@3 + 850980980,010020010,300020200,050010900,010400000, /ROW 02@4 + 005, /ROW 03@1 + 300600100,200100200,000990400,300950980,900900980,980050050,/ROW 03@2 + 020570400,010030990,990010020,300150600,990950990,850020200,/ROW 03@3 + 700980980,010010010,050010050,600010380,010300000, /ROW 03@4 + 001, /ROW 04@1 + 100200700,300100250,000990200,100950950,850900980,980150200,/ROW 04@2 + 020050400,200010990,990010010,950010500,990950990,850050200,/ROW 04@3 + 700980980,010020010,150200020,050010400,010600000, /ROW 04@4 + 027, /ROW 05@1 + 200500300,150050100,000990600,500950950,700950400,850900400,/ROW 05@2 + 020100200,100010990,990010010,700020600,900900990,050700050,/ROW 05@3 + 850980980,150010850,050020200,020200200,200200000, /ROW 05@4 + 005, /ROW 06@1 + 100400500,010010010,000990850,800990950,950990980,980020020,/ROW 06@2 + 020020600,050050990,990100150,400020900,990990990,150020020,/ROW 06@3 + 150980980,020020020,200020020,020020600,020700000, /ROW 06@4 + 001, /ROW 07@1 + 200700100,650100050,000990300,200950950,800950980,980100150,/ROW 07@2 + 100050750,050200990,990100150,850020200,990990990,900020250,/ROW 07@3 + 750980980,020020300,100010300,050010800,020300000, /ROW 07@4 + 018, /ROW 08@1 + 500480020,300650010,000900200,100800950,850900980,950650050,/ROW 08@2 + 050200200,020050990,990010010,020600990,800700990,020900020,/ROW 08@3 + 020100900,050020500,150050020,200200200,200500000, /ROW 08@4 + 001, /ROW 09@1 + 100450450,220440010,000780200,200900700,850780950,750950250,/ROW 09@2 + 050050150,020050990,990010010,020350900,800900990,100200020,/ROW 09@3 + 600980980,250250450,450250250,150150050,050500000, /ROW 09@4 + 054, /ROW 10@1 + 400550050,250250100,000700250,100950950,900800980,980200020,/ROW 10@2 + 050650250,020050980,980100150,100600800,990980990,950020850,/ROW 10@3 + 100980980,020020200,050020020,600050250,050100000, /ROW 10@4 + 063, /ROW 11@1 + 400550050,300300100,000600250,100950950,900750980,980200020,/ROW 11@2 + 050650250,020050980,980100150,100600800,990980990,950020850,/ROW 11@3 + 100980980,020020200,050020020,600050250,050100000, /ROW 11@4 + 045, /ROW 12@1 + 200700100,010010010,000990500,350990990,990900980,980100020,/ROW 12@2 + 050700200,020100980,980010010,100600800,990950990,950020850,/ROW 12@3 + 100980980,010010010,100020020,680010250,010200000, /ROW 12@4 + 013, /ROW 13@1 + 200700100,010010010,000990500,350990990,990900980,980100020,/ROW 13@2 + 020700200,020020980,980010010,100600800,990950990,950020850,/ROW 13@3 + 100980980,010010010,100010010,680010250,010200000, /ROW 13@4 + 014, /ROW 14@1 + 900090010,100900000,000200100,010950000,950650980,980400050,/ROW 14@2 + 050010020,020050980,980100100,010900800,990980990,950020850,/ROW 14@3 + 100980980,020010300,400020050,010010020,020800000, /ROW 14@4 + 001, /ROW 15@1 + 050450500,010010010,000990990,990990990,990990960,990020010,/ROW 15@2 + 010020250,020010800,980500050,100020900,990990990,100020100,/ROW 15@3 + 020980980,010010020,020010000,020010250,020400000, /ROW 15@4 + 013, /ROW 16@1 + 100450450,010010010,000990300,050600900,900900990,990300050,/ROW 16@2 + 010010050,300020980,980020020,950000700,990900990,950020900,/ROW 16@3 + 050980980,010010010,300150050,020020050,020800000, /ROW 16@4 + 001, /ROW 17@1 + 300600100,050010010,000990900,000950990,900990950,900200050,/ROW 17@2 + 600010100,050200980,980020020,700010800,600990990,010150020,/ROW 17@3 + 020400950,100020100,200050020,020020100,050250000, /ROW 17@4 + 072, /ROW 18@1 + 200400400,010010010,000990800,800900990,900950950,850100020,/ROW 18@2 + 500020130,050850980,980030050,500010800,600980990,010100020,/ROW 18@3 + 020500950,100020050,100020020,050020200,100150000, /ROW 18@4 + 002, /ROW 19@4 + 200300500,450450010,000990900,800950990,990900950,980100020,/ROW 19@2 + 200020100,020050990,990050700,050050800,990990990,050050020,/ROW 19@3 + 020980980,020020100,100020020,020020100,100700000, /ROW 19@4 + 008, /ROW 20@1 + 200500300,010010010,000990500,500600950,900900200,800100100,/ROW 20@2 + 020050100,020020980,980010010,500010800,950980990,500020100,/ROW 20@3 + 400980980,200200100,100100100,050050100,100300000, /ROW 20@4 + 013, /ROW 21@1 + 700290010,010010010,000990600,500800990,950950850,980050020,/ROW 21@2 + 020020050,020020900,980010010,200020900,500980990,050100050,/ROW 21@3 + 050600100,020020100,100020020,020020050,050900000, /ROW 21@4 + 001, /ROW 22@1 + 700290010,010010010,000990700,700700200,850800950,990010010,/ROW 22@2 + 010010010,010010990,990010010,200020990,950990990,050100050,/ROW 22@3 + 050800100,010010010,010010010,010010010,010900000, /ROW 22@4 + 036, /ROW 23@1 + 100800100,010010010,000990800,700800850,990650800,980200100,/ROW 23@2 + 020050050,010010050,950010010,200100990,600990950,050150020,/ROW 23@3 + 020300850,020020020,200100020,050010050,010100000, /ROW 23@4 + 009, /ROW 24@1 + 100800100,010010010,000990800,700800850,990650800,980200100,/ROW 24@2 + 020050050,010010050,950010010,200100990,600990950,050150020,/ROW 24@3 + 020300850,020020020,200100020,050010050,010100000, /ROW 24@4 + 054, /ROW 25@1 + 100700200,010010010,000990800,700800990,990950950,990200100,/ROW 25@2 + 020020100,010050850,900800150,100100990,700990010,050050020,/ROW 25@3 + 020600960,010010050,200100020,020020100,050350000, /ROW 25@4 + 005, /ROW 26@1 + 500400100,300600010,000850850,700950990,800900980,980700020,/ROW 26@2 + 020100100,020020980,980050100,400100700,950990990,300100400,/ROW 26@3 + 100800950,020020400,400020020,100100100,100600000, /ROW 26@4 + 063, /ROW 27@1 + 900100000,200600050,100950400,300800990,950900950,980500020,/ROW 27@2 + 020030100,020020950,980010010,200100800,800980980,400200300,/ROW 27@3 + 050800950,020020300,300020020,030030100,100500000, /ROW 27@4 + 001, /ROW 28@1 + 300300300,300050100,000990900,800990990,990990950,980700020,/ROW 28@2 + 020050300,020020950,980010010,200100900,900990990,200100100,/ROW 28@3 + 100900900,020020300,300020020,050050300,300400000, /ROW 28@4 + 001, /ROW 29@1 + 600390010,010010010,800700900,500950800,990800950,980500020,/ROW 29@2 + 020100300,020020950,980010010,900020600,950990900,700050800,/ROW 29@3 + 050900950,020020300,300020020,100100300,300800000, /ROW 29@4 + 252, /ROW 30@1 + 150700150,010010010,000990800,700950990,850950950,800950050,/ROW 30@2 + 020100100,050010980,950010010,300020950,700990990,300100050,/ROW 30@3 + 050850950,200020920,050050010,010100010,100150000, /ROW 30@4 + 081, /ROW 31@1 + 300600100,300500100,000950400,300800900,800900950,990500100,/ROW 31@2 + 020050050,250010980,950010010,900020700,950950990,700050750,/ROW 31@3 + 150900950,010010300,300100020,010050010,050500000, /ROW 31@4 + 005, /ROW 32@1 + 300400300,010010050,500990800,700900990,900950980,980100100,/ROW 32@2 + 020020200,100020980,980020020,900020700,950950990,700050750,/ROW 32@3 + 150900950,020020100,100020020,020020200,200800000, /ROW 32@4 + 009, /ROW 33@1 + 400550050,500200100,000990200,100800990,700950950,900700050,/ROW 33@2 + 020100300,100020980,990010010,300100990,800700990,020900020,/ROW 33@3 + 020100900,100020300,300050050,100100300,300500000, /ROW 33@4 + 0967,"LDR",01,00,10,05,11,61,00, /CASE IDENTIFICATION + 03,10,29,34,36,43,48,50,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT + 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS OMITTED + 0967,"LDR",01,00,10,05,11,61,00, /CASE IDENTIFICATION + 03,10,29,34,36,43,48,50,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT + 11,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS OMITTED + 0967,"LDR",01,00,09,05,11,61,00, /CASE IDENTIFICATION + 03,10,29,34,36,43,48,50,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT + 0967,"LDR",00,00,10,05,11,61,00, /CASE IDENTIFICATION + 03,10,17,21,29,34,36,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT + 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS OMITTED + 0967,"LDR",00,00,10,05,11,61,00, /CASE IDENTIFICATION + 03,10,17,21,29,34,36,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT + 11,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS OMITTED + 0967,"LDR",00,00,09,05,11,61,00, /CASE IDENTIFICATION + 03,10,17,21,29,34,36,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT + 0967,"LDR",00,00,09,05,11,61,01, /CASE IDENTIFICATION + 03,10,17,21,29,34,36,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT +?END \ No newline at end of file diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.lst b/software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.lst new file mode 100644 index 0000000..8752aa4 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.lst @@ -0,0 +1,859 @@ + LABEL 000000000LINE 00189359?COMPILE MRS081/NEW ALGOL GO ALGOL /MRS081 + + + + + + BURROUGHS B-5700 ALGOL COMPILER MARK XIII.0 MONDAY, 12/25/89, 7:25 AM. + + + + + + BEGIN 0000 + START OF SEGMENT ********** 2 + COMMENT CONGENITAL HEART DISEASE DIAGNOSIS PROGRAM. 0000 + FROM A SET OF CLINICAL SYMPTOMS, THE PROBABILITIES 0000 + FOR EACH OF THE 33 CONGENITAL HEART DISEASES BEING 0000 + PRESENT IN THE PATIENT UNDER CONSIDERATION IS 0000 + CALCULATED AND THOSE GREATER THAN ONE PERCENT 0000 + ARE PRINTED OUT TOGETHER WITH DISEASE IDENTIFICATION 0000 + AND CASE INFORMATION. 0000 + 0000 + FRED B FIELDING 0000 + SAN FRANCISCO DISTRICT OFFICE 0000 + 0000 + CARD SEQUENCE CODE FOR THE PROGRAM STARTS WITH 0000 + CHDD0001 AND ROW 01-1 FOR SYMPTOM-DISEASE MATRIX. 0000 + FIRST RELEASE 05 - 31 - 61; 0000 + 0000 + 0000 + INTEGER CASENO, CASEIN, SHEET, XRAY, EQUATION, 0000 + MO, DAY, YEAR, LAST, 0000 + E, J, K, P, X, 0000 + TOTE, TOTP, TOTX, OUTSHEET, 0000 + T22, T2021, T4243, T4445, T6789; 0000 + 0000 + REAL SUM; 0000 + 0000 + INTEGER ARRAY SYE[1:20], SYP[1:20], TE[1:50], TP[1:50], 0000 + ROW[1:51], MX[1:10], M[1:33,1:18]; 0007 + 0012 + REAL ARRAY FTROW[1:50], FTMX[1:10], PYKX[1:33], PYX[1:33]; 0012 + 0019 + LABEL NEWCASE, CARD1, CARD2, EQTEST, XP9, TAL9, EQ10, 0019 + CARD3, XP10, X1TO3, X4TO7, X26, LAB5, BNORWH, BROWN, 0019 + X17TO19, X20, WHITE, X40, X2369, FLTMX, TAL10, 0019 + NORM, PRINT, TALPT, EOF, 0019 + Y01, Y02, Y03, Y04, Y05, Y06, Y07, Y08, Y09, Y10, 0019 + Y11, Y12, Y13, Y14, Y15, Y16, Y17, Y18, Y19, Y20, 0019 + Y21, Y22, Y23, Y24, Y25, Y26, Y27, Y28, Y29, Y30, 0019 + Y31, Y32, Y33; 0019 + 0019 + SWITCH SWOUT:= Y01,Y02,Y03,Y04,Y05,Y06,Y07,Y08,Y09, 0019 + Y10,Y11,Y12,Y13,Y14,Y15,Y16,Y17,Y18,Y19,Y20,Y21, 0022 + Y22,Y23,Y24,Y25,Y26,Y27,Y28,Y29,Y30,Y31,Y32,Y33; 0022 + 0039 + FILE IN CARD(1, 10); 0039 + FILE OUT LINE 17(1,17); 0043 + 0047 + LIST MATRIX(FOR K:= 1 STEP 1 UNTIL 33 DO 0047 + FOR J:= 1 STEP 1 UNTIL 18 DO M[K,J]), 0050 + KASE(CASENO, CASEIN, SHEET, XRAY, EQUATION, 0061 + MO, DAY, YEAR, LAST), 0068 + IDOUT(CASENO, CASEIN, MO, DAY, YEAR), 0076 + PRESENT(FOR P:= 1 STEP 1 UNTIL 20 DO SYP[P]), 0086 + POUT(FOR P:= 1 STEP 1 UNTIL TOTP DO SYP[P]), 0096 + EXCLUDE(FOR E:= 1 STEP 1 UNTIL 20 DO SYE[E]), 0106 + EOUT(FOR E:= 1 STEP 1 UNTIL TOTE+1 DO SYE[E]), 0116 + SHOUT(OUTSHEET), 0127 + EQOUT(EQUATION), 0132 + ANS(FOR X:= K DO PYX[X]); 0137 + 0146 + FORMAT OUT IDFORM(X5,"CASE NUMBER",I7,X5,"PATIENT",X2,A3,X5, 0146 + START OF SEGMENT ********** 3 + "DATE",X1,3(I3)), 0146 + PFORM(/,X5,"SYMPTOMS PRESENT",X4,20(I4)), 0146 + EFORM(/,X5,"SYMPTOMS OMITTED",X4,20(I4)), 0146 + SHFORM(/,X5,"SYMPTOMS USED",X3,A2), 0146 + EQFORM(X5,"EQUATION USED",I5), 0146 + HEAD(X15,"DISEASE",X5,"PROBABILITY"), 0146 + 0146 + FORM1(X8,"Y01",X7,"N",F16.4), 0146 + FORM2(X8,"Y02",X5,"A S D",F14.4), 0146 + FORM3(X8,"Y03",X2,"A S D - P S",F11.4), 0146 + FORM4(X8,"Y04",X2,"A S D - P H",F11.4), 0146 + FORM5(X8,"Y05",X4,"C E C D",F13.4), 0146 + FORM6(X8,"Y06",X3,"P A P V C",F12.4), 0146 + FORM7(X8,"Y07",X3,"T A P V C",F12.4), 0146 + FORM8(X8,"Y08",X6,"T A",F15.4), 0146 + FORM9(X8,"Y09",X5,"EBST.",F14.4), 0146 + FORM10(X8,"Y10",X1,"V S D - V P S",F10.4), 0146 + FORM11(X8,"Y11",X1,"V S D - I P S",F10.4), 0146 + FORM12(X8,"Y12",X5,"V P S",F14.4), 0146 + FORM13(X8,"Y13",X5,"I P S",F14.4), 0146 + FORM14(X8,"Y14",X3,"P. ATRES.",F12.4), 0146 + FORM15(X8,"Y15",X2,"COARCT. P A",F11.4), 0146 + FORM16(X8,"Y16",X6,"P H",F15.4), 0146 + FORM17(X8,"Y17",X5,"A P W",F14.4), 0146 + FORM18(X8,"Y18",X5,"P D A",F14.4), 0146 + FORM19(X8,"Y19",X2,"P A-V FIST.",F11.4), 0146 + FORM20(X8,"Y20",X6,"M S",F15.4), 0146 + FORM21(X8,"Y21",X4,"MYOC. D",F13.4), 0146 + FORM22(X8,"Y22",X2,"A O COR. A",F12.4), 0146 + 3 IS 259 LONG, NEXT SEG 2 + START OF SEGMENT ********** 4 + FORM23(X8,"Y23",X2,"A S - VALV.",F11.4), 0146 + FORM24(X8,"Y24",X2,"A S - SUB.",F12.4), 0146 + FORM25(X8,"Y25",X3,"COARCT. A",F12.4), 0146 + FORM26(X8,"Y26",X4,"TRUNC.",F14.4), 0146 + FORM27(X8,"Y27",X3,"TRANSP.",F14.4), 0146 + FORM28(X8,"Y28",X3,"C TRANSP.",F12.4), 0146 + FORM29(X8,"Y29",X4,"AB. A O",F13.4), 0146 + FORM30(X8,"Y30",X5,"V S D",F14.4), 0146 + FORM31(X8,"Y31",X2,"V S D - P H",F11.4), 0146 + FORM32(X8,"Y32",X2,"P D A - P H",F11.4), 0146 + FORM33(X8,"Y33",X1,"T A - TRANSP.",F10.4); 0146 + 4 IS 98 LONG, NEXT SEG 2 + 0146 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 0146 + PROCEDURE UNPACK(M, SHEET, XRAY, EQUATION, ROW); 0146 + VALUE SHEET, XRAY, EQUATION; 0146 + INTEGER SHEET, XRAY, EQUATION; 0146 + INTEGER ARRAY M[1], ROW[1]; 0146 + BEGIN 0146 + INTEGER 0146 + START OF SEGMENT ********** 5 + ROWX; 0000 + 0000 + PROCEDURE UPACK(M, MX, ROW, ROWX, COUNT); 0000 + VALUE MX, ROWX, COUNT; 0000 + INTEGER MX, ROWX, COUNT; 0000 + INTEGER ARRAY M[1], ROW[1]; 0000 + BEGIN 0000 + DO BEGIN 0000 + ROW[ROWX]:= (M[MX] DIV 1000000) MOD 1000; 0000 + ROW[ROWX+1]:= (M[MX] DIV 1000) MOD 1000; 0003 + ROW[ROWX+2]:= M[MX] MOD 1000; 0007 + ROWX:= ROWX+3; 0011 + MX:= MX+1; 0012 + COUNT:= COUNT-1; 0013 + END 0014 + UNTIL COUNT < 0; % MODELS 220 DFL/BRP INSTRUCTION 0014 + END UPACK; 0016 + 0018 + ROWX:= 1; 0018 + IF EQUATION ! 10 THEN 0018 + UPACK(M, 2, ROW, ROWX, 16) 0019 + ELSE 0022 + BEGIN 0022 + UPACK(M, 2, ROW, ROWX, 4); 0023 + ROWX:= ROWX+21; % ROWX=22 0026 + UPACK(M, 9, ROW, ROWX, 5); 0027 + ROWX:= ROWX+27; % ROWX=49 0030 + UPACK(M, 18, ROW, ROWX, 0); 0031 + IF SHEET ! 1 THEN 0034 + BEGIN 0034 + UPACK(M, 7, ROW, ROWX-33, 1); % ROWX=16 0035 + ROW[ROWX]:= 0; 0038 + END 0040 + ELSE 0040 + BEGIN 0040 + ROW[19]:= (M[8] DIV 1000000) MOD 1000; 0040 + ROWX:= ROWX-9; % ROWX=40 0044 + UPACK(M, 15, ROW, ROWX, 2); 0045 + END; 0048 + END; 0048 + END UNPACK; 0048 + 5 IS 52 LONG, NEXT SEG 2 + 0146 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 0146 + 0146 + COMMENT READ DATA FOR SYMPTOM-DISEASE MATRIX.; 0146 + READ(CARD, /, MATRIX); 0146 + 0150 + COMMENT THE PROGRAM BEGINS HERE. THE FIRST TWO INPUT CARDS 0150 + ARE READ, THE FIRST TWO LINES OF OUTPUT ARE PRINTED, 0150 + THE NUMBER OF SYMPTOMS ARE CALCULATED, 0150 + AND THE EQUATION TYPE DETERMINED.; 0150 + 0150 + NEWCASE: FOR P:= 1 STEP 1 UNTIL 20 DO 0150 + SYP[P]:= 0; 0151 + FOR J:= 1 STEP 1 UNTIL 50 DO 0155 + TP[J]:= ROW[J]:= 0; 0156 + FOR J:= 1 STEP 1 UNTIL 50 DO 0161 + FTROW[J]:= 0.0; 0163 + 0167 + CARD1: READ(CARD, /, KASE) [EOF]; 0167 + WRITE(LINE[PAGE]); 0171 + WRITE(LINE, IDFORM, IDOUT); 0175 + CARD2: READ(CARD, /, PRESENT); 0178 + P:= 1; 0182 + FOR J:= 1 STEP 1 UNTIL 50 DO 0183 + BEGIN 0184 + IF SYP[P] = J THEN 0184 + BEGIN 0185 + TP[J]:= 1; 0186 + P:= P+1 0187 + END; 0188 + END; 0189 + 0191 + TOTP:= P - 1; 0191 + WRITE(LINE, PFORM, POUT); 0192 + K:= 1; 0195 + IF SHEET = 1 THEN 0196 + BEGIN 0197 + OUTSHEET:= "W "; 0197 + GO TO EQTEST 0198 + END; 0199 + OUTSHEET:= "B "; 0200 + 0200 + EQTEST: IF EQUATION = 10 THEN 0200 + GO TO EQ10; 0201 + 0202 + COMMENT CALCULATE PROBABILITIES USING EQUATION 9.; 0202 + 0202 + COMMENT ONE ROW OF THE MATRIX IS UNPACKED AND THE 0202 + INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED.; 0202 + 0202 + XP9: UNPACK(M[K,*], SHEET, XRAY, EQUATION, ROW[*]); 0202 + FOR J:= 8 STEP 1 UNTIL 16, 24, 25, 0206 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 0215 + BEGIN 0226 + IF TP[J] = 1 THEN 0226 + ROW[J]:= 1000 - ROW[J] 0227 + END; 0230 + 0233 + COMMENT THE ROW-PRODUCT IS CALCULATED AND ZEROES TESTED FOR.; 0233 + PYKX[K]:= M[K,1]; 0233 + FOR P:= 1 STEP 1 UNTIL TOTP DO 0236 + BEGIN 0238 + IF ROW[SYP[P]] = 0 THEN 0238 + BEGIN 0240 + PYKX[K]:= 0.0; 0240 + GO TO TAL9 0242 + END; 0243 + FTROW[P]:= ROW[SYP[P]] 0243 + END; 0245 + 0248 + FOR P:= 1 STEP 1 UNTIL TOTP DO 0248 + PYKX[K]:= PYKX[K]|FTROW[P]; 0250 + 0256 + TAL9: K:= K+1; 0256 + IF K { 33 THEN 0257 + GO TO XP9; 0258 + GO TO NORM; 0258 + 0259 + 0259 + COMMENT CALCULATE PROBABILITIES USING EQUATION 10.; 0259 + 0259 + EQ10: FOR J:= 1 STEP 1 UNTIL 50 DO 0259 + TE[J]:= 0; 0260 + FOR E:= 1 STEP 1 UNTIL 20 DO 0264 + SYE[E]:= 0; 0265 + FOR X:= 1 STEP 1 UNTIL 10 DO 0269 + MX[X]:= 0; 0270 + FOR X:= 1 STEP 1 UNTIL 10 DO 0274 + FTMX[X]:= 0.0; 0275 + 0279 + COMMENT THE THIRD INPUT CARD IS READ, THE THIRD LINE OF 0279 + OUTPUT IS PRINTED, AND THE NUMBER OF SYMPTOMS 0279 + TO BE OMITTED FOR THIS CASE IS CALCULATED.; 0279 + 0279 + CARD3: READ(CARD, /, EXCLUDE); 0279 + E:= 1; 0282 + FOR J:= 1 STEP 1 UNTIL 50 DO 0283 + BEGIN 0284 + IF SYE[E] = J THEN 0284 + BEGIN 0285 + TE[J]:= 1; 0286 + E:= E+1 0287 + END; 0288 + END; 0289 + 0291 + TOTE:= E-1; 0291 + WRITE(LINE, EFORM, EOUT); 0292 + TOTX:= SHEET+8; 0295 + 0297 + COMMENT ONE ROW OF THE MATRIX IS UNPACKED, THE 0297 + INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED, 0297 + AND THE SYMPTOMS OMITTED FOR THIS CASE DELETED.; 0297 + 0297 + XP10: UNPACK(M[K,*], SHEET, XRAY, EQUATION, ROW[*]); 0297 + FOR J:= 8 STEP 1 UNTIL 15, 24, 25, 0300 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 0309 + BEGIN 0320 + IF TP[J] = 1 THEN 0320 + ROW[J]:= 1000 - ROW[J]; 0321 + IF ROW[J] = 0 THEN 0325 + BEGIN 0326 + PYKX[K]:= 0.0; 0327 + GO TO TAL10 0329 + END; 0329 + IF TE[J] = 1 THEN 0329 + ROW[J]:= 0 0331 + END; 0332 + 0333 + COMMENT THE ROW-PRODUCT IS CALCULATED FOR THOSE INDEPENDENT 0333 + SYMPTOMS COMMON TO BOTH SHEETS, ZERO VALUES TESTED 0333 + FOR, AND EACH ELEMENT SCALED.; 0333 + 0333 + PYKX[K]:= M[K,1]; 0333 + FOR J:= 8 STEP 1 UNTIL 15, 24, 25, 0337 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 0346 + BEGIN 0357 + FTROW[J]:= ROW[J]; 0357 + FTROW[J]:= FTROW[J]/100.0; 0359 + IF FTROW[J] ! 0.0 THEN 0362 + PYKX[K]:= PYKX[K]|FTROW[J] 0364 + END; 0367 + 0370 + 0370 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 0370 + EXCLUSIVE SYMPTOM-SETS COMMON TO BOTH BROWN AND 0370 + WHITE SYMPTOM CHECK SHEETS PER TABLE V.; 0370 + 0370 + X1TO3: MX[1]:= ROW[SYP[1]]; 0370 + X4TO7: IF TE[4] = 1 THEN 0373 + BEGIN 0375 + MX[2]:= 100; 0376 + GO TO X26 0377 + END; 0378 + IF SYP[2] { 7 THEN 0378 + BEGIN 0379 + MX[2]:= ROW[SYP[2]]; 0380 + GO TO X26 0383 + END; 0384 + MX[2]:= 1000 - ROW[4] - ROW[5] - ROW[6] - ROW[7]; 0384 + 0390 + X26: X:= 3; 0390 + FOR J:= 26, 28, 34, 36 DO 0391 + BEGIN 0401 + IF TE[J] = 1 THEN 0401 + BEGIN 0402 + MX[X]:= 100; 0403 + GO TO LAB5 0405 + END; 0405 + IF TP[J] = TP[J+1] THEN 0405 + BEGIN 0408 + MX[X]:= 1000 - ROW[J] - ROW[J+1]; 0408 + GO TO LAB5 0413 + END; 0414 + IF TP[J] = 1 THEN 0414 + BEGIN 0415 + MX[X]:= ROW[J]; 0416 + GO TO LAB5 0418 + END; 0419 + MX[X]:= ROW[J+1]; 0419 + LAB5: X:= X+1 0422 + END; 0422 + 0423 + BNORWH: IF SHEET = 1 THEN 0423 + GO TO WHITE; 0424 + 0425 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 0425 + EXCLUSIVE SYMPTOM-SETS FOR THE BROWN SHEET OPTION.; 0425 + 0425 + BROWN: IF TP[16] = 1 THEN 0425 + ROW[16]:= 1000 - ROW[16]; 0427 + IF ROW[16] = 0 THEN 0431 + BEGIN 0432 + PYKX[K]:= 0.0; 0433 + GO TO TAL10 0434 + END; 0435 + IF TE[16] = 1 THEN 0435 + BEGIN 0436 + ROW[16]:= 0; 0437 + GO TO X17TO19 0439 + END; 0439 + 0439 + BEGIN 0439 + FTROW[16]:= ROW[16]; 0439 + PYKX[K]:= PYKX[K]|FTROW[16] / 100.0 0442 + END; 0445 + 0446 + X17TO19: IF TE[17] = 1 THEN 0446 + BEGIN 0448 + MX[7]:= 100; 0449 + GO TO X20 0450 + END; 0451 + IF TP[17] = TP[18] AND TP[18] = TP[19] THEN 0453 + BEGIN 0457 + MX[7]:= (1000-ROW[17])|(1000-ROW[18])| 0458 + (1000-ROW[19]); 0462 + GO TO X20 0464 + END; 0465 + IF TP[19] = 1 THEN 0465 + BEGIN 0466 + MX[7]:= ROW[19]; 0467 + GO TO X20 0469 + END; 0470 + IF TP[17] = 0 THEN 0470 + BEGIN 0471 + MX[7]:= ROW[18]|(1000 - ROW[17]); 0472 + GO TO X20 0476 + END; 0477 + IF TP[18] = 0 THEN 0477 + BEGIN 0478 + MX[7]:= ROW[17]|(1000 - ROW[18]); 0479 + GO TO X20 0483 + END; 0483 + MX[7]:= ROW[17]|ROW[18]; 0483 + 0487 + X20: IF TE[20] = 1 THEN 0487 + BEGIN 0489 + MX[8]:= 100; 0490 + GO TO FLTMX 0491 + END; 0492 + 0492 + T2021:= (1000 - ROW[20] - ROW[21]); 0492 + T22:= (1000 - ROW[22]); 0495 + 0497 + IF (TP[20] = TP[21]) AND (TP[21] = TP[22]) 0497 + AND (TP[22] = TP[23]) THEN 0501 + BEGIN 0504 + MX[8]:= T2021|T22|(1000 - ROW[23]); 0505 + GO TO FLTMX 0509 + END; 0509 + IF TP[20] = 1 THEN 0509 + BEGIN 0511 + IF TP[22] = 1 THEN 0511 + BEGIN 0513 + MX[8]:= ROW[20]|ROW[22]; 0513 + GO TO FLTMX 0517 + END; 0518 + MX[8]:= ROW[20]|T22; 0518 + GO TO FLTMX 0521 + END; 0521 + 0521 + IF TP[21] = 1 THEN 0521 + BEGIN 0523 + IF TP[22] = 1 THEN 0523 + BEGIN 0525 + MX[8]:= ROW[21]|ROW[22]; 0525 + GO TO FLTMX 0529 + END; 0529 + MX[8]:= ROW[21]|T22; 0529 + GO TO FLTMX 0532 + END; 0533 + IF TP[22] = 1 THEN 0533 + BEGIN 0534 + MX[8]:= ROW[22]|T2021; 0535 + GO TO FLTMX 0538 + END; 0538 + MX[8]:= ROW[23]; 0538 + GO TO FLTMX; 0541 + 0541 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 0541 + EXCLUSIVE SYMPTOM-SETS FOR THE WHITE SHEET OPTION.; 0541 + 0541 + WHITE: IF (TE[19] = TE[42])AND (TE[42] = TE[44]) 0541 + AND (TE[44] = 1)THEN 0546 + BEGIN 0548 + MX[7]:= 100; 0549 + GO TO X40 0550 + END; 0551 + 0551 + T4243:= (1000 - ROW[42] - ROW[43]); 0551 + T4445:= (1000 - ROW[44] - ROW[45]); 0554 + 0557 + IF (TP[19] = TP[42]) AND (TP[42] = TP[43]) 0557 + AND (TP[43] = TP[44]) AND (TP[44] = TP[45]) THEN 0561 + BEGIN 0567 + MX[7]:= (1000 - ROW[19])|T4243|T4445; 0568 + GO TO X40 0572 + END; 0572 + IF TP[19] = 1 THEN 0572 + BEGIN 0574 + MX[7]:= ROW[19]; 0574 + GO TO X40 0577 + END; 0577 + IF TP[42] = 1 THEN 0577 + BEGIN 0579 + IF TP[44] = 1 THEN 0579 + BEGIN 0581 + MX[7]:= ROW[42]|ROW[44]; 0581 + GO TO X40 0585 + END; 0585 + IF TP[45] = 1 THEN 0585 + BEGIN 0587 + MX[7]:= ROW[42]|ROW[45]; 0587 + GO TO X40 0591 + END; 0592 + MX[7]:= ROW[42]|T4445; 0592 + GO TO X40 0595 + END; 0595 + 0595 + IF TP[43] = 1 THEN 0595 + BEGIN 0597 + IF TP[44] = 1 THEN 0597 + BEGIN 0599 + MX[7]:= ROW[43]|ROW[44]; 0599 + GO TO X40 0603 + END; 0603 + IF TP[45] = 1 THEN 0603 + BEGIN 0605 + MX[7]:= ROW[43]|ROW[45]; 0605 + GO TO X40 0609 + END; 0610 + MX[7]:= ROW[43]|T4445; 0610 + GO TO X40 0613 + END; 0613 + 0613 + IF TP[44] = 1 THEN 0613 + BEGIN 0615 + MX[7]:= ROW[44]|T4243; 0615 + GO TO X40 0618 + END; 0619 + MX[7]:= ROW[45]|T4243; 0619 + 0622 + X40: IF TE[40] = 1 THEN 0622 + BEGIN 0623 + MX[8]:= 100; 0624 + GO TO X2369 0625 + END; 0626 + 0626 + IF TP[40] = TP[41] THEN 0626 + BEGIN 0628 + MX[8]:= 1000 - ROW[40] - ROW[41]; 0629 + GO TO X2369 0633 + END; 0633 + 0633 + IF TP[40] = 1 THEN 0633 + BEGIN 0635 + MX[8]:= ROW[40]; 0635 + GO TO X2369 0638 + END; 0638 + MX[8]:= ROW[41]; 0638 + 0641 + X2369: IF (TE[22] = TE[46]) AND (TE[46] = 1) THEN 0641 + BEGIN 0646 + MX[9]:= 100; 0646 + GO TO FLTMX 0648 + END; 0648 + 0648 + T22:= 1000 - ROW[22]; 0648 + T6789:= 1000 - ROW[46] - ROW[47] - ROW[48] - ROW[49]; 0650 + 0655 + IF (TP[22] = TP[23]) AND (TP[23] = TP[46]) 0656 + AND (TP[46] = TP[47]) AND (TP[47] = TP[48]) 0660 + AND (TP[48] = TP[49]) THEN 0665 + BEGIN 0668 + MX[9]:= T22|(1000 - ROW[23])|T6789; 0669 + GO TO FLTMX 0673 + END; 0673 + 0673 + IF TP[22] = 1 THEN 0673 + BEGIN 0675 + FOR J:= 46 STEP 1 UNTIL 49 DO 0675 + BEGIN 0677 + IF TP[J] = 1 THEN 0677 + BEGIN 0678 + MX[9]:= ROW[J]|ROW[22]; 0679 + GO TO FLTMX 0682 + END; 0683 + END; 0683 + MX[9]:= ROW[22]|T6789; 0685 + GO TO FLTMX 0688 + END; 0689 + 0689 + FOR J:= 46 STEP 1 UNTIL 49 DO 0689 + BEGIN 0690 + IF TP[J] = 1 THEN 0690 + BEGIN 0691 + MX[9]:= ROW[J]|T22; 0692 + GO TO FLTMX 0695 + END; 0695 + END; 0695 + 0697 + MX[9]:= ROW[23]; 0697 + GO TO FLTMX; 0700 + 0700 + FLTMX: FOR X:= 1 STEP 1 UNTIL TOTX DO 0700 + BEGIN 0702 + FTMX[X]:= MX[X]; 0702 + FTMX[X]:= FTMX[X]/100.00 0704 + END; 0706 + 0709 + FOR X:= 1 STEP 1 UNTIL TOTX DO 0709 + PYKX[K]:= PYKX[K]|FTMX[X]; 0712 + 0718 + COMMENT AT THIS POINT, THE ROW-PRODUCT HAS BEEN COMPUTED 0718 + AND A TEST IS MADE TO DETERMINE WHETHER THERE 0718 + ARE MORE ROWS YET TO BE PROCESSED, OR TO PRINT-OUT.; 0718 + 0718 + TAL10: K:= K+1; 0718 + IF K { 33 THEN 0719 + GO TO XP10; 0720 + GO TO NORM; 0720 + 0721 + COMMENT THE ROW-PROBABILITIES ARE FIRST NORMALIZED TO GIVE A 0721 + TRUE PERCENTAGE FIGURE AND LINES 4 - 6 ARE PRINTED.; 0721 + 0721 + NORM: SUM:= 0.0; 0721 + WRITE(LINE, SHFORM, SHOUT); 0721 + FOR K:= 1 STEP 1 UNTIL 33 DO 0725 + SUM:= SUM + PYKX[K]; 0726 + WRITE(LINE, EQFORM, EQOUT); 0730 + FOR K:= 1 STEP 1 UNTIL 33 DO 0733 + PYX[K]:= PYKX[K] / SUM; 0735 + 0740 + WRITE(LINE, HEAD); 0740 + 0743 + COMMENT THE PROBABILITIES ARE NOW PRINTED WHICH ARE ONE 0743 + PERCENT OR GREATER TOGETHER WITH DISEASE I. D. .; 0743 + 0743 + K:= 1; 0743 + PRINT: IF PYX[K] < 0.01 THEN 0744 + GO TO TALPT; 0745 + 0746 + GO TO SWOUT[K]; 0746 + Y01: WRITE(LINE, FORM1, ANS); 0748 + GO TO TALPT; 0751 + Y02: WRITE(LINE, FORM2, ANS); 0753 + GO TO TALPT; 0756 + Y03: WRITE(LINE, FORM3, ANS); 0756 + GO TO TALPT; 0760 + Y04: WRITE(LINE, FORM4, ANS); 0760 + GO TO TALPT; 0764 + Y05: WRITE(LINE, FORM5, ANS); 0764 + GO TO TALPT; 0768 + Y06: WRITE(LINE, FORM6, ANS); 0768 + GO TO TALPT; 0772 + Y07: WRITE(LINE, FORM7, ANS); 0772 + GO TO TALPT; 0776 + Y08: WRITE(LINE, FORM8, ANS); 0776 + GO TO TALPT; 0780 + Y09: WRITE(LINE, FORM9, ANS); 0780 + GO TO TALPT; 0784 + Y10: WRITE(LINE, FORM10, ANS); 0784 + GO TO TALPT; 0788 + Y11: WRITE(LINE, FORM11, ANS); 0788 + GO TO TALPT; 0792 + Y12: WRITE(LINE, FORM12, ANS); 0792 + GO TO TALPT; 0796 + Y13: WRITE(LINE, FORM13, ANS); 0796 + GO TO TALPT; 0800 + Y14: WRITE(LINE, FORM14, ANS); 0800 + GO TO TALPT; 0804 + Y15: WRITE(LINE, FORM15, ANS); 0804 + GO TO TALPT; 0808 + Y16: WRITE(LINE, FORM16, ANS); 0808 + GO TO TALPT; 0812 + Y17: WRITE(LINE, FORM17, ANS); 0812 + GO TO TALPT; 0816 + Y18: WRITE(LINE, FORM18, ANS); 0816 + GO TO TALPT; 0820 + Y19: WRITE(LINE, FORM19, ANS); 0820 + GO TO TALPT; 0824 + Y20: WRITE(LINE, FORM20, ANS); 0824 + GO TO TALPT; 0828 + Y21: WRITE(LINE, FORM21, ANS); 0828 + GO TO TALPT; 0832 + Y22: WRITE(LINE, FORM22, ANS); 0832 + GO TO TALPT; 0836 + Y23: WRITE(LINE, FORM23, ANS); 0836 + GO TO TALPT; 0840 + Y24: WRITE(LINE, FORM24, ANS); 0840 + GO TO TALPT; 0844 + Y25: WRITE(LINE, FORM25, ANS); 0844 + GO TO TALPT; 0848 + Y26: WRITE(LINE, FORM26, ANS); 0848 + GO TO TALPT; 0852 + Y27: WRITE(LINE, FORM27, ANS); 0852 + GO TO TALPT; 0856 + Y28: WRITE(LINE, FORM28, ANS); 0856 + GO TO TALPT; 0860 + Y29: WRITE(LINE, FORM29, ANS); 0860 + GO TO TALPT; 0864 + Y30: WRITE(LINE, FORM30, ANS); 0864 + GO TO TALPT; 0868 + Y31: WRITE(LINE, FORM31, ANS); 0868 + GO TO TALPT; 0872 + Y32: WRITE(LINE, FORM32, ANS); 0872 + GO TO TALPT; 0876 + Y33: WRITE(LINE, FORM33, ANS); 0876 + GO TO TALPT; 0880 + 0880 + TALPT: K:= K+1; 0880 + IF K { 33 THEN 0882 + GO TO PRINT; 0883 + 0883 + COMMENT PROGRAM REPEATS TO BEGINNING IF THERE ARE MORE 0883 + CASES TO BE RUN, AND HALTS IF NOT. THE INITIALS 0883 + H W APPEAR IN THE A-REG. UPON COMPLETION.; 0883 + 0883 + IF LAST = 0 THEN 0883 + GO TO NEWCASE; 0884 + COMMENT STOP 7270061216; 0884 + COMMENT GO TO NEWCASE; 0884 + EOF: 0884 + END. 0885 + 2 IS 888 LONG, NEXT SEG 1 +PRT(114) = OUTPUT(W) INTRINSIC, SEGMENT NUMBER = 6. +PRT(5) = BLOCK CONTROL INTRINSIC, SEGMENT NUMBER = 7. +PRT(111) = INPUT(W) INTRINSIC, SEGMENT NUMBER = 8. +PRT(113) = GO TO SOLVER INTRINSIC, SEGMENT NUMBER = 9. +PRT(14) = ALGOL WRITE INTRINSIC, SEGMENT NUMBER = 10. +PRT(15) = ALGOL READ INTRINSIC, SEGMENT NUMBER = 11. +PRT(16) = ALGOL SELECT INTRINSIC, SEGMENT NUMBER = 12. + 1 IS 2 LONG, NEXT SEG 0 + 13 IS 69 LONG, NEXT SEG 0 +NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 42 SECONDS. + +PRT SIZE = 81; TOTAL SEGMENT SIZE = 1368 WORDS; DISK SIZE = 55 SEGS; NO. PGM. SEGS = 13 + +ESTIMATED CORE STORAGE REQUIRED = 6726 WORDS. + +ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. + + + + + + + LABEL 000000000LINE 00189359?COMPILE MRS081/NEW ALGOL GO ALGOL /MRS081 + + + + + + + + + + + + LABEL 000000000LINE 00189359?COMPILE MRS081/NEW ALGOL GO MRS081 /NEW + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS OMITTED 0 + + SYMPTOMS USED W + EQUATION USED 10 + DISEASE PROBABILITY + Y10 V S D - V P S 0.0286 + Y11 V S D - I P S 0.0201 + Y12 V P S 0.7295 + Y13 I P S 0.2151 + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS OMITTED 11 0 + + SYMPTOMS USED W + EQUATION USED 10 + DISEASE PROBABILITY + Y10 V S D - V P S 0.0297 + Y11 V S D - I P S 0.0209 + Y12 V P S 0.7278 + Y13 I P S 0.2146 + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS USED W + EQUATION USED 9 + DISEASE PROBABILITY + Y02 A S D 0.0172 + Y10 V S D - V P S 0.1981 + Y11 V S D - I P S 0.2311 + Y12 V P S 0.4239 + Y13 I P S 0.1224 + + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS OMITTED 0 + + SYMPTOMS USED B + EQUATION USED 10 + DISEASE PROBABILITY + Y02 A S D 0.0158 + Y10 V S D - V P S 0.0595 + Y11 V S D - I P S 0.0418 + Y12 V P S 0.6692 + Y13 I P S 0.1933 + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS OMITTED 11 0 + + SYMPTOMS USED B + EQUATION USED 10 + DISEASE PROBABILITY + Y02 A S D 0.0164 + Y10 V S D - V P S 0.0616 + Y11 V S D - I P S 0.0433 + Y12 V P S 0.6651 + Y13 I P S 0.1921 + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS USED B + EQUATION USED 9 + DISEASE PROBABILITY + Y02 A S D 0.0113 + Y10 V S D - V P S 0.3478 + Y11 V S D - I P S 0.4058 + Y12 V P S 0.1675 + Y13 I P S 0.0484 + + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS USED B + EQUATION USED 9 + DISEASE PROBABILITY + Y02 A S D 0.0113 + Y10 V S D - V P S 0.3478 + Y11 V S D - I P S 0.4058 + Y12 V P S 0.1675 + Y13 I P S 0.0484 + + + + + + + LABEL 000000000LINE 00189359?COMPILE MRS081/NEW ALGOL GO MRS081 /NEW diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-DATA.card b/software/BALGOL/BALGOL-Examples/MRS-081/CASE-DATA.card similarity index 100% rename from software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-DATA.card rename to software/BALGOL/BALGOL-Examples/MRS-081/CASE-DATA.card diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.lst b/software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.lst new file mode 100644 index 0000000..c884c70 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.lst @@ -0,0 +1,786 @@ +Unisys ClearPath Software Series ALGOL COMPILER, MCP 18.0 [59.180.000] (59.180.0086). Wednesday, December 25, 2019 14:04:51 + + + + ( P A U L ) M R S 0 8 1 / N E W O N O P S + = = = = = = = = = = = = = = = = = = = = = = = + + + BEGIN 0000:00000:0 + BLOCK#1 IS SEGMENT 0003 + COMMENT CONGENITAL HEART DISEASE DIAGNOSIS PROGRAM. 1 0003:00001:0 + FROM A SET OF CLINICAL SYMPTOMS, THE PROBABILITIES 0003:00001:0 + FOR EACH OF THE 33 CONGENITAL HEART DISEASES BEING 0003:00001:0 + PRESENT IN THE PATIENT UNDER CONSIDERATION IS 0003:00001:0 + CALCULATED AND THOSE GREATER THAN ONE PERCENT 0003:00001:0 + ARE PRINTED OUT TOGETHER WITH DISEASE IDENTIFICATION 0003:00001:0 + AND CASE INFORMATION. 0003:00001:0 + 0003:00001:0 + FRED B FIELDING 0003:00001:0 + SAN FRANCISCO DISTRICT OFFICE 0003:00001:0 + 0003:00001:0 + CARD SEQUENCE CODE FOR THE PROGRAM STARTS WITH 0003:00001:0 + CHDD0001 AND ROW 01-1 FOR SYMPTOM-DISEASE MATRIX. 0003:00001:0 + FIRST RELEASE 05 - 31 - 61; 0003:00001:0 + 0003:00001:0 + 0003:00001:0 + INTEGER CASENO, CASEIN, SHEET, XRAY, EQUATION, 0003:00001:0 + MO, DAY, YEAR, LAST, 0003:00001:0 + E, J, K, P, X, 0003:00001:0 + TOTE, TOTP, TOTX, OUTSHEET, 0003:00001:0 + T22, T2021, T4243, T4445, T6789; 0003:00001:0 + 0003:00001:0 + REAL SUM; 0003:00001:0 + 0003:00001:0 + INTEGER ARRAY SYE[1:20], SYP[1:20], TE[1:50], TP[1:50], 0003:00001:0 + ROW[1:51], MX[1:10], M[1:33,1:18]; 0003:00001:0 + 0003:00006:4 + REAL ARRAY FTROW[1:50], FTMX[1:10], PYKX[1:33], PYX[1:33]; 0003:00006:4 + 0003:00006:4 + LABEL NEWCASE, CARD1, CARD2, EQTEST, XP9, TAL9, EQ10, 0003:00006:4 + CARD3, XP10, X1TO3, X4TO7, X26, LAB5, BNORWH, BROWN, 0003:00006:4 + X17TO19, X20, WHITE, X40, X2369, FLTMX, TAL10, 0003:00006:4 + NORM, PRINT, TALPT, EOF, 0003:00006:4 + Y01, Y02, Y03, Y04, Y05, Y06, Y07, Y08, Y09, Y10, 0003:00006:4 + Y11, Y12, Y13, Y14, Y15, Y16, Y17, Y18, Y19, Y20, 0003:00006:4 + Y21, Y22, Y23, Y24, Y25, Y26, Y27, Y28, Y29, Y30, 0003:00006:4 + Y31, Y32, Y33; 0003:00006:4 + 0003:00006:4 + SWITCH SWOUT:= Y01,Y02,Y03,Y04,Y05,Y06,Y07,Y08,Y09, 0003:00006:4 + Y10,Y11,Y12,Y13,Y14,Y15,Y16,Y17,Y18,Y19,Y20,Y21, 0003:00006:4 + Y22,Y23,Y24,Y25,Y26,Y27,Y28,Y29,Y30,Y31,Y32,Y33; 0003:00006:4 + 0003:00006:4 + FILE CARD(KIND=READER, MAXRECSIZE=14); 0003:00006:4 + DATA LENGTH IN WORDS IS 000A + FILE LINE (KIND=PRINTER, MAXRECSIZE=132, FRAMESIZE=8); 0003:00006:4 + DATA LENGTH IN WORDS IS 000C + 0003:00006:4 + LIST MATRIX(FOR K:= 1 STEP 1 UNTIL 33 DO 0003:00006:4 + FOR J:= 1 STEP 1 UNTIL 18 DO M[K,J]), 0003:00008:1 KASE(CASENO, CASEIN, SHEET, XRAY, EQUATION, 0003:00031:4 + MO, DAY, YEAR, LAST), 0003:0003E:1 + IDOUT(CASENO, CASEIN, MO, DAY, YEAR), 0003:00076:3 + PRESENT(FOR P:= 1 STEP 1 UNTIL 20 DO SYP[P]), 0003:0009E:4 + POUT(FOR P:= 1 STEP 1 UNTIL TOTP DO SYP[P]), 0003:000BA:1 + EXCLUDE(FOR E:= 1 STEP 1 UNTIL 20 DO SYE[E]), 0003:000D6:4 + EOUT(FOR E:= 1 STEP 1 UNTIL TOTE+1 DO SYE[E]), 0003:000F2:1 + SHOUT(OUTSHEET), 0003:0010F:1 + EQOUT(EQUATION), 0003:0011A:4 + ANS(FOR X:= K DO PYX[X]); 0003:00126:1 + 0003:0013D:1 + FORMAT OUT IDFORM(X5,"CASE NUMBER",I7,X5,"PATIENT",X2,A3,X5, 0003:0013D:1 + "DATE",X1,3(I3)), 0003:0013D:1 + PFORM(/,X5,"SYMPTOMS PRESENT",X4,20(I4)), 0003:0013D:1 + EFORM(/,X5,"SYMPTOMS OMITTED",X4,20(I4)), 0003:0013D:1 + SHFORM(/,X5,"SYMPTOMS USED",X3,A2), 0003:0013D:1 + EQFORM(X5,"EQUATION USED",I5), 0003:0013D:1 + HEAD(X15,"DISEASE",X5,"PROBABILITY"), 0003:0013D:1 + 0003:0013D:1 + FORM1(X8,"Y01",X7,"N",F16.4), 0003:0013D:1 + FORM2(X8,"Y02",X5,"A S D",F14.4), 0003:0013D:1 + FORM3(X8,"Y03",X2,"A S D - P S",F11.4), 0003:0013D:1 + FORM4(X8,"Y04",X2,"A S D - P H",F11.4), 0003:0013D:1 + FORM5(X8,"Y05",X4,"C E C D",F13.4), 0003:0013D:1 + FORM6(X8,"Y06",X3,"P A P V C",F12.4), 0003:0013D:1 + FORM7(X8,"Y07",X3,"T A P V C",F12.4), 0003:0013D:1 + FORM8(X8,"Y08",X6,"T A",F15.4), 0003:0013D:1 + FORM9(X8,"Y09",X5,"EBST.",F14.4), 0003:0013D:1 + FORM10(X8,"Y10",X1,"V S D - V P S",F10.4), 0003:0013D:1 + FORM11(X8,"Y11",X1,"V S D - I P S",F10.4), 0003:0013D:1 + FORM12(X8,"Y12",X5,"V P S",F14.4), 0003:0013D:1 + FORM13(X8,"Y13",X5,"I P S",F14.4), 0003:0013D:1 + FORM14(X8,"Y14",X3,"P. ATRES.",F12.4), 0003:0013D:1 + FORM15(X8,"Y15",X2,"COARCT. P A",F11.4), 0003:0013D:1 + FORM16(X8,"Y16",X6,"P H",F15.4), 0003:0013D:1 + FORM17(X8,"Y17",X5,"A P W",F14.4), 0003:0013D:1 + FORM18(X8,"Y18",X5,"P D A",F14.4), 0003:0013D:1 + DATA LENGTH IN WORDS IS 00E9 + FORM19(X8,"Y19",X2,"P A-V FIST.",F11.4), 0003:0013D:1 + FORM20(X8,"Y20",X6,"M S",F15.4), 0003:0013D:1 + FORM21(X8,"Y21",X4,"MYOC. D",F13.4), 0003:0013D:1 + FORM22(X8,"Y22",X2,"A O COR. A",F12.4), 0003:0013D:1 + FORM23(X8,"Y23",X2,"A S - VALV.",F11.4), 0003:0013D:1 + FORM24(X8,"Y24",X2,"A S - SUB.",F12.4), 0003:0013D:1 + FORM25(X8,"Y25",X3,"COARCT. A",F12.4), 0003:0013D:1 + FORM26(X8,"Y26",X4,"TRUNC.",F14.4), 0003:0013D:1 + FORM27(X8,"Y27",X3,"TRANSP.",F14.4), 0003:0013D:1 + FORM28(X8,"Y28",X3,"C TRANSP.",F12.4), 0003:0013D:1 + FORM29(X8,"Y29",X4,"AB. A O",F13.4), 0003:0013D:1 + FORM30(X8,"Y30",X5,"V S D",F14.4), 0003:0013D:1 + FORM31(X8,"Y31",X2,"V S D - P H",F11.4), 0003:0013D:1 + FORM32(X8,"Y32",X2,"P D A - P H",F11.4), 0003:0013D:1 + FORM33(X8,"Y33",X1,"T A - TRANSP.",F10.4); 0003:0013D:1 + 0003:0013D:1 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 0003:0013D:1 + PROCEDURE UNPACK(M, SHEET, XRAY, EQUATION, ROW); 0003:0013D:1 + VALUE SHEET, XRAY, EQUATION; 0003:0013D:1 + INTEGER SHEET, XRAY, EQUATION; 0003:0013D:1 + INTEGER ARRAY M[1], ROW[1]; 0003:0013D:1 BEGIN 0003:0013D:1 + INTEGER 0003:0013D:1 + ROWX; 0003:0013D:1 + UNPACK IS SEGMENT 0008 + 2 0008:00001:0 + PROCEDURE UPACK(M, MX, ROW, ROWX, COUNT); 0008:00001:0 + VALUE MX, ROWX, COUNT; 0008:00001:0 + INTEGER MX, ROWX, COUNT; 0008:00001:0 + INTEGER ARRAY M[1], ROW[1]; 0008:00001:0 + BEGIN 0008:00001:0 + DO BEGIN 0008:00001:0 + ROW[ROWX]:= (M[MX] DIV 1000000) MOD 1000; 4 0008:00001:0 + ROW[ROWX+1]:= (M[MX] DIV 1000) MOD 1000; 0008:00006:5 + ROW[ROWX+2]:= M[MX] MOD 1000; 0008:0000C:2 + ROWX:= ROWX+3; 0008:00011:2 + MX:= MX+1; 0008:00013:3 + COUNT:= COUNT-1; 0008:00015:3 + END 0008:00017:3 + UNTIL COUNT < 0; % MODELS 220 DFL/BRP INSTRUCTION 4 0008:00017:3 + END UPACK; 0008:00019:1 + 3 0008:00019:2 + ROWX:= 1; 0008:00019:2 + IF EQUATION ^= 10 THEN 0008:0001A:1 + UPACK(M, 2, ROW, ROWX, 16) 0008:0001B:2 + ELSE 0008:0001F:3 + BEGIN 0008:00020:0 + UPACK(M, 2, ROW, ROWX, 4); 3 0008:00020:4 + ROWX:= ROWX+21; % ROWX=22 0008:00024:4 + UPACK(M, 9, ROW, ROWX, 5); 0008:00026:4 + ROWX:= ROWX+27; % ROWX=49 0008:0002A:4 + UPACK(M, 18, ROW, ROWX, 0); 0008:0002C:4 + IF SHEET ^= 1 THEN 0008:00030:3 + BEGIN 0008:00031:3 + UPACK(M, 7, ROW, ROWX-33, 1); % ROWX=16 4 0008:00032:1 + ROW[ROWX]:= 0; 0008:00036:4 + END 0008:00038:5 + ELSE 4 0008:00038:5 + BEGIN 0008:00038:5 + ROW[19]:= (M[8] DIV 1000000) MOD 1000; 4 0008:00039:3 + ROWX:= ROWX-9; % ROWX=40 0008:0003E:0 + UPACK(M, 15, ROW, ROWX, 2); 0008:00040:0 + END; 0008:00044:0 + END; 4 0008:00044:0 + END UNPACK; 3 0008:00044:0 + UNPACK(0008) LENGTH IN WORDS IS 004B + 2 0003:0013D:1 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 0003:0013D:1 + 0003:0013D:1 + COMMENT READ DATA FOR SYMPTOM-DISEASE MATRIX.; 0003:0013D:1 + READ(CARD, /, MATRIX); 0003:0013D:1 + 0003:00146:5 + COMMENT THE PROGRAM BEGINS HERE. THE FIRST TWO INPUT CARDS 0003:00146:5 + ARE READ, THE FIRST TWO LINES OF OUTPUT ARE PRINTED, 0003:00146:5 + THE NUMBER OF SYMPTOMS ARE CALCULATED, 0003:00146:5 + AND THE EQUATION TYPE DETERMINED.; 0003:00146:5 + 0003:00146:5 + NEWCASE: FOR P:= 1 STEP 1 UNTIL 20 DO 0003:00146:5 + SYP[P]:= 0; 0003:00147:4 + FOR J:= 1 STEP 1 UNTIL 50 DO 0003:0014C:4 TP[J]:= ROW[J]:= 0; 0003:0014D:3 + FOR J:= 1 STEP 1 UNTIL 50 DO 0003:00154:3 + FTROW[J]:= 0.0; 0003:00155:2 + 0003:0015A:2 + CARD1: READ(CARD, /, KASE) [EOF]; 0003:0015A:2 + WRITE(LINE[SKIP 1]); 0003:00166:1 + WRITE(LINE, IDFORM, IDOUT); 0003:0016D:4 + CARD2: READ(CARD, /, PRESENT); 0003:00174:2 + P:= 1; 0003:0017E:0 + FOR J:= 1 STEP 1 UNTIL 50 DO 0003:0017E:5 + BEGIN 0003:0017F:4 + IF SYP[P] = J THEN 2 0003:0017F:4 + BEGIN 0003:00182:2 + TP[J]:= 1; 3 0003:00183:0 + P:= P+1 0003:00185:1 + END; 0003:00185:5 + END; 3 0003:00187:0 + 2 0003:00189:5 + TOTP:= P - 1; 0003:00189:5 + WRITE(LINE, PFORM, POUT); 0003:0018B:4 + K:= 1; 0003:00192:3 + IF SHEET = 1 THEN 0003:00193:2 + BEGIN 0003:00194:2 + OUTSHEET:= "W "; 2 0003:00195:0 + GO TO EQTEST 0003:00196:1 + END; 0003:00196:5 + OUTSHEET:= "B "; 2 0003:00196:5 + 0003:00198:0 + EQTEST: IF EQUATION = 10 THEN 0003:00198:0 + GO TO EQ10; 0003:00199:1 + 0003:00199:5 + COMMENT CALCULATE PROBABILITIES USING EQUATION 9.; 0003:00199:5 + 0003:00199:5 + COMMENT ONE ROW OF THE MATRIX IS UNPACKED AND THE 0003:00199:5 + INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED.; 0003:00199:5 + 0003:00199:5 + XP9: UNPACK(M[K,*], SHEET, XRAY, EQUATION, ROW[*]); 0003:00199:5 + FOR J:= 8 STEP 1 UNTIL 16, 24, 25, 0003:0019F:3 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 0003:001AC:0 + BEGIN 0003:001B9:2 + IF TP[J] = 1 THEN 2 0003:001B9:2 + ROW[J]:= 1000 - ROW[J] 0003:001BB:3 + END; 0003:001C0:1 + 2 0003:001C1:3 + COMMENT THE ROW-PRODUCT IS CALCULATED AND ZEROES TESTED FOR.; 0003:001C1:3 + PYKX[K]:= M[K,1]; 0003:001C1:3 + FOR P:= 1 STEP 1 UNTIL TOTP DO 0003:001C5:4 + BEGIN 0003:001C6:3 + IF ROW[SYP[P]] = 0 THEN 2 0003:001C6:3 + BEGIN 0003:001C9:5 + PYKX[K]:= 0.0; 3 0003:001CA:3 + GO TO TAL9 0003:001CC:4 + END; 0003:001CD:2 + FTROW[P]:= ROW[SYP[P]] 3 0003:001CD:2 + END; 0003:001D2:0 + 2 0003:001D5:3 + FOR P:= 1 STEP 1 UNTIL TOTP DO 0003:001D5:3 + PYKX[K]:= PYKX[K]*FTROW[P]; 0003:001D6:2 + 0003:001DF:2 TAL9: K:= K+1; 0003:001DF:2 + IF K <= 33 THEN 0003:001E1:1 + GO TO XP9; 0003:001E1:4 + GO TO NORM; 0003:001E2:2 + 0003:001E3:0 + 0003:001E3:0 + COMMENT CALCULATE PROBABILITIES USING EQUATION 10.; 0003:001E3:0 + 0003:001E3:0 + EQ10: FOR J:= 1 STEP 1 UNTIL 50 DO 0003:001E3:0 + TE[J]:= 0; 0003:001E3:5 + FOR E:= 1 STEP 1 UNTIL 20 DO 0003:001E8:5 + SYE[E]:= 0; 0003:001E9:4 + FOR X:= 1 STEP 1 UNTIL 10 DO 0003:001EE:4 + MX[X]:= 0; 0003:001EF:3 + FOR X:= 1 STEP 1 UNTIL 10 DO 0003:001F4:3 + FTMX[X]:= 0.0; 0003:001F5:2 + 0003:001FA:2 + COMMENT THE THIRD INPUT CARD IS READ, THE THIRD LINE OF 0003:001FA:2 + OUTPUT IS PRINTED, AND THE NUMBER OF SYMPTOMS 0003:001FA:2 + TO BE OMITTED FOR THIS CASE IS CALCULATED.; 0003:001FA:2 + 0003:001FA:2 + CARD3: READ(CARD, /, EXCLUDE); 0003:001FA:2 + E:= 1; 0003:00204:0 + FOR J:= 1 STEP 1 UNTIL 50 DO 0003:00204:5 + BEGIN 0003:00205:4 + IF SYE[E] = J THEN 2 0003:00205:4 + BEGIN 0003:00208:2 + TE[J]:= 1; 3 0003:00209:0 + E:= E+1 0003:0020B:1 + END; 0003:0020B:5 + END; 3 0003:0020D:0 + 2 0003:0020F:5 + TOTE:= E-1; 0003:0020F:5 + WRITE(LINE, EFORM, EOUT); 0003:00211:4 + TOTX:= SHEET+8; 0003:00218:3 + 0003:0021A:3 + COMMENT ONE ROW OF THE MATRIX IS UNPACKED, THE 0003:0021A:3 + INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED, 0003:0021A:3 + AND THE SYMPTOMS OMITTED FOR THIS CASE DELETED.; 0003:0021A:3 + 0003:0021A:3 + XP10: UNPACK(M[K,*], SHEET, XRAY, EQUATION, ROW[*]); 0003:0021A:3 + FOR J:= 8 STEP 1 UNTIL 15, 24, 25, 0003:00220:1 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 0003:0022C:4 + BEGIN 0003:0023A:0 + IF TP[J] = 1 THEN 2 0003:0023A:0 + ROW[J]:= 1000 - ROW[J]; 0003:0023C:1 + IF ROW[J] = 0 THEN 0003:00241:3 + BEGIN 0003:00243:4 + PYKX[K]:= 0.0; 3 0003:00244:2 + GO TO TAL10 0003:00246:3 + END; 0003:00247:1 + IF TE[J] = 1 THEN 3 0003:00247:1 + ROW[J]:= 0 0003:00249:2 + END; 0003:0024B:5 + 2 0003:0024C:5 + COMMENT THE ROW-PRODUCT IS CALCULATED FOR THOSE INDEPENDENT 0003:0024C:5 + SYMPTOMS COMMON TO BOTH SHEETS, ZERO VALUES TESTED 0003:0024C:5 + FOR, AND EACH ELEMENT SCALED.; 0003:0024C:5 + 0003:0024C:5 PYKX[K]:= M[K,1]; 0003:0024C:5 + FOR J:= 8 STEP 1 UNTIL 15, 24, 25, 0003:00251:0 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 0003:0025D:3 + BEGIN 0003:0026A:5 + FTROW[J]:= ROW[J]; 2 0003:0026A:5 + FTROW[J]:= FTROW[J]/100.0; 0003:0026E:4 + IF FTROW[J] ^= 0.0 THEN 0003:00273:0 + PYKX[K]:= PYKX[K]*FTROW[J] 0003:00275:1 + END; 0003:0027B:1 + 2 0003:0027C:2 + 0003:0027C:2 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 0003:0027C:2 + EXCLUSIVE SYMPTOM-SETS COMMON TO BOTH BROWN AND 0003:0027C:2 + WHITE SYMPTOM CHECK SHEETS PER TABLE V.; 0003:0027C:2 + 0003:0027C:2 + X1TO3: MX[1]:= ROW[SYP[1]]; 0003:0027C:2 + X4TO7: IF TE[4] = 1 THEN 0003:0027F:4 + BEGIN 0003:00281:1 + MX[2]:= 100; 2 0003:00281:5 + GO TO X26 0003:00283:2 + END; 0003:00284:0 + IF SYP[2] <= 7 THEN 2 0003:00284:0 + BEGIN 0003:00285:3 + MX[2]:= ROW[SYP[2]]; 2 0003:00286:1 + GO TO X26 0003:00289:3 + END; 0003:0028A:1 + MX[2]:= 1000 - ROW[4] - ROW[5] - ROW[6] - ROW[7]; 2 0003:0028A:1 + 0003:00291:2 + X26: X:= 3; 0003:00291:2 + FOR J:= 26, 28, 34, 36 DO 0003:00292:2 + BEGIN 0003:0029E:2 + IF TE[J] = 1 THEN 2 0003:0029E:2 + BEGIN 0003:002A0:3 + MX[X]:= 100; 3 0003:002A1:1 + GO TO LAB5 0003:002A3:3 + END; 0003:002A4:1 + IF TP[J] = TP[J+1] THEN 3 0003:002A4:1 + BEGIN 0003:002A8:2 + MX[X]:= 1000 - ROW[J] - ROW[J+1]; 3 0003:002A9:0 + GO TO LAB5 0003:002B0:0 + END; 0003:002B0:4 + IF TP[J] = 1 THEN 3 0003:002B0:4 + BEGIN 0003:002B2:5 + MX[X]:= ROW[J]; 3 0003:002B3:3 + GO TO LAB5 0003:002B7:2 + END; 0003:002B8:0 + MX[X]:= ROW[J+1]; 3 0003:002B8:0 + LAB5: X:= X+1 0003:002BC:1 + END; 0003:002BC:5 + 2 0003:002BE:4 + BNORWH: IF SHEET = 1 THEN 0003:002BE:4 + GO TO WHITE; 0003:002BF:4 + 0003:002C0:2 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 0003:002C0:2 + EXCLUSIVE SYMPTOM-SETS FOR THE BROWN SHEET OPTION.; 0003:002C0:2 + 0003:002C0:2 + BROWN: IF TP[16] = 1 THEN 0003:002C0:2 + ROW[16]:= 1000 - ROW[16]; 0003:002C1:5 + IF ROW[16] = 0 THEN 0003:002C5:5 BEGIN 0003:002C7:2 + PYKX[K]:= 0.0; 2 0003:002C8:0 + GO TO TAL10 0003:002CA:1 + END; 0003:002CA:5 + IF TE[16] = 1 THEN 2 0003:002CA:5 + BEGIN 0003:002CC:2 + ROW[16]:= 0; 2 0003:002CD:0 + GO TO X17TO19 0003:002CE:3 + END; 0003:002CF:1 + 2 0003:002CF:1 + BEGIN 0003:002CF:1 + FTROW[16]:= ROW[16]; 2 0003:002CF:1 + PYKX[K]:= PYKX[K]*FTROW[16] / 100.0 0003:002D1:4 + END; 0003:002D6:4 + 2 0003:002D7:2 + X17TO19: IF TE[17] = 1 THEN 0003:002D7:2 + BEGIN 0003:002D8:5 + MX[7]:= 100; 2 0003:002D9:3 + GO TO X20 0003:002DB:1 + END; 0003:002DB:5 + IF TP[17] = TP[18] AND TP[18] = TP[19] THEN 2 0003:002DB:5 + BEGIN 0003:002E1:0 + MX[7]:= (1000-ROW[17])*(1000-ROW[18])* 2 0003:002E1:4 + (1000-ROW[19]); 0003:002E6:1 + GO TO X20 0003:002E9:0 + END; 0003:002E9:4 + IF TP[19] = 1 THEN 2 0003:002E9:4 + BEGIN 0003:002EB:1 + MX[7]:= ROW[19]; 2 0003:002EB:5 + GO TO X20 0003:002EE:2 + END; 0003:002EF:0 + IF TP[17] = 0 THEN 2 0003:002EF:0 + BEGIN 0003:002F0:3 + MX[7]:= ROW[18]*(1000 - ROW[17]); 2 0003:002F1:1 + GO TO X20 0003:002F5:5 + END; 0003:002F6:3 + IF TP[18] = 0 THEN 2 0003:002F6:3 + BEGIN 0003:002F8:0 + MX[7]:= ROW[17]*(1000 - ROW[18]); 2 0003:002F8:4 + GO TO X20 0003:002FD:2 + END; 0003:002FE:0 + MX[7]:= ROW[17]*ROW[18]; 2 0003:002FE:0 + 0003:00302:0 + X20: IF TE[20] = 1 THEN 0003:00302:0 + BEGIN 0003:00303:3 + MX[8]:= 100; 2 0003:00304:1 + GO TO FLTMX 0003:00305:5 + END; 0003:00306:3 + 2 0003:00306:3 + T2021:= (1000 - ROW[20] - ROW[21]); 0003:00306:3 + T22:= (1000 - ROW[22]); 0003:0030A:3 + 0003:0030D:1 + IF (TP[20] = TP[21]) AND (TP[21] = TP[22]) 0003:0030D:1 + AND (TP[22] = TP[23]) THEN 0003:00311:5 + BEGIN 0003:00315:0 + MX[8]:= T2021*T22*(1000 - ROW[23]); 2 0003:00315:4 + GO TO FLTMX 0003:0031A:4 + END; 0003:0031B:2 + IF TP[20] = 1 THEN 2 0003:0031B:2 BEGIN 0003:0031C:5 + IF TP[22] = 1 THEN 2 0003:0031D:3 + BEGIN 0003:0031F:0 + MX[8]:= ROW[20]*ROW[22]; 3 0003:0031F:4 + GO TO FLTMX 0003:00323:4 + END; 0003:00324:2 + MX[8]:= ROW[20]*T22; 3 0003:00324:2 + GO TO FLTMX 0003:00327:5 + END; 0003:00328:3 + 2 0003:00328:3 + IF TP[21] = 1 THEN 0003:00328:3 + BEGIN 0003:0032A:0 + IF TP[22] = 1 THEN 2 0003:0032A:4 + BEGIN 0003:0032C:1 + MX[8]:= ROW[21]*ROW[22]; 3 0003:0032C:5 + GO TO FLTMX 0003:00330:5 + END; 0003:00331:3 + MX[8]:= ROW[21]*T22; 3 0003:00331:3 + GO TO FLTMX 0003:00335:0 + END; 0003:00335:4 + IF TP[22] = 1 THEN 2 0003:00335:4 + BEGIN 0003:00337:1 + MX[8]:= ROW[22]*T2021; 2 0003:00337:5 + GO TO FLTMX 0003:0033B:2 + END; 0003:0033C:0 + MX[8]:= ROW[23]; 2 0003:0033C:0 + GO TO FLTMX; 0003:0033E:3 + 0003:0033F:1 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 0003:0033F:1 + EXCLUSIVE SYMPTOM-SETS FOR THE WHITE SHEET OPTION.; 0003:0033F:1 + 0003:0033F:1 + WHITE: IF (TE[19] = TE[42])AND (TE[42] = TE[44]) 0003:0033F:1 + AND (TE[44] = 1)THEN 0003:00343:5 + BEGIN 0003:00346:0 + MX[7]:= 100; 2 0003:00346:4 + GO TO X40 0003:00348:2 + END; 0003:00349:0 + 2 0003:00349:0 + T4243:= (1000 - ROW[42] - ROW[43]); 0003:00349:0 + T4445:= (1000 - ROW[44] - ROW[45]); 0003:0034D:0 + 0003:00351:0 + IF (TP[19] = TP[42]) AND (TP[42] = TP[43]) 0003:00351:0 + AND (TP[43] = TP[44]) AND (TP[44] = TP[45]) THEN 0003:00355:4 + BEGIN 0003:0035B:3 + MX[7]:= (1000 - ROW[19])*T4243*T4445; 2 0003:0035C:1 + GO TO X40 0003:00361:1 + END; 0003:00361:5 + IF TP[19] = 1 THEN 2 0003:00361:5 + BEGIN 0003:00363:2 + MX[7]:= ROW[19]; 2 0003:00364:0 + GO TO X40 0003:00366:3 + END; 0003:00367:1 + IF TP[42] = 1 THEN 2 0003:00367:1 + BEGIN 0003:00368:4 + IF TP[44] = 1 THEN 2 0003:00369:2 + BEGIN 0003:0036A:5 + MX[7]:= ROW[42]*ROW[44]; 3 0003:0036B:3 + GO TO X40 0003:0036F:3 + END; 0003:00370:1 IF TP[45] = 1 THEN 3 0003:00370:1 + BEGIN 0003:00371:4 + MX[7]:= ROW[42]*ROW[45]; 3 0003:00372:2 + GO TO X40 0003:00376:2 + END; 0003:00377:0 + MX[7]:= ROW[42]*T4445; 3 0003:00377:0 + GO TO X40 0003:0037A:3 + END; 0003:0037B:1 + 2 0003:0037B:1 + IF TP[43] = 1 THEN 0003:0037B:1 + BEGIN 0003:0037C:4 + IF TP[44] = 1 THEN 2 0003:0037D:2 + BEGIN 0003:0037E:5 + MX[7]:= ROW[43]*ROW[44]; 3 0003:0037F:3 + GO TO X40 0003:00383:3 + END; 0003:00384:1 + IF TP[45] = 1 THEN 3 0003:00384:1 + BEGIN 0003:00385:4 + MX[7]:= ROW[43]*ROW[45]; 3 0003:00386:2 + GO TO X40 0003:0038A:2 + END; 0003:0038B:0 + MX[7]:= ROW[43]*T4445; 3 0003:0038B:0 + GO TO X40 0003:0038E:3 + END; 0003:0038F:1 + 2 0003:0038F:1 + IF TP[44] = 1 THEN 0003:0038F:1 + BEGIN 0003:00390:4 + MX[7]:= ROW[44]*T4243; 2 0003:00391:2 + GO TO X40 0003:00394:5 + END; 0003:00395:3 + MX[7]:= ROW[45]*T4243; 2 0003:00395:3 + 0003:00399:0 + X40: IF TE[40] = 1 THEN 0003:00399:0 + BEGIN 0003:0039A:3 + MX[8]:= 100; 2 0003:0039B:1 + GO TO X2369 0003:0039C:5 + END; 0003:0039D:3 + 2 0003:0039D:3 + IF TP[40] = TP[41] THEN 0003:0039D:3 + BEGIN 0003:003A0:0 + MX[8]:= 1000 - ROW[40] - ROW[41]; 2 0003:003A0:4 + GO TO X2369 0003:003A5:2 + END; 0003:003A6:0 + 2 0003:003A6:0 + IF TP[40] = 1 THEN 0003:003A6:0 + BEGIN 0003:003A7:3 + MX[8]:= ROW[40]; 2 0003:003A8:1 + GO TO X2369 0003:003AA:4 + END; 0003:003AB:2 + MX[8]:= ROW[41]; 2 0003:003AB:2 + 0003:003AD:5 + X2369: IF (TE[22] = TE[46]) AND (TE[46] = 1) THEN 0003:003AD:5 + BEGIN 0003:003B2:0 + MX[9]:= 100; 2 0003:003B2:4 + GO TO FLTMX 0003:003B4:2 + END; 0003:003B5:0 + 2 0003:003B5:0 + T22:= 1000 - ROW[22]; 0003:003B5:0 + T6789:= 1000 - ROW[46] - ROW[47] - ROW[48] - ROW[49]; 0003:003B7:4 0003:003BE:2 + IF (TP[22] = TP[23]) AND (TP[23] = TP[46]) 0003:003BE:2 + AND (TP[46] = TP[47]) AND (TP[47] = TP[48]) 0003:003C3:0 + AND (TP[48] = TP[49]) THEN 0003:003C8:2 + BEGIN 0003:003CB:3 + MX[9]:= T22*(1000 - ROW[23])*T6789; 2 0003:003CC:1 + GO TO FLTMX 0003:003D1:1 + END; 0003:003D1:5 + 2 0003:003D1:5 + IF TP[22] = 1 THEN 0003:003D1:5 + BEGIN 0003:003D3:2 + FOR J:= 46 STEP 1 UNTIL 49 DO 2 0003:003D4:0 + BEGIN 0003:003D5:0 + IF TP[J] = 1 THEN 3 0003:003D5:0 + BEGIN 0003:003D7:1 + MX[9]:= ROW[J]*ROW[22]; 4 0003:003D7:5 + GO TO FLTMX 0003:003DC:3 + END; 0003:003DD:1 + END; 4 0003:003DD:1 + MX[9]:= ROW[22]*T6789; 3 0003:003E0:0 + GO TO FLTMX 0003:003E3:3 + END; 0003:003E4:1 + 2 0003:003E4:1 + FOR J:= 46 STEP 1 UNTIL 49 DO 0003:003E4:1 + BEGIN 0003:003E5:1 + IF TP[J] = 1 THEN 2 0003:003E5:1 + BEGIN 0003:003E7:2 + MX[9]:= ROW[J]*T22; 3 0003:003E8:0 + GO TO FLTMX 0003:003EC:1 + END; 0003:003EC:5 + END; 3 0003:003EC:5 + 2 0003:003EF:4 + MX[9]:= ROW[23]; 0003:003EF:4 + GO TO FLTMX; 0003:003F2:1 + 0003:003F2:5 + FLTMX: FOR X:= 1 STEP 1 UNTIL TOTX DO 0003:003F2:5 + BEGIN 0003:003F3:4 + FTMX[X]:= MX[X]; 2 0003:003F3:4 + FTMX[X]:= FTMX[X]/100.00 0003:003F7:3 + END; 0003:003FB:1 + 2 0003:003FF:0 + FOR X:= 1 STEP 1 UNTIL TOTX DO 0003:003FF:0 + PYKX[K]:= PYKX[K]*FTMX[X]; 0003:003FF:5 + 0003:00408:5 + COMMENT AT THIS POINT, THE ROW-PRODUCT HAS BEEN COMPUTED 0003:00408:5 + AND A TEST IS MADE TO DETERMINE WHETHER THERE 0003:00408:5 + ARE MORE ROWS YET TO BE PROCESSED, OR TO PRINT-OUT.; 0003:00408:5 + 0003:00408:5 + TAL10: K:= K+1; 0003:00408:5 + IF K <= 33 THEN 0003:0040A:4 + GO TO XP10; 0003:0040B:1 + GO TO NORM; 0003:0040B:5 + 0003:0040C:3 + COMMENT THE ROW-PROBABILITIES ARE FIRST NORMALIZED TO GIVE A 0003:0040C:3 + TRUE PERCENTAGE FIGURE AND LINES 4 - 6 ARE PRINTED.; 0003:0040C:3 + 0003:0040C:3 + NORM: SUM:= 0.0; 0003:0040C:3 + WRITE(LINE, SHFORM, SHOUT); 0003:0040D:2 + FOR K:= 1 STEP 1 UNTIL 33 DO 0003:00414:1 SUM:= SUM + PYKX[K]; 0003:00415:0 + WRITE(LINE, EQFORM, EQOUT); 0003:0041B:1 + FOR K:= 1 STEP 1 UNTIL 33 DO 0003:00422:0 + PYX[K]:= PYKX[K] / SUM; 0003:00422:5 + 0003:0042A:2 + WRITE(LINE, HEAD); 0003:0042A:2 + 0003:00430:0 + COMMENT THE PROBABILITIES ARE NOW PRINTED WHICH ARE ONE 0003:00430:0 + PERCENT OR GREATER TOGETHER WITH DISEASE I. D. .; 0003:00430:0 + 0003:00430:0 + K:= 1; 0003:00430:0 + PRINT: IF PYX[K] < 0.01 THEN 0003:00430:5 + GO TO TALPT; 0003:00434:0 + 0003:00434:4 + GO TO SWOUT[K]; 0003:00434:4 + Y01: WRITE(LINE, FORM1, ANS); 0003:0044D:1 + GO TO TALPT; 0003:00454:0 + Y02: WRITE(LINE, FORM2, ANS); 0003:00454:4 + GO TO TALPT; 0003:0045B:3 + Y03: WRITE(LINE, FORM3, ANS); 0003:0045C:1 + GO TO TALPT; 0003:00463:0 + Y04: WRITE(LINE, FORM4, ANS); 0003:00463:4 + GO TO TALPT; 0003:0046A:3 + Y05: WRITE(LINE, FORM5, ANS); 0003:0046B:1 + GO TO TALPT; 0003:00472:0 + Y06: WRITE(LINE, FORM6, ANS); 0003:00472:4 + GO TO TALPT; 0003:00479:3 + Y07: WRITE(LINE, FORM7, ANS); 0003:0047A:1 + GO TO TALPT; 0003:00481:0 + Y08: WRITE(LINE, FORM8, ANS); 0003:00481:4 + GO TO TALPT; 0003:00488:3 + Y09: WRITE(LINE, FORM9, ANS); 0003:00489:1 + GO TO TALPT; 0003:00490:0 + Y10: WRITE(LINE, FORM10, ANS); 0003:00490:4 + GO TO TALPT; 0003:00497:3 + Y11: WRITE(LINE, FORM11, ANS); 0003:00498:1 + GO TO TALPT; 0003:0049F:0 + Y12: WRITE(LINE, FORM12, ANS); 0003:0049F:4 + GO TO TALPT; 0003:004A6:3 + Y13: WRITE(LINE, FORM13, ANS); 0003:004A7:1 + GO TO TALPT; 0003:004AE:0 + Y14: WRITE(LINE, FORM14, ANS); 0003:004AE:4 + GO TO TALPT; 0003:004B5:3 + Y15: WRITE(LINE, FORM15, ANS); 0003:004B6:1 + GO TO TALPT; 0003:004BD:0 + Y16: WRITE(LINE, FORM16, ANS); 0003:004BD:4 + GO TO TALPT; 0003:004C4:3 + Y17: WRITE(LINE, FORM17, ANS); 0003:004C5:1 + GO TO TALPT; 0003:004CC:0 + Y18: WRITE(LINE, FORM18, ANS); 0003:004CC:4 + GO TO TALPT; 0003:004D3:2 + Y19: WRITE(LINE, FORM19, ANS); 0003:004D4:0 + GO TO TALPT; 0003:004DA:5 + Y20: WRITE(LINE, FORM20, ANS); 0003:004DB:3 + GO TO TALPT; 0003:004E2:2 + Y21: WRITE(LINE, FORM21, ANS); 0003:004E3:0 + GO TO TALPT; 0003:004E9:5 + Y22: WRITE(LINE, FORM22, ANS); 0003:004EA:3 + GO TO TALPT; 0003:004F1:2 Y23: WRITE(LINE, FORM23, ANS); 0003:004F2:0 + GO TO TALPT; 0003:004F8:5 + Y24: WRITE(LINE, FORM24, ANS); 0003:004F9:3 + GO TO TALPT; 0003:00500:2 + Y25: WRITE(LINE, FORM25, ANS); 0003:00501:0 + GO TO TALPT; 0003:00507:5 + Y26: WRITE(LINE, FORM26, ANS); 0003:00508:3 + GO TO TALPT; 0003:0050F:2 + Y27: WRITE(LINE, FORM27, ANS); 0003:00510:0 + GO TO TALPT; 0003:00516:5 + Y28: WRITE(LINE, FORM28, ANS); 0003:00517:3 + GO TO TALPT; 0003:0051E:2 + Y29: WRITE(LINE, FORM29, ANS); 0003:0051F:0 + GO TO TALPT; 0003:00525:5 + Y30: WRITE(LINE, FORM30, ANS); 0003:00526:3 + GO TO TALPT; 0003:0052D:2 + Y31: WRITE(LINE, FORM31, ANS); 0003:0052E:0 + GO TO TALPT; 0003:00534:5 + Y32: WRITE(LINE, FORM32, ANS); 0003:00535:3 + GO TO TALPT; 0003:0053C:2 + Y33: WRITE(LINE, FORM33, ANS); 0003:0053D:0 + GO TO TALPT; 0003:00543:5 + 0003:00544:3 + TALPT: K:= K+1; 0003:00544:3 + IF K <= 33 THEN 0003:00546:2 + GO TO PRINT; 0003:00546:5 + 0003:00547:3 + COMMENT PROGRAM REPEATS TO BEGINNING IF THERE ARE MORE 0003:00547:3 + CASES TO BE RUN, AND HALTS IF NOT. THE INITIALS 0003:00547:3 + H W APPEAR IN THE A-REG. UPON COMPLETION.; 0003:00547:3 + 0003:00547:3 + IF LAST = 0 THEN 0003:00547:3 + GO TO NEWCASE; 0003:00548:3 + COMMENT STOP 7270061216; 0003:00549:1 + COMMENT GO TO NEWCASE; 0003:00549:1 + EOF: 0003:00549:1 + END. 0003:00549:1 + DATA LENGTH IN WORDS IS 009D + DATA LENGTH IN WORDS IS 004F + BLOCK#1(0003) LENGTH IN WORDS IS 05A1 +==================================================================================================================================== +NUMBER OF ERRORS DETECTED = 0. +NUMBER OF SEGMENTS = 11. TOTAL SEGMENT SIZE = 2007 WORDS. CORE ESTIMATE = 4068 WORDS. STACK ESTIMATE = 101 +PROGRAM SIZE = 672 CARDS, 4847 SYNTACTIC ITEMS, 102 DISK SECTORS. +PROGRAM FILE NAME: (PAUL)MRS081/NEW ON OPS. +COMPILATION TIME = 0.526 SECONDS ELAPSED; 0.238 SECONDS PROCESSING; 0.039 SECONDS I/O. +==================================================================================================================================== CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS OMITTED 0 + + SYMPTOMS USED W + EQUATION USED 10 + DISEASE PROBABILITY + Y10 V S D - V P S 0.0286 + Y11 V S D - I P S 0.0201 + Y12 V P S 0.7295 + Y13 I P S 0.2151 + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS OMITTED 11 0 + + SYMPTOMS USED W + EQUATION USED 10 + DISEASE PROBABILITY + Y10 V S D - V P S 0.0297 + Y11 V S D - I P S 0.0209 + Y12 V P S 0.7278 + Y13 I P S 0.2146 + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS USED W + EQUATION USED 9 + DISEASE PROBABILITY + Y02 A S D 0.0172 + Y10 V S D - V P S 0.1981 + Y11 V S D - I P S 0.2311 + Y12 V P S 0.4239 + Y13 I P S 0.1224 + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS OMITTED 0 + + SYMPTOMS USED B + EQUATION USED 10 + DISEASE PROBABILITY + Y02 A S D 0.0158 + Y10 V S D - V P S 0.0595 + Y11 V S D - I P S 0.0418 + Y12 V P S 0.6692 + Y13 I P S 0.1933 + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS OMITTED 11 0 + + SYMPTOMS USED B + EQUATION USED 10 + DISEASE PROBABILITY + Y02 A S D 0.0164 + Y10 V S D - V P S 0.0616 + Y11 V S D - I P S 0.0433 + Y12 V P S 0.6651 + Y13 I P S 0.1921 + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS USED B + EQUATION USED 9 + DISEASE PROBABILITY + Y02 A S D 0.0113 + Y10 V S D - V P S 0.3478 + Y11 V S D - I P S 0.4058 + Y12 V P S 0.1675 + Y13 I P S 0.0484 + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS USED B + EQUATION USED 9 + DISEASE PROBABILITY + Y02 A S D 0.0113 + Y10 V S D - V P S 0.3478 + Y11 V S D - I P S 0.4058 + Y12 V P S 0.1675 + Y13 I P S 0.0484 \ No newline at end of file diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.wfl_m b/software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.wfl_m new file mode 100644 index 0000000..6a12e6c --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.wfl_m @@ -0,0 +1,830 @@ +BEGIN JOB MRS081; 00001000 + 00002000 +COMPILE MRS081/NEW ALGOL GO; 00003000 + OPTION = (DSED, FAULT, ARRAY); 00003100 + ALGOL DATA CARD 00004000 +$SET LIST SINGLE 00005000 + BEGIN 00006000 + COMMENT CONGENITAL HEART DISEASE DIAGNOSIS PROGRAM. 00007000 + FROM A SET OF CLINICAL SYMPTOMS, THE PROBABILITIES 00008000 + FOR EACH OF THE 33 CONGENITAL HEART DISEASES BEING 00009000 + PRESENT IN THE PATIENT UNDER CONSIDERATION IS 00010000 + CALCULATED AND THOSE GREATER THAN ONE PERCENT 00011000 + ARE PRINTED OUT TOGETHER WITH DISEASE IDENTIFICATION 00012000 + AND CASE INFORMATION. 00013000 + 00014000 + FRED B FIELDING 00015000 + SAN FRANCISCO DISTRICT OFFICE 00016000 + 00017000 + CARD SEQUENCE CODE FOR THE PROGRAM STARTS WITH 00018000 + CHDD0001 AND ROW 01-1 FOR SYMPTOM-DISEASE MATRIX. 00019000 + FIRST RELEASE 05 - 31 - 61; 00020000 + 00021000 + 00022000 + INTEGER CASENO, CASEIN, SHEET, XRAY, EQUATION, 00023000 + MO, DAY, YEAR, LAST, 00024000 + E, J, K, P, X, 00025000 + TOTE, TOTP, TOTX, OUTSHEET, 00026000 + T22, T2021, T4243, T4445, T6789; 00027000 + 00028000 + REAL SUM; 00029000 + 00030000 + INTEGER ARRAY SYE[1:20], SYP[1:20], TE[1:50], TP[1:50], 00031000 + ROW[1:51], MX[1:10], M[1:33,1:18]; 00032000 + 00033000 + REAL ARRAY FTROW[1:50], FTMX[1:10], PYKX[1:33], PYX[1:33]; 00034000 + 00035000 + LABEL NEWCASE, CARD1, CARD2, EQTEST, XP9, TAL9, EQ10, 00036000 + CARD3, XP10, X1TO3, X4TO7, X26, LAB5, BNORWH, BROWN, 00037000 + X17TO19, X20, WHITE, X40, X2369, FLTMX, TAL10, 00038000 + NORM, PRINT, TALPT, EOF, 00039000 + Y01, Y02, Y03, Y04, Y05, Y06, Y07, Y08, Y09, Y10, 00040000 + Y11, Y12, Y13, Y14, Y15, Y16, Y17, Y18, Y19, Y20, 00041000 + Y21, Y22, Y23, Y24, Y25, Y26, Y27, Y28, Y29, Y30, 00042000 + Y31, Y32, Y33; 00043000 + 00044000 + SWITCH SWOUT:= Y01,Y02,Y03,Y04,Y05,Y06,Y07,Y08,Y09, 00045000 + Y10,Y11,Y12,Y13,Y14,Y15,Y16,Y17,Y18,Y19,Y20,Y21, 00046000 + Y22,Y23,Y24,Y25,Y26,Y27,Y28,Y29,Y30,Y31,Y32,Y33; 00047000 + 00048000 + FILE CARD(KIND=READER, MAXRECSIZE=14); 00049000 + FILE LINE (KIND=PRINTER, MAXRECSIZE=132, FRAMESIZE=8); 00050000 + 00051000 + LIST MATRIX(FOR K:= 1 STEP 1 UNTIL 33 DO 00052000 + FOR J:= 1 STEP 1 UNTIL 18 DO M[K,J]), 00053000 + KASE(CASENO, CASEIN, SHEET, XRAY, EQUATION, 00054000 + MO, DAY, YEAR, LAST), 00055000 + IDOUT(CASENO, CASEIN, MO, DAY, YEAR), 00056000 + PRESENT(FOR P:= 1 STEP 1 UNTIL 20 DO SYP[P]), 00057000 + POUT(FOR P:= 1 STEP 1 UNTIL TOTP DO SYP[P]), 00058000 + EXCLUDE(FOR E:= 1 STEP 1 UNTIL 20 DO SYE[E]), 00059000 + EOUT(FOR E:= 1 STEP 1 UNTIL TOTE+1 DO SYE[E]), 00060000 + SHOUT(OUTSHEET), 00061000 + EQOUT(EQUATION), 00062000 + ANS(FOR X:= K DO PYX[X]); 00063000 + 00064000 + FORMAT OUT IDFORM(X5,"CASE NUMBER",I7,X5,"PATIENT",X2,A3,X5, 00065000 + "DATE",X1,3(I3)), 00066000 + PFORM(/,X5,"SYMPTOMS PRESENT",X4,20(I4)), 00067000 + EFORM(/,X5,"SYMPTOMS OMITTED",X4,20(I4)), 00068000 + SHFORM(/,X5,"SYMPTOMS USED",X3,A2), 00069000 + EQFORM(X5,"EQUATION USED",I5), 00070000 + HEAD(X15,"DISEASE",X5,"PROBABILITY"), 00071000 + 00072000 + FORM1(X8,"Y01",X7,"N",F16.4), 00073000 + FORM2(X8,"Y02",X5,"A S D",F14.4), 00074000 + FORM3(X8,"Y03",X2,"A S D - P S",F11.4), 00075000 + FORM4(X8,"Y04",X2,"A S D - P H",F11.4), 00076000 + FORM5(X8,"Y05",X4,"C E C D",F13.4), 00077000 + FORM6(X8,"Y06",X3,"P A P V C",F12.4), 00078000 + FORM7(X8,"Y07",X3,"T A P V C",F12.4), 00079000 + FORM8(X8,"Y08",X6,"T A",F15.4), 00080000 + FORM9(X8,"Y09",X5,"EBST.",F14.4), 00081000 + FORM10(X8,"Y10",X1,"V S D - V P S",F10.4), 00082000 + FORM11(X8,"Y11",X1,"V S D - I P S",F10.4), 00083000 + FORM12(X8,"Y12",X5,"V P S",F14.4), 00084000 + FORM13(X8,"Y13",X5,"I P S",F14.4), 00085000 + FORM14(X8,"Y14",X3,"P. ATRES.",F12.4), 00086000 + FORM15(X8,"Y15",X2,"COARCT. P A",F11.4), 00087000 + FORM16(X8,"Y16",X6,"P H",F15.4), 00088000 + FORM17(X8,"Y17",X5,"A P W",F14.4), 00089000 + FORM18(X8,"Y18",X5,"P D A",F14.4), 00090000 + FORM19(X8,"Y19",X2,"P A-V FIST.",F11.4), 00091000 + FORM20(X8,"Y20",X6,"M S",F15.4), 00092000 + FORM21(X8,"Y21",X4,"MYOC. D",F13.4), 00093000 + FORM22(X8,"Y22",X2,"A O COR. A",F12.4), 00094000 + FORM23(X8,"Y23",X2,"A S - VALV.",F11.4), 00095000 + FORM24(X8,"Y24",X2,"A S - SUB.",F12.4), 00096000 + FORM25(X8,"Y25",X3,"COARCT. A",F12.4), 00097000 + FORM26(X8,"Y26",X4,"TRUNC.",F14.4), 00098000 + FORM27(X8,"Y27",X3,"TRANSP.",F14.4), 00099000 + FORM28(X8,"Y28",X3,"C TRANSP.",F12.4), 00100000 + FORM29(X8,"Y29",X4,"AB. A O",F13.4), 00101000 + FORM30(X8,"Y30",X5,"V S D",F14.4), 00102000 + FORM31(X8,"Y31",X2,"V S D - P H",F11.4), 00103000 + FORM32(X8,"Y32",X2,"P D A - P H",F11.4), 00104000 + FORM33(X8,"Y33",X1,"T A - TRANSP.",F10.4); 00105000 + 00106000 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00107000 + PROCEDURE UNPACK(M, SHEET, XRAY, EQUATION, ROW); 00108000 + VALUE SHEET, XRAY, EQUATION; 00109000 + INTEGER SHEET, XRAY, EQUATION; 00110000 + INTEGER ARRAY M[1], ROW[1]; 00111000 + BEGIN 00112000 + INTEGER 00113000 + ROWX; 00114000 + 00115000 + PROCEDURE UPACK(M, MX, ROW, ROWX, COUNT); 00116000 + VALUE MX, ROWX, COUNT; 00117000 + INTEGER MX, ROWX, COUNT; 00118000 + INTEGER ARRAY M[1], ROW[1]; 00119000 + BEGIN 00120000 + DO BEGIN 00121000 + ROW[ROWX]:= (M[MX] DIV 1000000) MOD 1000; 00122000 + ROW[ROWX+1]:= (M[MX] DIV 1000) MOD 1000; 00123000 + ROW[ROWX+2]:= M[MX] MOD 1000; 00124000 + ROWX:= ROWX+3; 00125000 + MX:= MX+1; 00126000 + COUNT:= COUNT-1; 00127000 + END 00128000 + UNTIL COUNT < 0; % MODELS 220 DFL/BRP INSTRUCTION 00129000 + END UPACK; 00130000 + 00131000 + ROWX:= 1; 00132000 + IF EQUATION ^= 10 THEN 00133000 + UPACK(M, 2, ROW, ROWX, 16) 00134000 + ELSE 00135000 + BEGIN 00136000 + UPACK(M, 2, ROW, ROWX, 4); 00137000 + ROWX:= ROWX+21; % ROWX=22 00138000 + UPACK(M, 9, ROW, ROWX, 5); 00139000 + ROWX:= ROWX+27; % ROWX=49 00140000 + UPACK(M, 18, ROW, ROWX, 0); 00141000 + IF SHEET ^= 1 THEN 00142000 + BEGIN 00143000 + UPACK(M, 7, ROW, ROWX-33, 1); % ROWX=16 00144000 + ROW[ROWX]:= 0; 00145000 + END 00146000 + ELSE 00147000 + BEGIN 00148000 + ROW[19]:= (M[8] DIV 1000000) MOD 1000; 00150000 + ROWX:= ROWX-9; % ROWX=40 00151000 + UPACK(M, 15, ROW, ROWX, 2); 00152000 + END; 00153000 + END; 00154000 + END UNPACK; 00155000 + 00156000 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00157000 + 00158000 + COMMENT READ DATA FOR SYMPTOM-DISEASE MATRIX.; 00161000 + READ(CARD, /, MATRIX); 00162000 + 00163000 + COMMENT THE PROGRAM BEGINS HERE. THE FIRST TWO INPUT CARDS 00164000 + ARE READ, THE FIRST TWO LINES OF OUTPUT ARE PRINTED, 00165000 + THE NUMBER OF SYMPTOMS ARE CALCULATED, 00166000 + AND THE EQUATION TYPE DETERMINED.; 00167000 + 00168000 + NEWCASE: FOR P:= 1 STEP 1 UNTIL 20 DO 00169000 + SYP[P]:= 0; 00170000 + FOR J:= 1 STEP 1 UNTIL 50 DO 00171000 + TP[J]:= ROW[J]:= 0; 00172000 + FOR J:= 1 STEP 1 UNTIL 50 DO 00173000 + FTROW[J]:= 0.0; 00174000 + 00175000 + CARD1: READ(CARD, /, KASE) [EOF]; 00176000 + WRITE(LINE[SKIP 1]); 00177000 + WRITE(LINE, IDFORM, IDOUT); 00178000 + CARD2: READ(CARD, /, PRESENT); 00179000 + P:= 1; 00180000 + FOR J:= 1 STEP 1 UNTIL 50 DO 00181000 + BEGIN 00182000 + IF SYP[P] = J THEN 00183000 + BEGIN 00184000 + TP[J]:= 1; 00185000 + P:= P+1 00186000 + END; 00187000 + END; 00188000 + 00189000 + TOTP:= P - 1; 00190000 + WRITE(LINE, PFORM, POUT); 00191000 + K:= 1; 00192000 + IF SHEET = 1 THEN 00193000 + BEGIN 00194000 + OUTSHEET:= "W "; 00195000 + GO TO EQTEST 00196000 + END; 00197000 + OUTSHEET:= "B "; 00198000 + 00199000 + EQTEST: IF EQUATION = 10 THEN 00200000 + GO TO EQ10; 00201000 + 00202000 + COMMENT CALCULATE PROBABILITIES USING EQUATION 9.; 00203000 + 00204000 + COMMENT ONE ROW OF THE MATRIX IS UNPACKED AND THE 00205000 + INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED.; 00206000 + 00207000 + XP9: UNPACK(M[K,*], SHEET, XRAY, EQUATION, ROW[*]); 00208000 + FOR J:= 8 STEP 1 UNTIL 16, 24, 25, 00209000 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 00210000 + BEGIN 00211000 + IF TP[J] = 1 THEN 00212000 + ROW[J]:= 1000 - ROW[J] 00213000 + END; 00214000 + 00215000 + COMMENT THE ROW-PRODUCT IS CALCULATED AND ZEROES TESTED FOR.; 00216000 + PYKX[K]:= M[K,1]; 00217000 + FOR P:= 1 STEP 1 UNTIL TOTP DO 00218000 + BEGIN 00219000 + IF ROW[SYP[P]] = 0 THEN 00220000 + BEGIN 00221000 + PYKX[K]:= 0.0; 00222000 + GO TO TAL9 00223000 + END; 00224000 + FTROW[P]:= ROW[SYP[P]] 00225000 + END; 00226000 + 00227000 + FOR P:= 1 STEP 1 UNTIL TOTP DO 00228000 + PYKX[K]:= PYKX[K]*FTROW[P]; 00229000 + 00230000 + TAL9: K:= K+1; 00231000 + IF K <= 33 THEN 00232000 + GO TO XP9; 00233000 + GO TO NORM; 00234000 + 00235000 + 00236000 + COMMENT CALCULATE PROBABILITIES USING EQUATION 10.; 00237000 + 00238000 + EQ10: FOR J:= 1 STEP 1 UNTIL 50 DO 00239000 + TE[J]:= 0; 00240000 + FOR E:= 1 STEP 1 UNTIL 20 DO 00241000 + SYE[E]:= 0; 00242000 + FOR X:= 1 STEP 1 UNTIL 10 DO 00243000 + MX[X]:= 0; 00244000 + FOR X:= 1 STEP 1 UNTIL 10 DO 00245000 + FTMX[X]:= 0.0; 00246000 + 00247000 + COMMENT THE THIRD INPUT CARD IS READ, THE THIRD LINE OF 00248000 + OUTPUT IS PRINTED, AND THE NUMBER OF SYMPTOMS 00249000 + TO BE OMITTED FOR THIS CASE IS CALCULATED.; 00250000 + 00251000 + CARD3: READ(CARD, /, EXCLUDE); 00252000 + E:= 1; 00253000 + FOR J:= 1 STEP 1 UNTIL 50 DO 00254000 + BEGIN 00255000 + IF SYE[E] = J THEN 00256000 + BEGIN 00257000 + TE[J]:= 1; 00258000 + E:= E+1 00259000 + END; 00260000 + END; 00261000 + 00262000 + TOTE:= E-1; 00263000 + WRITE(LINE, EFORM, EOUT); 00264000 + TOTX:= SHEET+8; 00265000 + 00266000 + COMMENT ONE ROW OF THE MATRIX IS UNPACKED, THE 00267000 + INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED, 00268000 + AND THE SYMPTOMS OMITTED FOR THIS CASE DELETED.; 00269000 + 00270000 + XP10: UNPACK(M[K,*], SHEET, XRAY, EQUATION, ROW[*]); 00271000 + FOR J:= 8 STEP 1 UNTIL 15, 24, 25, 00272000 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 00273000 + BEGIN 00274000 + IF TP[J] = 1 THEN 00275000 + ROW[J]:= 1000 - ROW[J]; 00276000 + IF ROW[J] = 0 THEN 00277000 + BEGIN 00278000 + PYKX[K]:= 0.0; 00279000 + GO TO TAL10 00280000 + END; 00281000 + IF TE[J] = 1 THEN 00282000 + ROW[J]:= 0 00283000 + END; 00284000 + 00285000 + COMMENT THE ROW-PRODUCT IS CALCULATED FOR THOSE INDEPENDENT 00286000 + SYMPTOMS COMMON TO BOTH SHEETS, ZERO VALUES TESTED 00287000 + FOR, AND EACH ELEMENT SCALED.; 00288000 + 00289000 + PYKX[K]:= M[K,1]; 00290000 + FOR J:= 8 STEP 1 UNTIL 15, 24, 25, 00291000 + 30 STEP 1 UNTIL 33, 38, 39, 50 DO 00292000 + BEGIN 00293000 + FTROW[J]:= ROW[J]; 00294000 + FTROW[J]:= FTROW[J]/100.0; 00295000 + IF FTROW[J] ^= 0.0 THEN 00296000 + PYKX[K]:= PYKX[K]*FTROW[J] 00297000 + END; 00298000 + 00299000 + 00300000 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 00301000 + EXCLUSIVE SYMPTOM-SETS COMMON TO BOTH BROWN AND 00302000 + WHITE SYMPTOM CHECK SHEETS PER TABLE V.; 00303000 + 00304000 + X1TO3: MX[1]:= ROW[SYP[1]]; 00305000 + X4TO7: IF TE[4] = 1 THEN 00306000 + BEGIN 00307000 + MX[2]:= 100; 00308000 + GO TO X26 00309000 + END; 00310000 + IF SYP[2] <= 7 THEN 00311000 + BEGIN 00312000 + MX[2]:= ROW[SYP[2]]; 00313000 + GO TO X26 00314000 + END; 00315000 + MX[2]:= 1000 - ROW[4] - ROW[5] - ROW[6] - ROW[7]; 00316000 + 00317000 + X26: X:= 3; 00318000 + FOR J:= 26, 28, 34, 36 DO 00319000 + BEGIN 00320000 + IF TE[J] = 1 THEN 00321000 + BEGIN 00322000 + MX[X]:= 100; 00323000 + GO TO LAB5 00324000 + END; 00325000 + IF TP[J] = TP[J+1] THEN 00326000 + BEGIN 00327000 + MX[X]:= 1000 - ROW[J] - ROW[J+1]; 00328000 + GO TO LAB5 00329000 + END; 00330000 + IF TP[J] = 1 THEN 00331000 + BEGIN 00332000 + MX[X]:= ROW[J]; 00333000 + GO TO LAB5 00334000 + END; 00335000 + MX[X]:= ROW[J+1]; 00336000 + LAB5: X:= X+1 00337000 + END; 00338000 + 00339000 + BNORWH: IF SHEET = 1 THEN 00340000 + GO TO WHITE; 00341000 + 00342000 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 00343000 + EXCLUSIVE SYMPTOM-SETS FOR THE BROWN SHEET OPTION.; 00344000 + 00345000 + BROWN: IF TP[16] = 1 THEN 00346000 + ROW[16]:= 1000 - ROW[16]; 00347000 + IF ROW[16] = 0 THEN 00348000 + BEGIN 00349000 + PYKX[K]:= 0.0; 00350000 + GO TO TAL10 00351000 + END; 00352000 + IF TE[16] = 1 THEN 00353000 + BEGIN 00354000 + ROW[16]:= 0; 00355000 + GO TO X17TO19 00356000 + END; 00357000 + 00358000 + BEGIN 00359000 + FTROW[16]:= ROW[16]; 00360000 + PYKX[K]:= PYKX[K]*FTROW[16] / 100.0 00361000 + END; 00362000 + 00363000 + X17TO19: IF TE[17] = 1 THEN 00364000 + BEGIN 00365000 + MX[7]:= 100; 00366000 + GO TO X20 00367000 + END; 00368000 + IF TP[17] = TP[18] AND TP[18] = TP[19] THEN 00369000 + BEGIN 00370000 + MX[7]:= (1000-ROW[17])*(1000-ROW[18])* 00371000 + (1000-ROW[19]); 00372000 + GO TO X20 00373000 + END; 00374000 + IF TP[19] = 1 THEN 00375000 + BEGIN 00376000 + MX[7]:= ROW[19]; 00377000 + GO TO X20 00378000 + END; 00379000 + IF TP[17] = 0 THEN 00380000 + BEGIN 00381000 + MX[7]:= ROW[18]*(1000 - ROW[17]); 00382000 + GO TO X20 00383000 + END; 00384000 + IF TP[18] = 0 THEN 00385000 + BEGIN 00386000 + MX[7]:= ROW[17]*(1000 - ROW[18]); 00387000 + GO TO X20 00388000 + END; 00389000 + MX[7]:= ROW[17]*ROW[18]; 00390000 + 00391000 + X20: IF TE[20] = 1 THEN 00392000 + BEGIN 00393000 + MX[8]:= 100; 00394000 + GO TO FLTMX 00395000 + END; 00396000 + 00397000 + T2021:= (1000 - ROW[20] - ROW[21]); 00398000 + T22:= (1000 - ROW[22]); 00399000 + 00400000 + IF (TP[20] = TP[21]) AND (TP[21] = TP[22]) 00401000 + AND (TP[22] = TP[23]) THEN 00402000 + BEGIN 00403000 + MX[8]:= T2021*T22*(1000 - ROW[23]); 00404000 + GO TO FLTMX 00405000 + END; 00406000 + IF TP[20] = 1 THEN 00407000 + BEGIN 00408000 + IF TP[22] = 1 THEN 00409000 + BEGIN 00410000 + MX[8]:= ROW[20]*ROW[22]; 00411000 + GO TO FLTMX 00412000 + END; 00413000 + MX[8]:= ROW[20]*T22; 00414000 + GO TO FLTMX 00415000 + END; 00416000 + 00417000 + IF TP[21] = 1 THEN 00418000 + BEGIN 00419000 + IF TP[22] = 1 THEN 00420000 + BEGIN 00421000 + MX[8]:= ROW[21]*ROW[22]; 00422000 + GO TO FLTMX 00423000 + END; 00424000 + MX[8]:= ROW[21]*T22; 00425000 + GO TO FLTMX 00426000 + END; 00427000 + IF TP[22] = 1 THEN 00428000 + BEGIN 00429000 + MX[8]:= ROW[22]*T2021; 00430000 + GO TO FLTMX 00431000 + END; 00432000 + MX[8]:= ROW[23]; 00433000 + GO TO FLTMX; 00434000 + 00435000 + COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY 00436000 + EXCLUSIVE SYMPTOM-SETS FOR THE WHITE SHEET OPTION.; 00437000 + 00438000 + WHITE: IF (TE[19] = TE[42])AND (TE[42] = TE[44]) 00439000 + AND (TE[44] = 1)THEN 00440000 + BEGIN 00441000 + MX[7]:= 100; 00442000 + GO TO X40 00443000 + END; 00444000 + 00445000 + T4243:= (1000 - ROW[42] - ROW[43]); 00446000 + T4445:= (1000 - ROW[44] - ROW[45]); 00447000 + 00448000 + IF (TP[19] = TP[42]) AND (TP[42] = TP[43]) 00449000 + AND (TP[43] = TP[44]) AND (TP[44] = TP[45]) THEN 00450000 + BEGIN 00451000 + MX[7]:= (1000 - ROW[19])*T4243*T4445; 00452000 + GO TO X40 00453000 + END; 00454000 + IF TP[19] = 1 THEN 00455000 + BEGIN 00456000 + MX[7]:= ROW[19]; 00457000 + GO TO X40 00458000 + END; 00459000 + IF TP[42] = 1 THEN 00460000 + BEGIN 00461000 + IF TP[44] = 1 THEN 00462000 + BEGIN 00463000 + MX[7]:= ROW[42]*ROW[44]; 00464000 + GO TO X40 00465000 + END; 00466000 + IF TP[45] = 1 THEN 00467000 + BEGIN 00468000 + MX[7]:= ROW[42]*ROW[45]; 00469000 + GO TO X40 00470000 + END; 00471000 + MX[7]:= ROW[42]*T4445; 00472000 + GO TO X40 00473000 + END; 00474000 + 00475000 + IF TP[43] = 1 THEN 00476000 + BEGIN 00477000 + IF TP[44] = 1 THEN 00478000 + BEGIN 00479000 + MX[7]:= ROW[43]*ROW[44]; 00480000 + GO TO X40 00481000 + END; 00482000 + IF TP[45] = 1 THEN 00483000 + BEGIN 00484000 + MX[7]:= ROW[43]*ROW[45]; 00485000 + GO TO X40 00486000 + END; 00487000 + MX[7]:= ROW[43]*T4445; 00488000 + GO TO X40 00489000 + END; 00490000 + 00491000 + IF TP[44] = 1 THEN 00492000 + BEGIN 00493000 + MX[7]:= ROW[44]*T4243; 00494000 + GO TO X40 00495000 + END; 00496000 + MX[7]:= ROW[45]*T4243; 00497000 + 00498000 + X40: IF TE[40] = 1 THEN 00499000 + BEGIN 00500000 + MX[8]:= 100; 00501000 + GO TO X2369 00502000 + END; 00503000 + 00504000 + IF TP[40] = TP[41] THEN 00505000 + BEGIN 00506000 + MX[8]:= 1000 - ROW[40] - ROW[41]; 00507000 + GO TO X2369 00508000 + END; 00509000 + 00510000 + IF TP[40] = 1 THEN 00511000 + BEGIN 00512000 + MX[8]:= ROW[40]; 00513000 + GO TO X2369 00514000 + END; 00515000 + MX[8]:= ROW[41]; 00516000 + 00517000 + X2369: IF (TE[22] = TE[46]) AND (TE[46] = 1) THEN 00518000 + BEGIN 00519000 + MX[9]:= 100; 00520000 + GO TO FLTMX 00521000 + END; 00522000 + 00523000 + T22:= 1000 - ROW[22]; 00524000 + T6789:= 1000 - ROW[46] - ROW[47] - ROW[48] - ROW[49]; 00525000 + 00526000 + IF (TP[22] = TP[23]) AND (TP[23] = TP[46]) 00527000 + AND (TP[46] = TP[47]) AND (TP[47] = TP[48]) 00528000 + AND (TP[48] = TP[49]) THEN 00529000 + BEGIN 00530000 + MX[9]:= T22*(1000 - ROW[23])*T6789; 00531000 + GO TO FLTMX 00532000 + END; 00533000 + 00534000 + IF TP[22] = 1 THEN 00535000 + BEGIN 00536000 + FOR J:= 46 STEP 1 UNTIL 49 DO 00537000 + BEGIN 00538000 + IF TP[J] = 1 THEN 00539000 + BEGIN 00540000 + MX[9]:= ROW[J]*ROW[22]; 00541000 + GO TO FLTMX 00542000 + END; 00543000 + END; 00544000 + MX[9]:= ROW[22]*T6789; 00545000 + GO TO FLTMX 00546000 + END; 00547000 + 00548000 + FOR J:= 46 STEP 1 UNTIL 49 DO 00549000 + BEGIN 00550000 + IF TP[J] = 1 THEN 00551000 + BEGIN 00552000 + MX[9]:= ROW[J]*T22; 00553000 + GO TO FLTMX 00554000 + END; 00555000 + END; 00556000 + 00557000 + MX[9]:= ROW[23]; 00558000 + GO TO FLTMX; 00559000 + 00560000 + FLTMX: FOR X:= 1 STEP 1 UNTIL TOTX DO 00561000 + BEGIN 00562000 + FTMX[X]:= MX[X]; 00563000 + FTMX[X]:= FTMX[X]/100.00 00564000 + END; 00565000 + 00566000 + FOR X:= 1 STEP 1 UNTIL TOTX DO 00567000 + PYKX[K]:= PYKX[K]*FTMX[X]; 00568000 + 00569000 + COMMENT AT THIS POINT, THE ROW-PRODUCT HAS BEEN COMPUTED 00570000 + AND A TEST IS MADE TO DETERMINE WHETHER THERE 00571000 + ARE MORE ROWS YET TO BE PROCESSED, OR TO PRINT-OUT.; 00572000 + 00573000 + TAL10: K:= K+1; 00574000 + IF K <= 33 THEN 00575000 + GO TO XP10; 00576000 + GO TO NORM; 00577000 + 00578000 + COMMENT THE ROW-PROBABILITIES ARE FIRST NORMALIZED TO GIVE A 00579000 + TRUE PERCENTAGE FIGURE AND LINES 4 - 6 ARE PRINTED.; 00580000 + 00581000 + NORM: SUM:= 0.0; 00582000 + WRITE(LINE, SHFORM, SHOUT); 00583000 + FOR K:= 1 STEP 1 UNTIL 33 DO 00584000 + SUM:= SUM + PYKX[K]; 00585000 + WRITE(LINE, EQFORM, EQOUT); 00586000 + FOR K:= 1 STEP 1 UNTIL 33 DO 00587000 + PYX[K]:= PYKX[K] / SUM; 00588000 + 00589000 + WRITE(LINE, HEAD); 00590000 + 00591000 + COMMENT THE PROBABILITIES ARE NOW PRINTED WHICH ARE ONE 00592000 + PERCENT OR GREATER TOGETHER WITH DISEASE I. D. .; 00593000 + 00594000 + K:= 1; 00595000 + PRINT: IF PYX[K] < 0.01 THEN 00596000 + GO TO TALPT; 00597000 + 00598000 + GO TO SWOUT[K]; 00599000 + Y01: WRITE(LINE, FORM1, ANS); 00600000 + GO TO TALPT; 00601000 + Y02: WRITE(LINE, FORM2, ANS); 00602000 + GO TO TALPT; 00603000 + Y03: WRITE(LINE, FORM3, ANS); 00604000 + GO TO TALPT; 00605000 + Y04: WRITE(LINE, FORM4, ANS); 00606000 + GO TO TALPT; 00607000 + Y05: WRITE(LINE, FORM5, ANS); 00608000 + GO TO TALPT; 00609000 + Y06: WRITE(LINE, FORM6, ANS); 00610000 + GO TO TALPT; 00611000 + Y07: WRITE(LINE, FORM7, ANS); 00612000 + GO TO TALPT; 00613000 + Y08: WRITE(LINE, FORM8, ANS); 00614000 + GO TO TALPT; 00615000 + Y09: WRITE(LINE, FORM9, ANS); 00616000 + GO TO TALPT; 00617000 + Y10: WRITE(LINE, FORM10, ANS); 00618000 + GO TO TALPT; 00619000 + Y11: WRITE(LINE, FORM11, ANS); 00620000 + GO TO TALPT; 00621000 + Y12: WRITE(LINE, FORM12, ANS); 00622000 + GO TO TALPT; 00623000 + Y13: WRITE(LINE, FORM13, ANS); 00624000 + GO TO TALPT; 00625000 + Y14: WRITE(LINE, FORM14, ANS); 00626000 + GO TO TALPT; 00627000 + Y15: WRITE(LINE, FORM15, ANS); 00628000 + GO TO TALPT; 00629000 + Y16: WRITE(LINE, FORM16, ANS); 00630000 + GO TO TALPT; 00631000 + Y17: WRITE(LINE, FORM17, ANS); 00632000 + GO TO TALPT; 00633000 + Y18: WRITE(LINE, FORM18, ANS); 00634000 + GO TO TALPT; 00635000 + Y19: WRITE(LINE, FORM19, ANS); 00636000 + GO TO TALPT; 00637000 + Y20: WRITE(LINE, FORM20, ANS); 00638000 + GO TO TALPT; 00639000 + Y21: WRITE(LINE, FORM21, ANS); 00640000 + GO TO TALPT; 00641000 + Y22: WRITE(LINE, FORM22, ANS); 00642000 + GO TO TALPT; 00643000 + Y23: WRITE(LINE, FORM23, ANS); 00644000 + GO TO TALPT; 00645000 + Y24: WRITE(LINE, FORM24, ANS); 00646000 + GO TO TALPT; 00647000 + Y25: WRITE(LINE, FORM25, ANS); 00648000 + GO TO TALPT; 00649000 + Y26: WRITE(LINE, FORM26, ANS); 00650000 + GO TO TALPT; 00651000 + Y27: WRITE(LINE, FORM27, ANS); 00652000 + GO TO TALPT; 00653000 + Y28: WRITE(LINE, FORM28, ANS); 00654000 + GO TO TALPT; 00655000 + Y29: WRITE(LINE, FORM29, ANS); 00656000 + GO TO TALPT; 00657000 + Y30: WRITE(LINE, FORM30, ANS); 00658000 + GO TO TALPT; 00659000 + Y31: WRITE(LINE, FORM31, ANS); 00660000 + GO TO TALPT; 00661000 + Y32: WRITE(LINE, FORM32, ANS); 00662000 + GO TO TALPT; 00663000 + Y33: WRITE(LINE, FORM33, ANS); 00664000 + GO TO TALPT; 00665000 + 00666000 + TALPT: K:= K+1; 00667000 + IF K <= 33 THEN 00668000 + GO TO PRINT; 00669000 + 00670000 + COMMENT PROGRAM REPEATS TO BEGINNING IF THERE ARE MORE 00671000 + CASES TO BE RUN, AND HALTS IF NOT. THE INITIALS 00672000 + H W APPEAR IN THE A-REG. UPON COMPLETION.; 00673000 + 00674000 + IF LAST = 0 THEN 00675000 + GO TO NEWCASE; 00676000 + COMMENT STOP 7270061216; 00677000 + COMMENT GO TO NEWCASE; 00678000 + EOF: 00679000 + END. 00680000 +?DATA CARD 00681000 + 100, /ROW 01@1 00682000 + 010490500,010000010,000990990,900970950,950970950,990700020,/ROW 01@2 00683000 + 070000800,010050990,999010010,150050900,970990990,010020020,/ROW 01@3 00684000 + 020980980,010000020,700040030,000000800,050900000, /ROW 01@4 00685000 + 081, /ROW 02@1 00686000 + 100500500,020010020,000990650,500950980,600990980,980300200,/ROW 02@2 00687000 + 020050900,020020990,990010010,600010200,990990990,700050050,/ROW 02@3 00688000 + 850980980,010020010,300020200,050010900,010400000, /ROW 02@4 00689000 + 005, /ROW 03@1 00690000 + 300600100,200100200,000990400,300950980,900900980,980050050,/ROW 03@2 00691000 + 020570400,010030990,990010020,300150600,990950990,850020200,/ROW 03@3 00692000 + 700980980,010010010,050010050,600010380,010300000, /ROW 03@4 00693000 + 001, /ROW 04@1 00694000 + 100200700,300100250,000990200,100950950,850900980,980150200,/ROW 04@2 00695000 + 020050400,200010990,990010010,950010500,990950990,850050200,/ROW 04@3 00696000 + 700980980,010020010,150200020,050010400,010600000, /ROW 04@4 00697000 + 027, /ROW 05@1 00698000 + 200500300,150050100,000990600,500950950,700950400,850900400,/ROW 05@2 00699000 + 020100200,100010990,990010010,700020600,900900990,050700050,/ROW 05@3 00700000 + 850980980,150010850,050020200,020200200,200200000, /ROW 05@4 00701000 + 005, /ROW 06@1 00702000 + 100400500,010010010,000990850,800990950,950990980,980020020,/ROW 06@2 00703000 + 020020600,050050990,990100150,400020900,990990990,150020020,/ROW 06@3 00704000 + 150980980,020020020,200020020,020020600,020700000, /ROW 06@4 00705000 + 001, /ROW 07@1 00706000 + 200700100,650100050,000990300,200950950,800950980,980100150,/ROW 07@2 00707000 + 100050750,050200990,990100150,850020200,990990990,900020250,/ROW 07@3 00708000 + 750980980,020020300,100010300,050010800,020300000, /ROW 07@4 00709000 + 018, /ROW 08@1 00710000 + 500480020,300650010,000900200,100800950,850900980,950650050,/ROW 08@2 00711000 + 050200200,020050990,990010010,020600990,800700990,020900020,/ROW 08@3 00712000 + 020100900,050020500,150050020,200200200,200500000, /ROW 08@4 00713000 + 001, /ROW 09@1 00714000 + 100450450,220440010,000780200,200900700,850780950,750950250,/ROW 09@2 00715000 + 050050150,020050990,990010010,020350900,800900990,100200020,/ROW 09@3 00716000 + 600980980,250250450,450250250,150150050,050500000, /ROW 09@4 00717000 + 054, /ROW 10@1 00718000 + 400550050,250250100,000700250,100950950,900800980,980200020,/ROW 10@2 00719000 + 050650250,020050980,980100150,100600800,990980990,950020850,/ROW 10@3 00720000 + 100980980,020020200,050020020,600050250,050100000, /ROW 10@4 00721000 + 063, /ROW 11@1 00722000 + 400550050,300300100,000600250,100950950,900750980,980200020,/ROW 11@2 00723000 + 050650250,020050980,980100150,100600800,990980990,950020850,/ROW 11@3 00724000 + 100980980,020020200,050020020,600050250,050100000, /ROW 11@4 00725000 + 045, /ROW 12@1 00726000 + 200700100,010010010,000990500,350990990,990900980,980100020,/ROW 12@2 00727000 + 050700200,020100980,980010010,100600800,990950990,950020850,/ROW 12@3 00728000 + 100980980,010010010,100020020,680010250,010200000, /ROW 12@4 00729000 + 013, /ROW 13@1 00730000 + 200700100,010010010,000990500,350990990,990900980,980100020,/ROW 13@2 00731000 + 020700200,020020980,980010010,100600800,990950990,950020850,/ROW 13@3 00732000 + 100980980,010010010,100010010,680010250,010200000, /ROW 13@4 00733000 + 014, /ROW 14@1 00734000 + 900090010,100900000,000200100,010950000,950650980,980400050,/ROW 14@2 00735000 + 050010020,020050980,980100100,010900800,990980990,950020850,/ROW 14@3 00736000 + 100980980,020010300,400020050,010010020,020800000, /ROW 14@4 00737000 + 001, /ROW 15@1 00738000 + 050450500,010010010,000990990,990990990,990990960,990020010,/ROW 15@2 00739000 + 010020250,020010800,980500050,100020900,990990990,100020100,/ROW 15@3 00740000 + 020980980,010010020,020010000,020010250,020400000, /ROW 15@4 00741000 + 013, /ROW 16@1 00742000 + 100450450,010010010,000990300,050600900,900900990,990300050,/ROW 16@2 00743000 + 010010050,300020980,980020020,950000700,990900990,950020900,/ROW 16@3 00744000 + 050980980,010010010,300150050,020020050,020800000, /ROW 16@4 00745000 + 001, /ROW 17@1 00746000 + 300600100,050010010,000990900,000950990,900990950,900200050,/ROW 17@2 00747000 + 600010100,050200980,980020020,700010800,600990990,010150020,/ROW 17@3 00748000 + 020400950,100020100,200050020,020020100,050250000, /ROW 17@4 00749000 + 072, /ROW 18@1 00750000 + 200400400,010010010,000990800,800900990,900950950,850100020,/ROW 18@2 00751000 + 500020130,050850980,980030050,500010800,600980990,010100020,/ROW 18@3 00752000 + 020500950,100020050,100020020,050020200,100150000, /ROW 18@4 00753000 + 002, /ROW 19@4 00754000 + 200300500,450450010,000990900,800950990,990900950,980100020,/ROW 19@2 00755000 + 200020100,020050990,990050700,050050800,990990990,050050020,/ROW 19@3 00756000 + 020980980,020020100,100020020,020020100,100700000, /ROW 19@4 00757000 + 008, /ROW 20@1 00758000 + 200500300,010010010,000990500,500600950,900900200,800100100,/ROW 20@2 00759000 + 020050100,020020980,980010010,500010800,950980990,500020100,/ROW 20@3 00760000 + 400980980,200200100,100100100,050050100,100300000, /ROW 20@4 00761000 + 013, /ROW 21@1 00762000 + 700290010,010010010,000990600,500800990,950950850,980050020,/ROW 21@2 00763000 + 020020050,020020900,980010010,200020900,500980990,050100050,/ROW 21@3 00764000 + 050600100,020020100,100020020,020020050,050900000, /ROW 21@4 00765000 + 001, /ROW 22@1 00766000 + 700290010,010010010,000990700,700700200,850800950,990010010,/ROW 22@2 00767000 + 010010010,010010990,990010010,200020990,950990990,050100050,/ROW 22@3 00768000 + 050800100,010010010,010010010,010010010,010900000, /ROW 22@4 00769000 + 036, /ROW 23@1 00770000 + 100800100,010010010,000990800,700800850,990650800,980200100,/ROW 23@2 00771000 + 020050050,010010050,950010010,200100990,600990950,050150020,/ROW 23@3 00772000 + 020300850,020020020,200100020,050010050,010100000, /ROW 23@4 00773000 + 009, /ROW 24@1 00774000 + 100800100,010010010,000990800,700800850,990650800,980200100,/ROW 24@2 00775000 + 020050050,010010050,950010010,200100990,600990950,050150020,/ROW 24@3 00776000 + 020300850,020020020,200100020,050010050,010100000, /ROW 24@4 00777000 + 054, /ROW 25@1 00778000 + 100700200,010010010,000990800,700800990,990950950,990200100,/ROW 25@2 00779000 + 020020100,010050850,900800150,100100990,700990010,050050020,/ROW 25@3 00780000 + 020600960,010010050,200100020,020020100,050350000, /ROW 25@4 00781000 + 005, /ROW 26@1 00782000 + 500400100,300600010,000850850,700950990,800900980,980700020,/ROW 26@2 00783000 + 020100100,020020980,980050100,400100700,950990990,300100400,/ROW 26@3 00784000 + 100800950,020020400,400020020,100100100,100600000, /ROW 26@4 00785000 + 063, /ROW 27@1 00786000 + 900100000,200600050,100950400,300800990,950900950,980500020,/ROW 27@2 00787000 + 020030100,020020950,980010010,200100800,800980980,400200300,/ROW 27@3 00788000 + 050800950,020020300,300020020,030030100,100500000, /ROW 27@4 00789000 + 001, /ROW 28@1 00790000 + 300300300,300050100,000990900,800990990,990990950,980700020,/ROW 28@2 00791000 + 020050300,020020950,980010010,200100900,900990990,200100100,/ROW 28@3 00792000 + 100900900,020020300,300020020,050050300,300400000, /ROW 28@4 00793000 + 001, /ROW 29@1 00794000 + 600390010,010010010,800700900,500950800,990800950,980500020,/ROW 29@2 00795000 + 020100300,020020950,980010010,900020600,950990900,700050800,/ROW 29@3 00796000 + 050900950,020020300,300020020,100100300,300800000, /ROW 29@4 00797000 + 252, /ROW 30@1 00798000 + 150700150,010010010,000990800,700950990,850950950,800950050,/ROW 30@2 00799000 + 020100100,050010980,950010010,300020950,700990990,300100050,/ROW 30@3 00800000 + 050850950,200020920,050050010,010100010,100150000, /ROW 30@4 00801000 + 081, /ROW 31@1 00802000 + 300600100,300500100,000950400,300800900,800900950,990500100,/ROW 31@2 00803000 + 020050050,250010980,950010010,900020700,950950990,700050750,/ROW 31@3 00804000 + 150900950,010010300,300100020,010050010,050500000, /ROW 31@4 00805000 + 005, /ROW 32@1 00806000 + 300400300,010010050,500990800,700900990,900950980,980100100,/ROW 32@2 00807000 + 020020200,100020980,980020020,900020700,950950990,700050750,/ROW 32@3 00808000 + 150900950,020020100,100020020,020020200,200800000, /ROW 32@4 00809000 + 009, /ROW 33@1 00810000 + 400550050,500200100,000990200,100800990,700950950,900700050,/ROW 33@2 00811000 + 020100300,100020980,990010010,300100990,800700990,020900020,/ROW 33@3 00812000 + 020100900,100020300,300050050,100100300,300500000, /ROW 33@4 00813000 + 0967,"LDR",01,00,10,05,11,61,00, /CASE IDENTIFICATION 00814000 + 03,10,29,34,36,43,48,50,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT 00815000 + 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS OMITTED 00816000 + 0967,"LDR",01,00,10,05,11,61,00, /CASE IDENTIFICATION 00817000 + 03,10,29,34,36,43,48,50,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT 00818000 + 11,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS OMITTED 00819000 + 0967,"LDR",01,00,09,05,11,61,00, /CASE IDENTIFICATION 00820000 + 03,10,29,34,36,43,48,50,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT 00821000 + 0967,"LDR",00,00,10,05,11,61,00, /CASE IDENTIFICATION 00822000 + 03,10,17,21,29,34,36,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT 00823000 + 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS OMITTED 00824000 + 0967,"LDR",00,00,10,05,11,61,00, /CASE IDENTIFICATION 00825000 + 03,10,17,21,29,34,36,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT 00826000 + 11,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS OMITTED 00827000 + 0967,"LDR",00,00,09,05,11,61,00, /CASE IDENTIFICATION 00828000 + 03,10,17,21,29,34,36,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT 00829000 + 0967,"LDR",00,00,09,05,11,61,01, /CASE IDENTIFICATION 00830000 + 03,10,17,21,29,34,36,00,00,00,00,00,00,00,00,00,00,00,00,00,/SYMPTOMS PRESENT 00831000 +?END JOB 00832000 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-Code.lst b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-Code.lst new file mode 100644 index 0000000..ce1d2a5 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-Code.lst @@ -0,0 +1,4175 @@ +0200 BAC-220 STANDARD VERSION 2/1/62 + +0200 COMMENT CONGENITAL HEART DISEASE DIAGNOSIS PROGRAM. CHDD0001 + +0200 FROM A SET OF CLINICAL SYMPTOMS, THE PROBABILITIES CHDD0002 + +0200 FOR EACH OF THE 33 CONGENITAL HEART DISEASES BEING CHDD0003 + +0200 PRESENT IN THE PATIENT UNDER CONSIDERATION IS CHDD0004 + +0200 CALCULATED AND THOSE GREATER THAN ONE PERCENT CHDD0005 + +0200 ARE PRINTED OUT TOGETHER WITH DISEASE IDENTIFICATION CHDD0006 + +0200 AND CASE INFORMATION. CHDD0007 + +0200 + +0200 FRED B FIELDING CHDD0008 + +0200 SAN FRANCISCO DISTRICT OFFICE CHDD0009 + +0200 + +0200 CARD SEQUENCE CODE FOR THE PROGRAM STARTS WITH CHDD0010 + +0200 CHDD0001 AND ROW 01-1 FOR SYMPTOM-DISEASE MATRIX. CHDD0011 + +0200 FIRST RELEASE 05 - 31 - 61 $CHDD0012 + +0200 + +0200 + +0200 INTEGER CASENO , CASEIN , SHEET , XRAY , EQUATION , CHDD0013 + +0200 MO , DAY , YEAR , LAST , CHDD0014 + +0200 E , J , K , P , X , CHDD0015 + +0200 TOTE , TOTP , TOTX , OUTSHEET , CHDD0016 + +0200 T22 , T2021 , T4243 , T4445 , T6789 , CHDD0017 + +0200 ( SYE() , SYP() ) , ( TE() , TP() ) , CHDD0018 + +0200 ROW () , MX () , M (,) $ CHDD0019 + +0200 REAL SUM , FTROW () , FTMX () , PYKX () , PYX () $ CHDD0020 + +0200 + +0200 ARRAY ( SYE(20) , SYP(20) ) , ( TE(50) , TP(50) ) , CHDD0021 + +0200 ( ROW(51) , FTROW(50) ) , ( MX(10) , FTMX(10) ) , CHDD0022 + +0200 PYKX (33) , PYX (33) , M (33,18) $ CHDD0023 + +0200 + +0200 EXTERNAL PROCEDURE UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $CHDD0024 + +0200 + +0200 COMMENT READ DATA FOR SYMPTOM-DISEASE MATRIX. $CHDD0025 + 0200 0 0000 30 + 0201 0 0000 30 + 0202 0 0000 10 9078 CONST + 0203 0 0000 40 9077 K + 0204 0 0000 44 + 0205 0 0000 30 + 0206 0 0000 10 9078 CONST + 0207 0 0000 12 9077 K + 0208 0 0000 40 9077 K + 0205 0209 + 0209 0 0000 13 9076 CONST + 0210 0 1111 31 0212 + 0211 0 0000 36 + 0212 0 0001 33 + 0213 0 0000 30 + 0212 0214 + 0211 0214 + 0214 0 0000 10 9078 CONST + 0215 0 0000 40 9075 J + 0216 0 0000 44 + 0217 0 0000 30 + 0218 0 0000 10 9078 CONST + 0219 0 0000 12 9075 J + 0220 0 0000 40 9075 J + 0217 0221 + 0221 0 0000 13 9074 CONST + 0222 0 1111 31 0224 + 0223 0 0000 36 + 0224 0 0001 33 + 0225 0 0000 30 + 0224 0226 + 0223 0226 + 0226 0 0000 10 9077 K + 0227 0 0000 14 9074 CONST + 0228 0 0001 49 0010 + 0229 0 0000 12 9075 J + 0230 0 0000 40 9073 TEMP + 0231 0 0100 42 0231 + 0232 0 0002 20 0201 + 0233 0 0000 42 9073 TEMP + 0234 1 0000 40 9060 M + 0225 0236 + 0216 0235 + 0235 0 0000 30 + 0213 0237 + 0204 0236 + 0236 0 0000 30 + +0202 INPUT MATRIX(FOR K=(1,1,33) $ FOR J=(1,1,18) $ M(K,J) ) $CHDD0026 + 0237 0 0009 43 0000 + 0238 0 0000 30 0201 + 0200 0239 + +0239 READ ( $ $ MATRIX ) $ CHDD0027 + +0239 + 0239 0 0000 10 0240 + 0240 0 0000 01 0201 MATRI + 0241 0 0000 44 8934 READ + 0242 0 0000 30 8934 + +0243 COMMENT THE PROGRAM BEGINS HERE. THE FIRST TWO INPUT CARDS CHDD0028 + +0243 ARE READ, THE FIRST TWO LINES OF OUTPUT ARE PRINTED, CHDD0029 + +0243 THE NUMBER OF SYMPTOMS ARE CALCULATED, CHDD0030 + +0243 AND THE EQUATION TYPE DETERMINED. $ CHDD0031 + +0243 + 0243 0 0000 10 9078 CONST + 0244 0 0000 40 8933 P + 0245 0 0000 44 + 0246 0 0000 30 + 0247 0 0000 10 9078 CONST + 0248 0 0000 12 8933 P + 0249 0 0000 40 8933 P + 0246 0250 + 0250 0 0000 13 8932 CONST + 0251 0 1111 31 0253 + 0252 0 0000 36 + 0253 0 0001 33 + 0254 0 0000 30 + 0253 0255 + 0252 0255 + +0243 NEWCASE.. FOR P = (1,1,20) $ SYP (P) = 0 $ CHDD0032 + 0255 0 0000 42 8933 P + 0256 1 0000 46 9959 SYP + 0254 0258 + 0245 0257 + 0257 0 0000 30 + 0258 0 0000 10 9078 CONST + 0259 0 0000 40 9075 J + 0260 0 0000 44 + 0261 0 0000 30 + 0262 0 0000 10 9078 CONST + 0263 0 0000 12 9075 J + 0264 0 0000 40 9075 J + 0261 0265 + 0265 0 0000 13 8931 CONST + 0266 0 1111 31 0268 + 0267 0 0000 36 + 0268 0 0001 33 + 0269 0 0000 30 + 0268 0270 + 0267 0270 + +0258 FOR J = (1,1,50) $ TP (J) = ROW (J) = 0 $ CHDD0033 + 0270 0 0000 42 9075 J + 0271 1 0000 46 9808 ROW + 0272 1 0000 46 9859 TP + 0269 0274 + 0260 0273 + 0273 0 0000 30 + 0274 0 0000 10 9078 CONST + 0275 0 0000 40 9075 J + 0276 0 0000 44 + 0277 0 0000 30 + 0278 0 0000 10 9078 CONST + 0279 0 0000 12 9075 J + 0280 0 0000 40 9075 J + 0277 0281 + 0281 0 0000 13 8931 CONST + 0282 0 1111 31 0284 + 0283 0 0000 36 + 0284 0 0001 33 + 0285 0 0000 30 + 0284 0286 + 0283 0286 + +0274 FOR J = (1,1,50) $ FTROW (J) = 0.0 $ CHDD0034 + 0286 0 0000 42 9075 J + 0287 1 0000 46 9758 FTROW + 0285 0289 + 0276 0288 + 0288 0 0000 30 + 0289 0 0000 30 + 0290 0 0000 30 + 0291 0 0100 42 0291 + 0292 0 0002 20 0290 + 0293 0 0000 40 8930 CASEN + 0294 0 0100 42 0294 + 0295 0 0002 20 0290 + 0296 0 0000 40 8929 CASEI + 0297 0 0100 42 0297 + 0298 0 0002 20 0290 + 0299 0 0000 40 8928 SHEET + 0300 0 0100 42 0300 + 0301 0 0002 20 0290 + 0302 0 0000 40 8927 XRAY + +0289 INPUT CASE (CASENO,CASEIN,SHEET,XRAY,EQUATION, CHDD0035 + 0303 0 0100 42 0303 + 0304 0 0002 20 0290 + 0305 0 0000 40 8926 EQUAT + 0306 0 0100 42 0306 + 0307 0 0002 20 0290 + 0308 0 0000 40 8925 MO + 0309 0 0100 42 0309 + 0310 0 0002 20 0290 + 0311 0 0000 40 8924 DAY + 0312 0 0100 42 0312 + 0313 0 0002 20 0290 + 0314 0 0000 40 8923 YEAR + +0306 MO,DAY,YEAR,LAST ) $ CHDD0036 + 0315 0 0100 42 0315 + 0316 0 0002 20 0290 + 0317 0 0000 40 8922 LAST + 0318 0 0009 43 0000 + 0319 0 0000 30 0290 + 0289 0320 + +0320 CARD1.. READ ( $ $ CASE ) $ CHDD0037 + 0320 0 0000 10 0321 + 0321 0 0000 01 0290 CASE + 0322 0 0000 44 8934 READ + 0323 0 0000 30 8934 + 0324 0 0000 30 + 0325 0 0000 30 + 0326 0 0000 10 8930 CASEN + 0327 0 0100 42 0327 + 0328 0 0002 20 0325 + 0329 0 0000 10 8929 CASEI + 0330 0 0100 42 0330 + 0331 0 0002 20 0325 + 0332 0 0000 10 8925 MO + 0333 0 0100 42 0333 + 0334 0 0002 20 0325 + 0335 0 0000 10 8924 DAY + 0336 0 0100 42 0336 + 0337 0 0002 20 0325 + +0324 OUTPUT IDOUT ( CASENO , CASEIN , MO , DAY , YEAR ) $ CHDD0038 + 0338 0 0000 10 8923 YEAR + 0339 0 0100 42 0339 + 0340 0 0002 20 0325 + 0341 0 0009 43 0000 + 0342 0 0000 30 0325 + 0324 0343 + 0343 0 0000 30 + 0344 0 0004 20 0500 + 0345 2 4341 62 4500 + 0346 2 5564 54 4245 + 0347 3 5914 00 0000 + 0348 0 0004 90 0700 + 0349 0 0004 20 0500 + +0343 FORMAT IDFORM (B5,*CASE NUMBER*,I7,B5, CHDD0039 + 0350 2 5741 63 4945 + 0351 3 5563 14 0000 + 0352 0 0004 20 0200 + 0353 0 0004 10 0300 + 0354 0 0004 20 0500 + 0355 3 4441 63 4514 + 0356 0 0004 20 0100 + 0357 0 0004 90 0300 + 0358 1 0000 03 0357 + 0359 0 0006 60 0300 + 0360 1 0000 00 0344 + +0343 *PATIENT*,B2,A3,B5,*DATE*,B1,3(I3),W3 ) $ CHDD0040 + 0343 0361 + 0361 0 0000 10 0362 + 0362 0 0000 01 0325 IDOUT + 0363 0 4400 28 8682 + 0364 1 0000 40 0000 + +0361 WRITE ( $ $ IDOUT , IDFORM) $ CHDD0041 + 0365 0 0000 10 0366 + 0366 0 0000 01 0344 IDFOR + 0367 0 0000 44 8682 WRITE + 0368 0 0100 30 8682 + 0369 0 0000 30 + 0370 0 0000 30 + 0371 0 0000 10 9078 CONST + 0372 0 0000 40 8933 P + 0373 0 0000 44 + 0374 0 0000 30 + 0375 0 0000 10 9078 CONST + 0376 0 0000 12 8933 P + 0377 0 0000 40 8933 P + 0374 0378 + 0378 0 0000 13 8932 CONST + 0379 0 1111 31 0381 + 0380 0 0000 36 + 0381 0 0001 33 + 0382 0 0000 30 + 0381 0383 + 0380 0383 + 0383 0 0100 42 0383 + 0384 0 0002 20 0370 + 0385 0 0000 42 8933 P + 0386 1 0000 40 9959 SYP + 0382 0388 + 0373 0387 + 0387 0 0000 30 + +0369 INPUT PRESENT ( FOR P = (1,1,20) $ SYP (P) ) $ CHDD0042 + 0388 0 0009 43 0000 + 0389 0 0000 30 0370 + 0369 0390 + +0390 CARD2.. READ ( $ $ PRESENT ) $ CHDD0043 + 0390 0 0000 10 0391 + 0391 0 0000 01 0370 PRESE + 0392 0 0000 44 8934 READ + 0393 0 0000 30 8934 + +0394 P = 1 $ CHDD0044 + 0394 0 0000 10 9078 CONST + 0395 0 0000 40 8933 P + 0396 0 0000 10 9078 CONST + 0397 0 0000 40 9075 J + 0398 0 0000 44 + 0399 0 0000 30 + 0400 0 0000 10 9078 CONST + 0401 0 0000 12 9075 J + 0402 0 0000 40 9075 J + 0399 0403 + 0403 0 0000 13 8931 CONST + 0404 0 1111 31 0406 + 0405 0 0000 36 + 0406 0 0001 33 + +0396 FOR J = (1,1,50) $ CHDD0045 + 0407 0 0000 30 + 0406 0408 + 0405 0408 + +0407 BEGIN CHDD0046 + +0407 IF SYP (P) EQL J $ CHDD0047 + 0408 0 0000 42 8933 P + 0409 1 0000 10 9959 SYP + 0410 0 0000 13 9075 J + 0411 0 1111 31 0413 + 0412 0 0000 36 0414 + 0413 0 0000 30 + 0414 0 0000 10 9078 CONST + 0415 0 0000 42 9075 J + 0416 1 0000 40 9859 TP + +0417 ( TP (J) = 1 $ P = P+1 ) CHDD0048 + 0417 0 0000 10 9078 CONST + 0418 0 0000 12 8933 P + 0419 0 0000 40 8933 P + 0413 0420 + +0420 END $ CHDD0049 + 0407 0421 + 0398 0420 + 0420 0 0000 30 + +0421 TOTP = P - 1 $ CHDD0050 + 0421 0 0000 10 8933 P + 0422 0 0000 13 9078 CONST + 0423 0 0000 40 8681 TOTP + 0424 0 0000 30 + 0425 0 0000 30 + 0426 0 0000 10 9078 CONST + 0427 0 0000 40 8933 P + 0428 0 0000 44 + 0429 0 0000 30 + 0430 0 0000 10 9078 CONST + 0431 0 0000 12 8933 P + 0432 0 0000 40 8933 P + 0429 0433 + 0433 0 0000 13 8681 TOTP + 0434 0 1111 31 0436 + 0435 0 0000 36 + 0436 0 0001 33 + 0437 0 0000 30 + 0436 0438 + 0435 0438 + 0438 0 0000 42 8933 P + 0439 1 0000 10 9959 SYP + 0440 0 0100 42 0440 + 0441 0 0002 20 0425 + 0437 0443 + 0428 0442 + 0442 0 0000 30 + +0424 OUTPUT POUT ( FOR P = (1,1,TOTP) $ SYP (P) ) $ CHDD0051 + 0443 0 0009 43 0000 + 0444 0 0000 30 0425 + 0424 0445 + 0445 0 0000 30 + 0446 0 0004 20 0500 + 0447 2 6268 54 5763 + 0448 2 5654 62 0057 + 0449 2 5945 62 4555 + 0450 3 6314 00 0000 + 0451 0 0004 20 0400 + 0452 0 0004 90 0400 + 0453 1 0000 20 0452 + 0454 0 0006 60 0400 + 0455 1 0000 00 0446 + +0445 FORMAT PFORM (B5,*SYMPTOMS PRESENT*,B4,20(I4),W4) $ CHDD0052 + 0445 0456 + 0456 0 0000 10 0457 + 0457 0 0000 01 0425 POUT + 0458 0 4400 28 8682 + 0459 1 0000 40 0000 + +0456 WRITE ( $ $ POUT , PFORM ) $ CHDD0053 + 0460 0 0000 10 0461 + 0461 0 0000 01 0446 PFORM + 0462 0 0000 44 8682 WRITE + 0463 0 0100 30 8682 + +0464 K = 1 $ CHDD0054 + 0464 0 0000 10 9078 CONST + 0465 0 0000 40 9077 K + +0466 IF SHEET EQL 1 $ CHDD0055 + 0466 0 0000 10 8928 SHEET + 0467 0 0000 13 9078 CONST + 0468 0 1111 31 0470 + 0469 0 0000 36 0471 + 0470 0 0000 30 + 0471 0 0000 10 8680 CONST + 0472 0 0000 40 8679 OUTSH + 0473 0 0000 30 0000 EQTES + +0473 ( OUTSHEET = 6600000000 $ GO TO EQTEST ) $ CHDD0056 + 0470 0474 + +0474 OUTSHEET = 4200000000 $ CHDD0057 + 0474 0 0000 10 8678 CONST + 0475 0 0000 40 8679 OUTSH + 0473 0476 + 0476 0 0000 10 8926 EQUAT + 0477 0 0000 13 8677 CONST + 0478 0 1111 31 0480 + 0479 0 0000 36 0481 + 0480 0 0000 30 + +0476 EQTEST.. IF EQUATION EQL 10 $ GO TO EQ10 $ CHDD0058 + +0476 + 0481 0 0000 30 0000 EQ10 + 0480 0482 + +0482 COMMENT CALCULATE PROBABILITIES USING EQUATION 9. $ CHDD0059 + +0482 + +0482 + +0482 COMMENT ONE ROW OF THE MATRIX IS UNPACKED AND THE CHDD0060 + +0482 INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED. $CHDD0061 + +0482 + 0482 0 0000 10 9077 K + 0483 0 0000 14 9074 CONST + 0484 0 0001 49 0010 + 0485 0 0000 12 0486 + 0486 0 0000 01 9060 M + 0487 0 4400 28 0000 + 0488 1 0000 40 0000 + 0489 0 0000 10 9078 CONST + 0490 1 0000 40 9999 + 0491 0 0000 10 8928 SHEET + 0492 1 0000 40 9998 + 0493 0 0000 10 8927 XRAY + 0494 1 0000 40 9997 + 0495 0 0000 10 8926 EQUAT + 0496 1 0000 40 9996 + 0497 0 0000 10 0498 + 0498 0 0000 01 9808 ROW + 0499 1 0000 40 9995 + +0482 XP9.. UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $ CHDD0062 + 0500 0 0000 10 9078 CONST + 0501 0 0000 44 0000 UNPAC + 0502 0 0600 30 0000 + 0503 0 0000 10 8676 CONST + 0504 0 0000 40 9075 J + 0505 0 0000 44 + 0506 0 0000 30 + 0507 0 0000 10 9078 CONST + 0508 0 0000 12 9075 J + 0509 0 0000 40 9075 J + 0506 0510 + 0510 0 0000 13 8675 CONST + 0511 0 1111 31 0513 + 0512 0 0000 36 + 0513 0 0001 33 + 0514 0 0000 10 8674 CONST + 0515 0 0000 40 9075 J + 0516 0 0000 44 + 0517 0 0000 30 + 0518 0 0000 10 8673 CONST + 0519 0 0000 40 9075 J + 0520 0 0000 44 + 0521 0 0000 30 + 0522 0 0000 10 8672 CONST + 0523 0 0000 40 9075 J + 0524 0 0000 44 + 0525 0 0000 30 + 0526 0 0000 10 9078 CONST + 0527 0 0000 12 9075 J + 0528 0 0000 40 9075 J + 0525 0529 + 0529 0 0000 13 9076 CONST + 0530 0 1111 31 0532 + 0531 0 0000 36 + 0532 0 0001 33 + 0533 0 0000 10 8671 CONST + 0534 0 0000 40 9075 J + 0535 0 0000 44 + 0536 0 0000 30 + 0537 0 0000 10 8670 CONST + 0538 0 0000 40 9075 J + 0539 0 0000 44 + 0540 0 0000 30 + +0503 FOR J = (8,1,16), 24, 25, (30,1,33), 38, 39, 50 $ CHDD0063 + 0541 0 0000 10 8931 CONST + 0542 0 0000 40 9075 J + 0543 0 0000 44 + 0544 0 0000 30 + 0545 0 0000 30 + 0544 0546 + 0540 0546 + 0536 0546 + 0532 0546 + 0531 0546 + 0521 0546 + 0517 0546 + 0513 0546 + 0512 0546 + 0546 0 0000 42 9075 J + 0547 1 0000 10 9859 TP + 0548 0 0000 13 9078 CONST + 0549 0 1111 31 0551 + 0550 0 0000 36 0552 + 0551 0 0000 30 + 0552 0 0000 10 8669 CONST + 0553 0 0000 42 9075 J + 0554 1 0000 13 9808 ROW + 0555 1 0000 40 9808 ROW + 0551 0556 + +0543 ( IF TP (J) EQL 1 $ ROW (J) = 1000 - ROW (J) ) $CHDD0064 + +0543 + 0545 0557 + 0543 0556 + 0539 0556 + 0535 0556 + 0524 0556 + 0520 0556 + 0516 0556 + 0505 0556 + 0556 0 0000 30 + +0557 COMMENT THE ROW-PRODUCT IS CALCULATED AND ZEROES TESTED FOR.$CHDD0065 + 0557 0 0000 10 9077 K + 0558 0 0000 14 9074 CONST + 0559 0 0001 49 0010 + +0557 PYKX (K) = M (K,1) $ CHDD0066 + 0559 0 0001 40 9073 TEMP + 0560 0 0000 42 9073 TEMP + 0561 1 0000 10 9061 M + 0562 0 0000 44 8655 FLOAT + 0563 0 0000 30 8655 + 0564 0 0000 42 9077 K + 0565 1 0000 40 9705 PYKX + 0566 0 0000 10 9078 CONST + 0567 0 0000 40 8933 P + 0568 0 0000 44 + 0569 0 0000 30 + 0570 0 0000 10 9078 CONST + 0571 0 0000 12 8933 P + 0572 0 0000 40 8933 P + 0569 0573 + 0573 0 0000 13 8681 TOTP + 0574 0 1111 31 0576 + 0575 0 0000 36 + 0576 0 0001 33 + +0566 FOR P = (1,1,TOTP) $ CHDD0067 + 0577 0 0000 30 + 0576 0578 + 0575 0578 + +0577 BEGIN CHDD0068 + +0577 IF ROW ( SYP(P) ) EQL 0 $ CHDD0069 + 0578 0 0000 42 8933 P + 0579 1 0000 42 9959 SYP + 0580 1 0000 10 9808 ROW + 0581 0 0000 36 0583 + 0582 0 0000 30 + 0583 0 0000 42 9077 K + 0584 1 0000 46 9705 PYKX + 0585 0 0000 30 0000 TAL9 + +0585 ( PYKX (K) = 0.0 $ GO TO TAL9 ) $ CHDD0070 + 0582 0586 + +0586 FTROW (P) = ROW ( SYP(P) ) CHDD0071 + 0586 0 0000 42 8933 P + 0587 1 0000 42 9959 SYP + 0588 1 0000 10 9808 ROW + 0589 0 0000 44 8655 FLOAT + 0590 0 0000 30 8655 + 0591 0 0000 42 8933 P + 0592 1 0000 40 9758 FTROW + +0593 END $ CHDD0072 + +0593 + 0577 0594 + 0568 0593 + 0593 0 0000 30 + 0594 0 0000 10 9078 CONST + 0595 0 0000 40 8933 P + 0596 0 0000 44 + 0597 0 0000 30 + 0598 0 0000 10 9078 CONST + 0599 0 0000 12 8933 P + 0600 0 0000 40 8933 P + 0597 0601 + 0601 0 0000 13 8681 TOTP + 0602 0 1111 31 0604 + 0603 0 0000 36 + 0604 0 0001 33 + +0594 FOR P = (1,1,TOTP) $ CHDD0073 + 0605 0 0000 30 + 0604 0606 + 0603 0606 + +0605 PYKX (K) = PYKX (K).FTROW (P) $ CHDD0074 + +0605 + 0606 0 0000 42 9077 K + 0607 1 0000 10 9705 PYKX + 0608 0 0000 42 8933 P + 0609 1 0000 24 9758 FTROW + 0610 0 0000 42 9077 K + 0611 1 0000 40 9705 PYKX + 0605 0613 + 0596 0612 + 0612 0 0000 30 + 0585 0613 + +0613 TAL9.. K = K+1 $ CHDD0075 + 0613 0 0000 10 9078 CONST + 0614 0 0000 12 9077 K + 0615 0 0000 40 9077 K + 0616 0 0000 10 9077 K + 0617 0 0000 13 9076 CONST + 0618 0 1111 31 0620 + 0619 0 0000 36 0621 + 0620 0 0000 33 + +0616 IF K LEQ 33 $ GO TO XP9 $ CHDD0076 + 0621 0 0000 30 0482 XP9 + 0620 0622 + +0622 GO TO NORM $ CHDD0077 + +0622 + +0622 + 0622 0 0000 30 0000 NORM + +0623 COMMENT CALCULATE PROBABILITIES USING EQUATION 10. $ CHDD0078 + +0623 + 0481 0623 + 0623 0 0000 10 9078 CONST + 0624 0 0000 40 9075 J + 0625 0 0000 44 + 0626 0 0000 30 + 0627 0 0000 10 9078 CONST + 0628 0 0000 12 9075 J + 0629 0 0000 40 9075 J + 0626 0630 + 0630 0 0000 13 8931 CONST + 0631 0 1111 31 0633 + 0632 0 0000 36 + 0633 0 0001 33 + 0634 0 0000 30 + 0633 0635 + 0632 0635 + +0623 EQ10.. FOR J = (1,1,50) $ TE (J) = 0 $ CHDD0079 + 0635 0 0000 42 9075 J + 0636 1 0000 46 9909 TE + 0634 0638 + 0625 0637 + 0637 0 0000 30 + 0638 0 0000 10 9078 CONST + 0639 0 0000 40 8654 E + 0640 0 0000 44 + 0641 0 0000 30 + 0642 0 0000 10 9078 CONST + 0643 0 0000 12 8654 E + 0644 0 0000 40 8654 E + 0641 0645 + 0645 0 0000 13 8932 CONST + 0646 0 1111 31 0648 + 0647 0 0000 36 + 0648 0 0001 33 + 0649 0 0000 30 + 0648 0650 + 0647 0650 + +0638 FOR E = (1,1,20) $ SYE (E) = 0 $ CHDD0080 + 0650 0 0000 42 8654 E + 0651 1 0000 46 9979 SYE + 0649 0653 + 0640 0652 + 0652 0 0000 30 + 0653 0 0000 10 9078 CONST + 0654 0 0000 40 8653 X + 0655 0 0000 44 + 0656 0 0000 30 + 0657 0 0000 10 9078 CONST + 0658 0 0000 12 8653 X + 0659 0 0000 40 8653 X + 0656 0660 + 0660 0 0000 13 8677 CONST + 0661 0 1111 31 0663 + 0662 0 0000 36 + 0663 0 0001 33 + 0664 0 0000 30 + 0663 0665 + 0662 0665 + +0653 FOR X = (1,1,10) $ MX (X) = 0 $ CHDD0081 + 0665 0 0000 42 8653 X + 0666 1 0000 46 9748 MX + 0664 0668 + 0655 0667 + 0667 0 0000 30 + 0668 0 0000 10 9078 CONST + 0669 0 0000 40 8653 X + 0670 0 0000 44 + 0671 0 0000 30 + 0672 0 0000 10 9078 CONST + 0673 0 0000 12 8653 X + 0674 0 0000 40 8653 X + 0671 0675 + 0675 0 0000 13 8677 CONST + 0676 0 1111 31 0678 + 0677 0 0000 36 + 0678 0 0001 33 + 0679 0 0000 30 + 0678 0680 + 0677 0680 + +0668 FOR X = (1,1,10) $ FTMX (X) = 0.0 $ CHDD0082 + +0668 + 0680 0 0000 42 8653 X + 0681 1 0000 46 9738 FTMX + 0679 0683 + 0670 0682 + 0682 0 0000 30 + +0683 COMMENT THE THIRD INPUT CARD IS READ, THE THIRD LINE OF CHDD0083 + +0683 OUTPUT IS PRINTED, AND THE NUMBER OF SYMPTOMS CHDD0084 + +0683 TO BE OMITTED FOR THIS CASE IS CALCULATED. $ CHDD0085 + +0683 + 0683 0 0000 30 + 0684 0 0000 30 + 0685 0 0000 10 9078 CONST + 0686 0 0000 40 8654 E + 0687 0 0000 44 + 0688 0 0000 30 + 0689 0 0000 10 9078 CONST + 0690 0 0000 12 8654 E + 0691 0 0000 40 8654 E + 0688 0692 + 0692 0 0000 13 8932 CONST + 0693 0 1111 31 0695 + 0694 0 0000 36 + 0695 0 0001 33 + 0696 0 0000 30 + 0695 0697 + 0694 0697 + 0697 0 0100 42 0697 + 0698 0 0002 20 0684 + 0699 0 0000 42 8654 E + 0700 1 0000 40 9979 SYE + 0696 0702 + 0687 0701 + 0701 0 0000 30 + 0702 0 0009 43 0000 + 0703 0 0000 30 0684 + +0685 INPUT ( EXCLUDE ( FOR E = (1,1,20) $ SYE (E) ) ) $ CHDD0086 + 0683 0704 + +0704 CARD3.. READ ( $ $ EXCLUDE ) $ CHDD0087 + 0704 0 0000 10 0705 + 0705 0 0000 01 0684 EXCLU + 0706 0 0000 44 8934 READ + 0707 0 0000 30 8934 + +0708 E = 1 $ CHDD0088 + 0708 0 0000 10 9078 CONST + 0709 0 0000 40 8654 E + 0710 0 0000 10 9078 CONST + 0711 0 0000 40 9075 J + 0712 0 0000 44 + 0713 0 0000 30 + 0714 0 0000 10 9078 CONST + 0715 0 0000 12 9075 J + 0716 0 0000 40 9075 J + 0713 0717 + 0717 0 0000 13 8931 CONST + 0718 0 1111 31 0720 + 0719 0 0000 36 + 0720 0 0001 33 + +0710 FOR J = (1,1,50) $ CHDD0089 + 0721 0 0000 30 + 0720 0722 + 0719 0722 + +0721 BEGIN CHDD0090 + +0721 IF SYE (E) EQL J $ CHDD0091 + 0722 0 0000 42 8654 E + 0723 1 0000 10 9979 SYE + 0724 0 0000 13 9075 J + 0725 0 1111 31 0727 + 0726 0 0000 36 0728 + 0727 0 0000 30 + 0728 0 0000 10 9078 CONST + 0729 0 0000 42 9075 J + 0730 1 0000 40 9909 TE + +0731 ( TE (J) = 1 $ E = E+1 ) CHDD0092 + 0731 0 0000 10 9078 CONST + 0732 0 0000 12 8654 E + 0733 0 0000 40 8654 E + 0727 0734 + +0734 END $ CHDD0093 + 0721 0735 + 0712 0734 + 0734 0 0000 30 + +0735 TOTE = E-1 $ CHDD0094 + 0735 0 0000 10 8654 E + 0736 0 0000 13 9078 CONST + 0737 0 0000 40 8652 TOTE + 0738 0 0000 30 + 0739 0 0000 30 + 0740 0 0000 10 9078 CONST + 0741 0 0000 40 8654 E + 0742 0 0000 44 + 0743 0 0000 30 + 0744 0 0000 10 9078 CONST + 0745 0 0000 12 8654 E + 0746 0 0000 40 8654 E + 0743 0747 + 0747 0 0000 40 9073 TEMP + 0748 0 0000 10 9078 CONST + 0749 0 0000 12 8652 TOTE + 0750 0 0000 13 9073 TEMP + 0751 0 1111 31 0753 + 0752 0 0000 36 + 0753 0 0000 33 + 0754 0 0000 30 + 0753 0755 + 0752 0755 + 0755 0 0000 42 8654 E + 0756 1 0000 10 9979 SYE + 0757 0 0100 42 0757 + 0758 0 0002 20 0739 + 0754 0760 + 0742 0759 + 0759 0 0000 30 + +0738 OUTPUT EOUT ( FOR E = (1,1,TOTE+1) $ SYE (E) ) $ CHDD0095 + 0760 0 0009 43 0000 + 0761 0 0000 30 0739 + 0738 0762 + 0762 0 0000 30 + 0763 0 0004 20 0500 + 0764 2 6268 54 5763 + 0765 2 5654 62 0056 + 0766 2 5449 63 6345 + 0767 3 4414 00 0000 + 0768 0 0004 20 0400 + 0769 0 0004 90 0400 + 0770 1 0000 20 0769 + 0771 0 0006 60 0400 + 0772 1 0000 00 0763 + +0762 FORMAT EFORM (B5,*SYMPTOMS OMITTED*,B4,20(I4),W4) $ CHDD0096 + 0762 0773 + 0773 0 0000 10 0774 + 0774 0 0000 01 0739 EOUT + 0775 0 4400 28 8682 + 0776 1 0000 40 0000 + +0773 WRITE ( $ $ EOUT , EFORM ) $ CHDD0097 + 0777 0 0000 10 0778 + 0778 0 0000 01 0763 EFORM + 0779 0 0000 44 8682 WRITE + 0780 0 0100 30 8682 + +0781 TOTX = SHEET+8 $ CHDD0098 + +0781 + 0781 0 0000 10 8676 CONST + 0782 0 0000 12 8928 SHEET + 0783 0 0000 40 8651 TOTX + +0784 COMMENT ONE ROW OF THE MATRIX IS UNPACKED, THE CHDD0099 + +0784 INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED, CHDD0100 + +0784 AND THE SYMPTOMS OMITTED FOR THIS CASE DELETED. $CHDD0101 + +0784 + 0784 0 0000 10 9077 K + 0785 0 0000 14 9074 CONST + 0786 0 0001 49 0010 + 0787 0 0000 12 0788 + 0788 0 0000 01 9060 M + 0789 0 4400 28 0000 + 0790 1 0000 40 0000 + 0791 0 0000 10 9078 CONST + 0792 1 0000 40 9999 + 0793 0 0000 10 8928 SHEET + 0794 1 0000 40 9998 + 0795 0 0000 10 8927 XRAY + 0796 1 0000 40 9997 + 0797 0 0000 10 8926 EQUAT + 0798 1 0000 40 9996 + 0799 0 0000 10 0800 + 0800 0 0000 01 9808 ROW + 0801 1 0000 40 9995 + +0784 XP10.. UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $ CHDD0102 + 0802 0 0000 10 9078 CONST + 0803 0 0000 44 0000 UNPAC + 0804 0 0600 30 0000 + 0805 0 0000 10 8676 CONST + 0806 0 0000 40 9075 J + 0807 0 0000 44 + 0808 0 0000 30 + 0809 0 0000 10 9078 CONST + 0810 0 0000 12 9075 J + 0811 0 0000 40 9075 J + 0808 0812 + 0812 0 0000 13 8650 CONST + 0813 0 1111 31 0815 + 0814 0 0000 36 + 0815 0 0001 33 + 0816 0 0000 10 8674 CONST + 0817 0 0000 40 9075 J + 0818 0 0000 44 + 0819 0 0000 30 + 0820 0 0000 10 8673 CONST + 0821 0 0000 40 9075 J + 0822 0 0000 44 + 0823 0 0000 30 + 0824 0 0000 10 8672 CONST + 0825 0 0000 40 9075 J + 0826 0 0000 44 + 0827 0 0000 30 + 0828 0 0000 10 9078 CONST + 0829 0 0000 12 9075 J + 0830 0 0000 40 9075 J + 0827 0831 + 0831 0 0000 13 9076 CONST + 0832 0 1111 31 0834 + 0833 0 0000 36 + 0834 0 0001 33 + 0835 0 0000 10 8671 CONST + 0836 0 0000 40 9075 J + 0837 0 0000 44 + 0838 0 0000 30 + 0839 0 0000 10 8670 CONST + 0840 0 0000 40 9075 J + 0841 0 0000 44 + 0842 0 0000 30 + +0805 FOR J = (8,1,15) , 24, 25, (30,1,33), 38, 39, 50 $CHDD0103 + 0843 0 0000 10 8931 CONST + 0844 0 0000 40 9075 J + 0845 0 0000 44 + 0846 0 0000 30 + 0847 0 0000 30 + 0846 0848 + 0842 0848 + 0838 0848 + 0834 0848 + 0833 0848 + 0823 0848 + 0819 0848 + 0815 0848 + 0814 0848 + +0845 BEGIN CHDD0104 + 0848 0 0000 42 9075 J + 0849 1 0000 10 9859 TP + 0850 0 0000 13 9078 CONST + 0851 0 1111 31 0853 + 0852 0 0000 36 0854 + 0853 0 0000 30 + +0845 IF TP(J) EQL 1 $ ROW (J) = 1000 - ROW (J) $ CHDD0105 + 0854 0 0000 10 8669 CONST + 0855 0 0000 42 9075 J + 0856 1 0000 13 9808 ROW + 0857 1 0000 40 9808 ROW + 0853 0858 + +0858 IF ROW (J) EQL 0 $ CHDD0106 + 0858 0 0000 42 9075 J + 0859 1 0000 10 9808 ROW + 0860 0 0000 36 0862 + 0861 0 0000 30 + 0862 0 0000 42 9077 K + 0863 1 0000 46 9705 PYKX + 0864 0 0000 30 0000 TAL10 + +0864 ( PYKX (K) = 0.0 $ GO TO TAL10 ) $ CHDD0107 + 0861 0865 + 0865 0 0000 42 9075 J + 0866 1 0000 10 9909 TE + 0867 0 0000 13 9078 CONST + 0868 0 1111 31 0870 + 0869 0 0000 36 0871 + 0870 0 0000 30 + +0865 IF TE (J) EQL 1 $ ROW (J) = 0 CHDD0108 + 0871 0 0000 42 9075 J + 0872 1 0000 46 9808 ROW + 0870 0873 + +0873 END $ CHDD0109 + +0873 + 0847 0874 + 0845 0873 + 0841 0873 + 0837 0873 + 0826 0873 + 0822 0873 + 0818 0873 + 0807 0873 + 0873 0 0000 30 + +0874 COMMENT THE ROW-PRODUCT IS CALCULATED FOR THOSE INDEPENDENT CHDD0110 + +0874 SYMPTOMS COMMON TO BOTH SHEETS, ZERO VALUES TESTED CHDD0111 + +0874 FOR, AND EACH ELEMENT SCALED. $CHDD0112 + +0874 + 0874 0 0000 10 9077 K + 0875 0 0000 14 9074 CONST + 0876 0 0001 49 0010 + +0874 PYKX (K)= M (K,1) $ CHDD0113 + 0876 0 0001 40 9073 TEMP + 0877 0 0000 42 9073 TEMP + 0878 1 0000 10 9061 M + 0879 0 0000 44 8655 FLOAT + 0880 0 0000 30 8655 + 0881 0 0000 42 9077 K + 0882 1 0000 40 9705 PYKX + 0883 0 0000 10 8676 CONST + 0884 0 0000 40 9075 J + 0885 0 0000 44 + 0886 0 0000 30 + 0887 0 0000 10 9078 CONST + 0888 0 0000 12 9075 J + 0889 0 0000 40 9075 J + 0886 0890 + 0890 0 0000 13 8650 CONST + 0891 0 1111 31 0893 + 0892 0 0000 36 + 0893 0 0001 33 + 0894 0 0000 10 8674 CONST + 0895 0 0000 40 9075 J + 0896 0 0000 44 + 0897 0 0000 30 + 0898 0 0000 10 8673 CONST + 0899 0 0000 40 9075 J + 0900 0 0000 44 + 0901 0 0000 30 + 0902 0 0000 10 8672 CONST + 0903 0 0000 40 9075 J + 0904 0 0000 44 + 0905 0 0000 30 + 0906 0 0000 10 9078 CONST + 0907 0 0000 12 9075 J + 0908 0 0000 40 9075 J + 0905 0909 + 0909 0 0000 13 9076 CONST + 0910 0 1111 31 0912 + 0911 0 0000 36 + 0912 0 0001 33 + 0913 0 0000 10 8671 CONST + 0914 0 0000 40 9075 J + 0915 0 0000 44 + 0916 0 0000 30 + 0917 0 0000 10 8670 CONST + 0918 0 0000 40 9075 J + 0919 0 0000 44 + 0920 0 0000 30 + +0883 FOR J= (8,1,15), 24, 25, (30,1,33), 38, 39, 50 $ CHDD0114 + 0921 0 0000 10 8931 CONST + 0922 0 0000 40 9075 J + 0923 0 0000 44 + 0924 0 0000 30 + 0925 0 0000 30 + 0924 0926 + 0920 0926 + 0916 0926 + 0912 0926 + 0911 0926 + 0901 0926 + 0897 0926 + 0893 0926 + 0892 0926 + +0923 BEGIN CHDD0115 + 0926 0 0000 42 9075 J + 0927 1 0000 10 9808 ROW + 0928 0 0000 44 8655 FLOAT + 0929 0 0000 30 8655 + 0930 0 0000 42 9075 J + 0931 1 0000 40 9758 FTROW + +0932 FTROW(J) = ROW(J) $ FTROW(J) = FTROW(J)/100.0 $ CHDD0116 + 0932 0 0000 42 9075 J + 0933 1 0000 10 9758 FTROW + 0934 0 0002 45 0000 + 0935 0 0000 25 8649 CONST + 0936 1 0000 40 9758 FTROW + +0937 IF FTROW (J) NEQ 0.0 $ CHDD0117 + 0937 0 0000 42 9075 J + 0938 1 0000 10 9758 FTROW + 0939 0 0000 36 + +0937 PYKX (K) = PYKX(K).FTROW(J) CHDD0118 + 0940 0 0000 42 9077 K + 0941 1 0000 10 9705 PYKX + 0942 0 0000 42 9075 J + 0943 1 0000 24 9758 FTROW + 0944 0 0000 42 9077 K + 0945 1 0000 40 9705 PYKX + 0939 0946 + +0946 END $ CHDD0119 + +0946 + +0946 + 0925 0947 + 0923 0946 + 0919 0946 + 0915 0946 + 0904 0946 + 0900 0946 + 0896 0946 + 0885 0946 + 0946 0 0000 30 + +0947 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0120 + +0947 EXCLUSIVE SYMPTOM-SETS COMMON TO BOTH BROWN AND CHDD0121 + +0947 WHITE SYMPTOM CHECK SHEETS PER TABLE V. $ CHDD0122 + +0947 + +0947 X1TO3.. MX (1) = ROW ( SYP (1) ) $ CHDD0123 + 0947 0 0000 42 9960 SYP + 0948 1 0000 10 9808 ROW + 0949 0 0000 40 9749 MX + +0950 X4TO7.. IF TE (4) EQL 1 $ CHDD0124 + 0950 0 0000 10 9913 TE + 0951 0 0000 13 9078 CONST + 0952 0 1111 31 0954 + 0953 0 0000 36 0955 + 0954 0 0000 30 + 0955 0 0000 10 8648 CONST + 0956 0 0000 40 9750 MX + 0957 0 0000 30 0000 X26 + +0957 ( MX (2) = 100 $ GO TO X26 ) $ CHDD0125 + 0954 0958 + +0958 IF SYP (2) LEQ 7 $ CHDD0126 + 0958 0 0000 10 9961 SYP + 0959 0 0000 13 8647 CONST + 0960 0 1111 31 0962 + 0961 0 0000 36 0963 + 0962 0 0000 33 + 0963 0 0000 42 9961 SYP + 0964 1 0000 10 9808 ROW + 0965 0 0000 40 9750 MX + 0966 0 0000 30 0000 X26 + +0966 ( MX (2) = ROW ( SYP(2) ) $ GO TO X26 ) $ CHDD0127 + 0962 0967 + +0967 MX (2) = 1000 - ROW(4) - ROW(5) - ROW(6) - ROW(7) $CHDD0128 + 0967 0 0000 11 9814 ROW + 0968 0 0000 13 9815 ROW + 0969 0 0000 13 9813 ROW + 0970 0 0000 13 9812 ROW + 0971 0 0000 12 8669 CONST + 0972 0 0000 40 9750 MX + 0966 0973 + 0957 0973 + +0973 X26.. X = 3 $ CHDD0129 + 0973 0 0000 10 8646 CONST + 0974 0 0000 40 8653 X + 0975 0 0000 10 8645 CONST + 0976 0 0000 40 9075 J + 0977 0 0000 44 + 0978 0 0000 30 + 0979 0 0000 10 8644 CONST + 0980 0 0000 40 9075 J + 0981 0 0000 44 + 0982 0 0000 30 + 0983 0 0000 10 8643 CONST + 0984 0 0000 40 9075 J + 0985 0 0000 44 + 0986 0 0000 30 + +0975 FOR J = 26 , 28, 34, 36 $ CHDD0130 + 0987 0 0000 10 8642 CONST + 0988 0 0000 40 9075 J + 0989 0 0000 44 + 0990 0 0000 30 + 0991 0 0000 30 + 0990 0992 + 0986 0992 + 0982 0992 + 0978 0992 + +0989 BEGIN CHDD0131 + +0989 IF TE (J) EQL 1 $ CHDD0132 + 0992 0 0000 42 9075 J + 0993 1 0000 10 9909 TE + 0994 0 0000 13 9078 CONST + 0995 0 1111 31 0997 + 0996 0 0000 36 0998 + 0997 0 0000 30 + 0998 0 0000 10 8648 CONST + 0999 0 0000 42 8653 X + 1000 1 0000 40 9748 MX + 1001 0 0000 30 0000 LAB5 + +1001 ( MX (X) = 100 $ GO TO LAB5 ) $ CHDD0133 + 0997 1002 + +1002 IF TP (J) EQL TP (J+1) $ CHDD0134 + 1002 0 0000 42 9075 J + 1003 1 0000 10 9859 TP + 1004 1 0000 13 9860 TP + 1005 0 1111 31 1007 + 1006 0 0000 36 1008 + 1007 0 0000 30 + 1008 0 0000 42 9075 J + 1009 1 0000 11 9808 ROW + 1010 1 0000 13 9809 ROW + 1011 0 0000 12 8669 CONST + 1012 0 0000 42 8653 X + 1013 1 0000 40 9748 MX + 1014 0 0000 30 0000 LAB5 + +1014 ( MX(X) = 1000 - ROW(J) - ROW(J+1) $ GO TO LAB5 ) $CHDD0135 + 1007 1015 + +1015 IF TP (J) EQL 1 $ CHDD0136 + 1015 0 0000 42 9075 J + 1016 1 0000 10 9859 TP + 1017 0 0000 13 9078 CONST + 1018 0 1111 31 1020 + 1019 0 0000 36 1021 + 1020 0 0000 30 + 1021 0 0000 42 9075 J + 1022 1 0000 10 9808 ROW + 1023 0 0000 42 8653 X + 1024 1 0000 40 9748 MX + 1025 0 0000 30 0000 LAB5 + +1025 ( MX (X) = ROW (J) $ GO TO LAB5 ) $ CHDD0137 + 1020 1026 + +1026 MX (X) = ROW (J+1) $ CHDD0138 + 1026 0 0000 42 9075 J + 1027 1 0000 10 9809 ROW + 1028 0 0000 42 8653 X + 1029 1 0000 40 9748 MX + 1025 1030 + 1014 1030 + 1001 1030 + +1030 LAB5.. X = X+1 CHDD0139 + 1030 0 0000 10 9078 CONST + 1031 0 0000 12 8653 X + 1032 0 0000 40 8653 X + +1033 END $ CHDD0140 + +1033 + 0991 1034 + 0989 1033 + 0985 1033 + 0981 1033 + 0977 1033 + 1033 0 0000 30 + 1034 0 0000 10 8928 SHEET + 1035 0 0000 13 9078 CONST + 1036 0 1111 31 1038 + 1037 0 0000 36 1039 + 1038 0 0000 30 + +1034 BNORWH.. IF SHEET EQL 1 $ GO TO WHITE $ CHDD0141 + +1034 + 1039 0 0000 30 0000 WHITE + 1038 1040 + +1040 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0142 + +1040 EXCLUSIVE SYMPTOM-SETS FOR THE BROWN SHEET OPTION. $CHDD0143 + +1040 + 1040 0 0000 10 9875 TP + 1041 0 0000 13 9078 CONST + 1042 0 1111 31 1044 + 1043 0 0000 36 1045 + 1044 0 0000 30 + +1040 BROWN.. IF TP (16) EQL 1 $ ROW (16) = 1000 - ROW (16) $CHDD0144 + 1045 0 0000 10 8669 CONST + 1046 0 0000 13 9824 ROW + 1047 0 0000 40 9824 ROW + 1044 1048 + +1048 IF ROW (16) EQL 0 $ CHDD0145 + 1048 0 0000 10 9824 ROW + 1049 0 0000 36 1051 + 1050 0 0000 30 + 1051 0 0000 42 9077 K + 1052 1 0000 46 9705 PYKX + 1053 0 0000 30 0000 TAL10 + +1053 ( PYKX (K) = 0.0 $ GO TO TAL10 ) $ CHDD0146 + 1050 1054 + +1054 IF TE (16) EQL 1 $ CHDD0147 + 1054 0 0000 10 9925 TE + 1055 0 0000 13 9078 CONST + 1056 0 1111 31 1058 + 1057 0 0000 36 1059 + 1058 0 0000 30 + 1059 0 0000 46 9824 ROW + 1060 0 0000 30 0000 X17TO + +1060 ( ROW (16) = 0 $ GO TO X17TO19 ) $ CHDD0148 + 1058 1061 + +1061 BEGIN CHDD0149 + +1061 FTROW (16) = ROW (16) $ CHDD0150 + 1061 0 0000 10 9824 ROW + 1062 0 0000 44 8655 FLOAT + 1063 0 0000 30 8655 + 1064 0 0000 40 9774 FTROW + 1065 0 0000 42 9077 K + 1066 1 0000 10 9705 PYKX + 1067 0 0000 24 9774 FTROW + +1065 PYKX (K) = PYKX (K).FTROW (16) / 100.0 CHDD0151 + 1068 0 0002 45 0000 + 1069 0 0000 25 8649 CONST + 1070 1 0000 40 9705 PYKX + +1071 END $ CHDD0152 + 1060 1071 + +1071 X17TO19.. IF TE (17) EQL 1 $ CHDD0153 + 1071 0 0000 10 9926 TE + 1072 0 0000 13 9078 CONST + 1073 0 1111 31 1075 + 1074 0 0000 36 1076 + 1075 0 0000 30 + 1076 0 0000 10 8648 CONST + 1077 0 0000 40 9755 MX + 1078 0 0000 30 0000 X20 + +1078 ( MX (7) =100 $ GO TO X20 ) $ CHDD0154 + 1075 1079 + 1079 0 0000 10 9876 TP + 1080 0 0000 13 9877 TP + 1081 0 1111 31 1083 + 1082 0 0000 36 1085 + 1083 0 0001 45 0002 + 1084 0 0000 30 1086 + 1085 0 0000 10 9078 CONST + 1086 0 0000 40 9073 TEMP + 1087 0 0000 10 9877 TP + 1088 0 0000 13 9878 TP + 1089 0 1111 31 1091 + 1090 0 0000 36 1093 + 1091 0 0001 45 0002 + 1092 0 0000 30 1094 + 1093 0 0000 10 9078 CONST + +1079 IF ( TP(17) EQL TP(18) ) AND ( TP(18) EQL TP(19) ) $CHDD0155 + 1094 0 0000 17 9073 TEMP + 1095 0 0000 36 + +1079 BEGIN CHDD0156 + 1096 0 0000 10 8669 CONST + 1097 0 0000 13 9825 ROW + 1098 0 0000 40 9073 TEMP + 1099 0 0000 10 8669 CONST + 1100 0 0000 13 9826 ROW + 1101 0 0000 14 9073 TEMP + 1102 0 0001 49 0010 + 1102 0 0001 40 9073 TEMP + 1103 0 0000 10 8669 CONST + 1104 0 0000 13 9827 ROW + +1098 MX(7) =(1000-ROW(17)).(1000-ROW(18)).(1000-ROW(19)) $CHDD0157 + 1105 0 0000 14 9073 TEMP + 1106 0 0001 49 0010 + 1106 0 0001 40 9755 MX + +1107 GO TO X20 CHDD0158 + 1107 0 0000 30 0000 X20 + +1108 END $ CHDD0159 + 1095 1108 + +1108 IF TP (19) EQL 1 $ CHDD0160 + 1108 0 0000 10 9878 TP + 1109 0 0000 13 9078 CONST + 1110 0 1111 31 1112 + 1111 0 0000 36 1113 + 1112 0 0000 30 + 1113 0 0000 10 9827 ROW + 1114 0 0000 40 9755 MX + 1115 0 0000 30 0000 X20 + +1115 ( MX (7) = ROW (19) $ GO TO X20 ) $ CHDD0161 + 1112 1116 + +1116 IF TP (17) EQL 0 $ CHDD0162 + 1116 0 0000 10 9876 TP + 1117 0 0000 36 1119 + 1118 0 0000 30 + 1119 0 0000 10 8669 CONST + 1120 0 0000 13 9825 ROW + 1121 0 0000 14 9826 ROW + 1122 0 0001 49 0010 + 1122 0 0001 40 9755 MX + 1123 0 0000 30 0000 X20 + +1121 ( MX(7) = ROW(18).(1000 - ROW(17) ) $ GO TO X20 ) $CHDD0163 + 1118 1124 + +1124 IF TP (18) EQL 0 $ CHDD0164 + 1124 0 0000 10 9877 TP + 1125 0 0000 36 1127 + 1126 0 0000 30 + 1127 0 0000 10 8669 CONST + 1128 0 0000 13 9826 ROW + 1129 0 0000 14 9825 ROW + 1130 0 0001 49 0010 + 1130 0 0001 40 9755 MX + 1131 0 0000 30 0000 X20 + +1129 ( MX(7) = ROW(17).(1000 - ROW(18) ) $ GO TO X20 ) $CHDD0165 + 1126 1132 + +1132 MX (7) = ROW(17).ROW(18) $ CHDD0166 + +1132 + 1132 0 0000 10 9825 ROW + 1133 0 0000 14 9826 ROW + 1134 0 0001 49 0010 + 1134 0 0001 40 9755 MX + 1131 1135 + 1123 1135 + 1115 1135 + 1107 1135 + 1078 1135 + +1135 X20.. IF TE (20) EQL 1 $ CHDD0167 + 1135 0 0000 10 9929 TE + 1136 0 0000 13 9078 CONST + 1137 0 1111 31 1139 + 1138 0 0000 36 1140 + 1139 0 0000 30 + 1140 0 0000 10 8648 CONST + 1141 0 0000 40 9756 MX + 1142 0 0000 30 0000 FLTMX + +1142 ( MX (8) = 100 $ GO TO FLTMX ) $ CHDD0168 + 1139 1143 + 1143 0 0000 11 9828 ROW + 1144 0 0000 13 9829 ROW + 1145 0 0000 12 8669 CONST + +1143 T2021 = ( 1000 - ROW (20) - ROW (21) ) $ CHDD0169 + 1146 0 0000 40 8641 T2021 + 1147 0 0000 10 9830 ROW + 1148 0 0000 49 0004 + +1147 T22 = ( 1000 0 ROW (22) ) $ CHDD0170 + +1147 + 1149 0 0000 40 8640 T22 + 1150 0 0000 10 9879 TP + 1151 0 0000 13 9880 TP + 1152 0 1111 31 1154 + 1153 0 0000 36 1156 + 1154 0 0001 45 0002 + 1155 0 0000 30 1157 + 1156 0 0000 10 9078 CONST + +1150 IF ( TP(20) EQL TP(21) ) AND ( TP(21) EQL TP(22) ) CHDD0171 + 1157 0 0000 40 9073 TEMP + 1158 0 0000 10 9880 TP + 1159 0 0000 13 9881 TP + 1160 0 1111 31 1162 + 1161 0 0000 36 1164 + 1162 0 0001 45 0002 + 1163 0 0000 30 1165 + 1164 0 0000 10 9078 CONST + 1165 0 0000 17 9073 TEMP + 1166 0 0000 40 9073 TEMP + 1167 0 0000 10 9881 TP + 1168 0 0000 13 9882 TP + 1169 0 1111 31 1171 + 1170 0 0000 36 1173 + 1171 0 0001 45 0002 + 1172 0 0000 30 1174 + 1173 0 0000 10 9078 CONST + +1165 AND ( TP(22) EQL TP(23) ) $ CHDD0172 + 1174 0 0000 17 9073 TEMP + 1175 0 0000 36 + 1176 0 0000 10 8669 CONST + 1177 0 0000 13 9831 ROW + 1178 0 0000 14 8640 T22 + 1179 0 0001 49 0010 + 1180 0 0000 14 8641 T2021 + 1181 0 0001 49 0010 + 1181 0 0001 40 9756 MX + 1182 0 0000 30 0000 FLTMX + +1178 (MX(8) = T2021.T22.(1000 - ROW(23) ) $ GO TO FLTMX )$CHDD0173 + 1175 1183 + +1183 IF TP (20) EQL 1 $ CHDD0174 + 1183 0 0000 10 9879 TP + 1184 0 0000 13 9078 CONST + 1185 0 1111 31 1187 + 1186 0 0000 36 1188 + 1187 0 0000 30 + +1183 BEGIN CHDD0175 + +1183 IF TP (22) EQL 1 $ CHDD0176 + 1188 0 0000 10 9881 TP + 1189 0 0000 13 9078 CONST + 1190 0 1111 31 1192 + 1191 0 0000 36 1193 + 1192 0 0000 30 + 1193 0 0000 10 9828 ROW + 1194 0 0000 14 9830 ROW + 1195 0 0001 49 0010 + 1195 0 0001 40 9756 MX + 1196 0 0000 30 0000 FLTMX + +1196 ( MX(8) = ROW(20).ROW(22) $ GO TO FLTMX ) $ CHDD0177 + 1192 1197 + 1197 0 0000 10 9828 ROW + 1198 0 0000 14 8640 T22 + 1199 0 0001 49 0010 + 1199 0 0001 40 9756 MX + +1197 MX (8) = ROW (20).T22 $ GO TO FLTMX CHDD0178 + 1200 0 0000 30 0000 FLTMX + +1201 END $ CHDD0179 + +1201 CHDD0180 + 1187 1201 + +1201 IF TP (21) EQL 1 $ CHDD0181 + 1201 0 0000 10 9880 TP + 1202 0 0000 13 9078 CONST + 1203 0 1111 31 1205 + 1204 0 0000 36 1206 + 1205 0 0000 30 + +1201 BEGIN CHDD0182 + +1201 IF TP (22) EQL 1 $ CHDD0183 + 1206 0 0000 10 9881 TP + 1207 0 0000 13 9078 CONST + 1208 0 1111 31 1210 + 1209 0 0000 36 1211 + 1210 0 0000 30 + 1211 0 0000 10 9829 ROW + 1212 0 0000 14 9830 ROW + 1213 0 0001 49 0010 + 1213 0 0001 40 9756 MX + 1214 0 0000 30 0000 FLTMX + +1214 ( MX(8) = ROW(21).ROW(22) $ GO TO FLTMX ) $ CHDD0184 + 1210 1215 + 1215 0 0000 10 9829 ROW + 1216 0 0000 14 8640 T22 + 1217 0 0001 49 0010 + 1217 0 0001 40 9756 MX + +1215 MX (8) = ROW (21).T22 $ GO TO FLTMX CHDD0185 + 1218 0 0000 30 0000 FLTMX + +1219 END $ CHDD0186 + 1205 1219 + +1219 IF TP (22) EQL 1 $ CHDD0187 + 1219 0 0000 10 9881 TP + 1220 0 0000 13 9078 CONST + 1221 0 1111 31 1223 + 1222 0 0000 36 1224 + 1223 0 0000 30 + 1224 0 0000 10 9830 ROW + 1225 0 0000 14 8641 T2021 + 1226 0 0001 49 0010 + 1226 0 0001 40 9756 MX + 1227 0 0000 30 0000 FLTMX + +1227 ( MX(8) = ROW(22).T2021 $ GO TO FLTMX ) $ CHDD0188 + 1223 1228 + 1228 0 0000 10 9831 ROW + 1229 0 0000 40 9756 MX + +1228 MX (8) = ROW (23) $ GO TO FLTMX $ CHDD0189 + +1228 + 1230 0 0000 30 0000 FLTMX + +1231 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0190 + +1231 EXCLUSIVE SYMPTOM-SETS FOR THE WHITE SHEET OPTION. $CHDD0191 + +1231 + 1039 1231 + 1231 0 0000 10 9928 TE + 1232 0 0000 13 9951 TE + 1233 0 1111 31 1235 + 1234 0 0000 36 1237 + 1235 0 0001 45 0002 + 1236 0 0000 30 1238 + 1237 0 0000 10 9078 CONST + +1238 WHITE.. IF (TE(19) EQL TE(42) ) AND ( TE(42) EQL TE(44) ) CHDD0192 + 1238 0 0000 40 9073 TEMP + 1239 0 0000 10 9951 TE + 1240 0 0000 13 9953 TE + 1241 0 1111 31 1243 + 1242 0 0000 36 1245 + 1243 0 0001 45 0002 + 1244 0 0000 30 1246 + 1245 0 0000 10 9078 CONST + 1246 0 0000 17 9073 TEMP + 1247 0 0000 40 9073 TEMP + 1248 0 0000 10 9953 TE + 1249 0 0000 13 9078 CONST + 1250 0 1111 31 1252 + 1251 0 0000 36 1254 + 1252 0 0001 45 0002 + 1253 0 0000 30 1255 + 1254 0 0000 10 9078 CONST + +1246 AND ( TE(44) EQL 1 ) $ CHDD0193 + 1255 0 0000 17 9073 TEMP + 1256 0 0000 36 + 1257 0 0000 10 8648 CONST + 1258 0 0000 40 9755 MX + 1259 0 0000 30 0000 X40 + +1259 ( MX (7) = 100 $ GO TO X40 ) $ CHDD0194 + 1256 1260 + 1260 0 0000 11 9850 ROW + 1261 0 0000 13 9851 ROW + 1262 0 0000 12 8669 CONST + +1260 T4243 = ( 1000 - ROW(42) - ROW(43) ) $ CHDD0195 + 1263 0 0000 40 8639 T4243 + 1264 0 0000 11 9852 ROW + 1265 0 0000 13 9853 ROW + 1266 0 0000 12 8669 CONST + +1264 T4445 = ( 1000 - ROW(44) - ROW(45) ) $ CHDD0196 + +1264 + 1267 0 0000 40 8638 T4445 + 1268 0 0000 10 9878 TP + 1269 0 0000 13 9901 TP + 1270 0 1111 31 1272 + 1271 0 0000 36 1274 + 1272 0 0001 45 0002 + 1273 0 0000 30 1275 + 1274 0 0000 10 9078 CONST + +1268 IF ( TP(19) EQL TP(42) ) AND ( TP(42) EQL TP(43) ) CHDD0197 + 1275 0 0000 40 9073 TEMP + 1276 0 0000 10 9901 TP + 1277 0 0000 13 9902 TP + 1278 0 1111 31 1280 + 1279 0 0000 36 1282 + 1280 0 0001 45 0002 + 1281 0 0000 30 1283 + 1282 0 0000 10 9078 CONST + 1283 0 0000 17 9073 TEMP + 1284 0 0000 40 9073 TEMP + 1285 0 0000 10 9902 TP + 1286 0 0000 13 9903 TP + 1287 0 1111 31 1289 + 1288 0 0000 36 1291 + 1289 0 0001 45 0002 + 1290 0 0000 30 1292 + 1291 0 0000 10 9078 CONST + 1292 0 0000 17 9073 TEMP + 1293 0 0000 40 9073 TEMP + 1294 0 0000 10 9903 TP + 1295 0 0000 13 9904 TP + 1296 0 1111 31 1298 + 1297 0 0000 36 1300 + 1298 0 0001 45 0002 + 1299 0 0000 30 1301 + 1300 0 0000 10 9078 CONST + +1283 AND ( TP(43) EQL TP(44) ) AND ( TP(44) EQL TP(45) ) $CHDD0198 + 1301 0 0000 17 9073 TEMP + 1302 0 0000 36 + 1303 0 0000 10 8669 CONST + 1304 0 0000 13 9827 ROW + 1305 0 0000 14 8639 T4243 + 1306 0 0001 49 0010 + 1307 0 0000 14 8638 T4445 + 1308 0 0001 49 0010 + 1308 0 0001 40 9755 MX + 1309 0 0000 30 0000 X40 + +1305 ( MX(7) = (1000 - ROW(19)).T4243.T4445 $ GO TO X40 )$CHDD0199 + 1302 1310 + +1310 IF TP (19) EQL 1 $ CHDD0200 + 1310 0 0000 10 9878 TP + 1311 0 0000 13 9078 CONST + 1312 0 1111 31 1314 + 1313 0 0000 36 1315 + 1314 0 0000 30 + 1315 0 0000 10 9827 ROW + 1316 0 0000 40 9755 MX + 1317 0 0000 30 0000 X40 + +1317 ( MX(7) = ROW(19) $ GO TO X40 ) $ CHDD0201 + 1314 1318 + +1318 IF TP (42) EQL 1 $ CHDD0202 + 1318 0 0000 10 9901 TP + 1319 0 0000 13 9078 CONST + 1320 0 1111 31 1322 + 1321 0 0000 36 1323 + 1322 0 0000 30 + +1318 BEGIN CHDD0203 + +1318 IF TP(44) EQL 1 $ CHDD0204 + 1323 0 0000 10 9903 TP + 1324 0 0000 13 9078 CONST + 1325 0 1111 31 1327 + 1326 0 0000 36 1328 + 1327 0 0000 30 + 1328 0 0000 10 9850 ROW + 1329 0 0000 14 9852 ROW + 1330 0 0001 49 0010 + 1330 0 0001 40 9755 MX + 1331 0 0000 30 0000 X40 + +1331 ( MX(7) = ROW(42).ROW(44) $ GO TO X40 ) $ CHDD0205 + 1327 1332 + +1332 IF TP (45) EQL 1 $ CHDD0206 + 1332 0 0000 10 9904 TP + 1333 0 0000 13 9078 CONST + 1334 0 1111 31 1336 + 1335 0 0000 36 1337 + 1336 0 0000 30 + 1337 0 0000 10 9850 ROW + 1338 0 0000 14 9853 ROW + 1339 0 0001 49 0010 + 1339 0 0001 40 9755 MX + 1340 0 0000 30 0000 X40 + +1340 ( MX(7) = ROW(42).ROW(45) $ GO TO X40 ) $ CHDD0207 + 1336 1341 + 1341 0 0000 10 9850 ROW + 1342 0 0000 14 8638 T4445 + 1343 0 0001 49 0010 + 1343 0 0001 40 9755 MX + +1341 MX (7) = ROW (42).T4445 $ GO TO X40 CHDD0208 + 1344 0 0000 30 0000 X40 + +1345 END $ CHDD0209 + 1322 1345 + +1345 IF TP (43) EQL 1 $ CHDD0210 + 1345 0 0000 10 9902 TP + 1346 0 0000 13 9078 CONST + 1347 0 1111 31 1349 + 1348 0 0000 36 1350 + 1349 0 0000 30 + +1345 BEGIN CHDD0211 + +1345 IF TP (44) EQL 1 $ CHDD0212 + 1350 0 0000 10 9903 TP + 1351 0 0000 13 9078 CONST + 1352 0 1111 31 1354 + 1353 0 0000 36 1355 + 1354 0 0000 30 + 1355 0 0000 10 9851 ROW + 1356 0 0000 14 9852 ROW + 1357 0 0001 49 0010 + 1357 0 0001 40 9755 MX + 1358 0 0000 30 0000 X40 + +1358 ( MX(7) = ROW(43).ROW(44) $ GO TO X40 ) $ CHDD0213 + 1354 1359 + +1359 IF TP (45) EQL 1 $ CHDD0214 + 1359 0 0000 10 9904 TP + 1360 0 0000 13 9078 CONST + 1361 0 1111 31 1363 + 1362 0 0000 36 1364 + 1363 0 0000 30 + 1364 0 0000 10 9851 ROW + 1365 0 0000 14 9853 ROW + 1366 0 0001 49 0010 + 1366 0 0001 40 9755 MX + 1367 0 0000 30 0000 X40 + +1367 ( MX(7) = ROW(43).ROW(45) $ GO TO X40 ) $ CHDD0215 + 1363 1368 + 1368 0 0000 10 9851 ROW + 1369 0 0000 14 8638 T4445 + 1370 0 0001 49 0010 + 1370 0 0001 40 9755 MX + +1368 MX (7) = ROW (43).T4445 $ GO TO X40 CHDD0216 + 1371 0 0000 30 0000 X40 + +1372 END $ CHDD0217 + 1349 1372 + +1372 IF TP (44) EQL 1 $ CHDD0218 + 1372 0 0000 10 9903 TP + 1373 0 0000 13 9078 CONST + 1374 0 1111 31 1376 + 1375 0 0000 36 1377 + 1376 0 0000 30 + 1377 0 0000 10 9852 ROW + 1378 0 0000 14 8639 T4243 + 1379 0 0001 49 0010 + 1379 0 0001 40 9755 MX + 1380 0 0000 30 0000 X40 + +1380 ( MX(7) = ROW(44).T4243 $ GO TO X40 ) $ CHDD0219 + 1376 1381 + +1381 MX (7) = ROW (45).T4243 $ CHDD0220 + +1381 + 1381 0 0000 10 9853 ROW + 1382 0 0000 14 8639 T4243 + 1383 0 0001 49 0010 + 1383 0 0001 40 9755 MX + 1380 1384 + 1371 1384 + 1367 1384 + 1358 1384 + 1344 1384 + 1340 1384 + 1331 1384 + 1317 1384 + 1309 1384 + 1259 1384 + +1384 X40.. IF TE (40) EQL 1 $ CHDD0221 + 1384 0 0000 10 9949 TE + 1385 0 0000 13 9078 CONST + 1386 0 1111 31 1388 + 1387 0 0000 36 1389 + 1388 0 0000 30 + 1389 0 0000 10 8648 CONST + 1390 0 0000 40 9756 MX + 1391 0 0000 30 0000 X2369 + +1391 ( MX (8) = 100 $ GO TO X2369 ) $ CHDD0222 + 1388 1392 + +1392 IF TP (40) EQL TP (41) $ CHDD0223 + 1392 0 0000 10 9899 TP + 1393 0 0000 13 9900 TP + 1394 0 1111 31 1396 + 1395 0 0000 36 1397 + 1396 0 0000 30 + 1397 0 0000 11 9848 ROW + 1398 0 0000 13 9849 ROW + 1399 0 0000 12 8669 CONST + 1400 0 0000 40 9756 MX + 1401 0 0000 30 0000 X2369 + +1401 ( MX(8) = 1000 - ROW(40) - ROW(41) $ GO TO X2369 ) $CHDD0224 + 1396 1402 + +1402 IF TP (40) EQL 1 $ CHDD0225 + 1402 0 0000 10 9899 TP + 1403 0 0000 13 9078 CONST + 1404 0 1111 31 1406 + 1405 0 0000 36 1407 + 1406 0 0000 30 + 1407 0 0000 10 9848 ROW + 1408 0 0000 40 9756 MX + 1409 0 0000 30 0000 X2369 + +1409 ( MX(8) = ROW(40) $ GO TO X2369 ) $ CHDD0226 + 1406 1410 + +1410 MX (8) = ROW (41) $ CHDD0227 + +1410 + 1410 0 0000 10 9849 ROW + 1411 0 0000 40 9756 MX + 1409 1412 + 1401 1412 + 1391 1412 + 1412 0 0000 10 9931 TE + 1413 0 0000 13 9955 TE + 1414 0 1111 31 1416 + 1415 0 0000 36 1418 + 1416 0 0001 45 0002 + 1417 0 0000 30 1419 + 1418 0 0000 10 9078 CONST + 1419 0 0000 40 9073 TEMP + 1420 0 0000 10 9955 TE + 1421 0 0000 13 9078 CONST + 1422 0 1111 31 1424 + 1423 0 0000 36 1426 + 1424 0 0001 45 0002 + 1425 0 0000 30 1427 + 1426 0 0000 10 9078 CONST + +1412 X2369.. IF ( TE(22) EQL TE(46) ) AND ( TE(46) EQL 1 ) $ CHDD0228 + 1427 0 0000 17 9073 TEMP + 1428 0 0000 36 + 1429 0 0000 10 8648 CONST + 1430 0 0000 40 9757 MX + 1431 0 0000 30 0000 FLTMX + +1431 ( MX (9) = 100 $ GO TO FLTMX ) $ CHDD0229 + 1428 1432 + +1432 T22 = 1000 - ROW (22) $ CHDD0230 + 1432 0 0000 10 8669 CONST + 1433 0 0000 13 9830 ROW + 1434 0 0000 40 8640 T22 + +1435 T6789 = 1000 - ROW(46) - ROW(47) - ROW(48) - ROW(49)$CHDD0231 + 1435 0 0000 11 9856 ROW + 1436 0 0000 13 9857 ROW + 1437 0 0000 13 9855 ROW + 1438 0 0000 13 9854 ROW + 1439 0 0000 12 8669 CONST + 1440 0 0000 40 8637 T6789 + 1441 0 0000 10 9881 TP + 1442 0 0000 13 9882 TP + 1443 0 1111 31 1445 + 1444 0 0000 36 1447 + 1445 0 0001 45 0002 + 1446 0 0000 30 1448 + 1447 0 0000 10 9078 CONST + +1441 IF ( TP(22) EQL TP(23) ) AND ( TP(23) EQL TP(46) ) CHDD0232 + 1448 0 0000 40 9073 TEMP + 1449 0 0000 10 9882 TP + 1450 0 0000 13 9905 TP + 1451 0 1111 31 1453 + 1452 0 0000 36 1455 + 1453 0 0001 45 0002 + 1454 0 0000 30 1456 + 1455 0 0000 10 9078 CONST + 1456 0 0000 17 9073 TEMP + 1457 0 0000 40 9073 TEMP + 1458 0 0000 10 9905 TP + 1459 0 0000 13 9906 TP + 1460 0 1111 31 1462 + 1461 0 0000 36 1464 + 1462 0 0001 45 0002 + 1463 0 0000 30 1465 + 1464 0 0000 10 9078 CONST + 1465 0 0000 17 9073 TEMP + +1456 AND ( TP(46) EQL TP(47) ) AND ( TP(47) EQL TP(48) ) CHDD0233 + 1466 0 0000 40 9073 TEMP + 1467 0 0000 10 9906 TP + 1468 0 0000 13 9907 TP + 1469 0 1111 31 1471 + 1470 0 0000 36 1473 + 1471 0 0001 45 0002 + 1472 0 0000 30 1474 + 1473 0 0000 10 9078 CONST + 1474 0 0000 17 9073 TEMP + 1475 0 0000 40 9073 TEMP + 1476 0 0000 10 9907 TP + 1477 0 0000 13 9908 TP + 1478 0 1111 31 1480 + 1479 0 0000 36 1482 + 1480 0 0001 45 0002 + 1481 0 0000 30 1483 + 1482 0 0000 10 9078 CONST + +1474 AND ( TP(48) EQL TP(49) ) $ CHDD0234 + 1483 0 0000 17 9073 TEMP + 1484 0 0000 36 + 1485 0 0000 10 8669 CONST + 1486 0 0000 13 9831 ROW + 1487 0 0000 14 8640 T22 + 1488 0 0001 49 0010 + 1489 0 0000 14 8637 T6789 + 1490 0 0001 49 0010 + 1490 0 0001 40 9757 MX + 1491 0 0000 30 0000 FLTMX + +1487 ( MX(9) = T22.(1000 - ROW(23)).T6789 $ GO TO FLTMX)$CHDD0235 + 1484 1492 + +1492 IF TP (22) EQL 1 $ CHDD0236 + 1492 0 0000 10 9881 TP + 1493 0 0000 13 9078 CONST + 1494 0 1111 31 1496 + 1495 0 0000 36 1497 + 1496 0 0000 30 + +1492 BEGIN CHDD0237 + 1497 0 0000 10 8636 CONST + 1498 0 0000 40 9075 J + 1499 0 0000 44 + 1500 0 0000 30 + 1501 0 0000 10 9078 CONST + 1502 0 0000 12 9075 J + 1503 0 0000 40 9075 J + 1500 1504 + 1504 0 0000 13 8635 CONST + 1505 0 1111 31 1507 + 1506 0 0000 36 + 1507 0 0001 33 + +1497 FOR J = (46,1,49) $ CHDD0238 + 1508 0 0000 30 + 1507 1509 + 1506 1509 + +1508 BEGIN CHDD0239 + +1508 IF TP (J) EQL 1 $ CHDD0240 + 1509 0 0000 42 9075 J + 1510 1 0000 10 9859 TP + 1511 0 0000 13 9078 CONST + 1512 0 1111 31 1514 + 1513 0 0000 36 1515 + 1514 0 0000 30 + 1515 0 0000 42 9075 J + 1516 1 0000 10 9808 ROW + 1517 0 0000 14 9830 ROW + 1518 0 0001 49 0010 + 1518 0 0001 40 9757 MX + +1519 ( MX(9) = ROW(J).ROW(22) $ GO TO FLTMX ) CHDD0241 + 1519 0 0000 30 0000 FLTMX + 1514 1520 + +1520 END $ CHDD0242 + 1508 1521 + 1499 1520 + 1520 0 0000 30 + 1521 0 0000 10 9830 ROW + 1522 0 0000 14 8637 T6789 + 1523 0 0001 49 0010 + 1523 0 0001 40 9757 MX + +1521 MX (9) = ROW (22).T6789 $ GO TO FLTMX CHDD0243 + 1524 0 0000 30 0000 FLTMX + +1525 END $ CHDD0244 + 1496 1525 + 1525 0 0000 10 8636 CONST + 1526 0 0000 40 9075 J + 1527 0 0000 44 + 1528 0 0000 30 + 1529 0 0000 10 9078 CONST + 1530 0 0000 12 9075 J + 1531 0 0000 40 9075 J + 1528 1532 + 1532 0 0000 13 8635 CONST + 1533 0 1111 31 1535 + 1534 0 0000 36 + 1535 0 0001 33 + +1525 FOR J = (46,1,49) $ CHDD0245 + 1536 0 0000 30 + 1535 1537 + 1534 1537 + +1536 BEGIN CHDD0246 + +1536 IF TP (J) EQL 1 $ CHDD0247 + 1537 0 0000 42 9075 J + 1538 1 0000 10 9859 TP + 1539 0 0000 13 9078 CONST + 1540 0 1111 31 1542 + 1541 0 0000 36 1543 + 1542 0 0000 30 + 1543 0 0000 42 9075 J + 1544 1 0000 10 9808 ROW + 1545 0 0000 14 8640 T22 + 1546 0 0001 49 0010 + 1546 0 0001 40 9757 MX + +1547 ( MX(9) = ROW(J).T22 $ GO TO FLTMX ) CHDD0248 + 1547 0 0000 30 0000 FLTMX + 1542 1548 + +1548 END $ CHDD0249 + 1536 1549 + 1527 1548 + 1548 0 0000 30 + 1549 0 0000 10 9831 ROW + 1550 0 0000 40 9757 MX + +1549 MX (9) = ROW (23) $ GO TO FLTMX $ CHDD0250 + +1549 + 1551 0 0000 30 0000 FLTMX + 1551 1552 + 1547 1552 + 1524 1552 + 1519 1552 + 1491 1552 + 1431 1552 + 1230 1552 + 1227 1552 + 1218 1552 + 1214 1552 + 1200 1552 + 1196 1552 + 1182 1552 + 1142 1552 + 1552 0 0000 10 9078 CONST + 1553 0 0000 40 8653 X + 1554 0 0000 44 + 1555 0 0000 30 + 1556 0 0000 10 9078 CONST + 1557 0 0000 12 8653 X + 1558 0 0000 40 8653 X + 1555 1559 + 1559 0 0000 13 8651 TOTX + 1560 0 1111 31 1562 + 1561 0 0000 36 + 1562 0 0001 33 + +1552 FLTMX.. FOR X = (1,1,TOTX) $ CHDD0251 + 1563 0 0000 30 + 1562 1564 + 1561 1564 + 1564 0 0000 42 8653 X + 1565 1 0000 10 9748 MX + 1566 0 0000 44 8655 FLOAT + 1567 0 0000 30 8655 + 1568 0 0000 42 8653 X + 1569 1 0000 40 9738 FTMX + 1570 0 0000 42 8653 X + 1571 1 0000 10 9738 FTMX + 1572 0 0002 45 0000 + 1573 0 0000 25 8649 CONST + 1574 1 0000 40 9738 FTMX + +1563 ( FTMX(X) = MX(X) $ FTMX(X) = FTMX(X)/100.00 ) $ CHDD0252 + 1563 1576 + 1554 1575 + 1575 0 0000 30 + 1576 0 0000 10 9078 CONST + 1577 0 0000 40 8653 X + 1578 0 0000 44 + 1579 0 0000 30 + 1580 0 0000 10 9078 CONST + 1581 0 0000 12 8653 X + 1582 0 0000 40 8653 X + 1579 1583 + 1583 0 0000 13 8651 TOTX + 1584 0 1111 31 1586 + 1585 0 0000 36 + 1586 0 0001 33 + +1576 FOR X = (1,1,TOTX) $ CHDD0253 + 1587 0 0000 30 + 1586 1588 + 1585 1588 + +1587 PYKX (K) = PYKX (K).FTMX (X) $ CHDD0254 + +1587 + 1588 0 0000 42 9077 K + 1589 1 0000 10 9705 PYKX + 1590 0 0000 42 8653 X + 1591 1 0000 24 9738 FTMX + 1592 0 0000 42 9077 K + 1593 1 0000 40 9705 PYKX + 1587 1595 + 1578 1594 + 1594 0 0000 30 + +1595 COMMENT AT THIS POINT, THE ROW-PRODUCT HAS BEEN COMPUTED CHDD0255 + +1595 AND A TEST IS MADE TO DETERMINE WHETHER THERE CHDD0256 + +1595 ARE MORE ROWS YET TO BE PROCESSED, OR TO PRINT-OUT. $CHDD0257 + +1595 + 1053 1595 + 0864 1595 + +1595 TAL10.. K = K+1 $ CHDD0258 + 1595 0 0000 10 9078 CONST + 1596 0 0000 12 9077 K + 1597 0 0000 40 9077 K + 1598 0 0000 10 9077 K + 1599 0 0000 13 9076 CONST + 1600 0 1111 31 1602 + 1601 0 0000 36 1603 + 1602 0 0000 33 + +1598 IF K LEQ 33 $ GO TO XP10 $ CHDD0259 + 1603 0 0000 30 0784 XP10 + 1602 1604 + +1604 GO TO NORM $ CHDD0260 + +1604 + 1604 0 0000 30 0000 NORM + +1605 COMMENT THE ROW-PROBABILITIES ARE FIRST NORMALIZED TO GIVE A CHDD0261 + +1605 TRUE PERCENTAGE FIGURE AND LINES 4 - 6 ARE PRINTED. $CHDD0262 + +1605 + 1604 1605 + 0622 1605 + +1605 NORM.. SUM = 0.0 $ CHDD0263 + 1605 0 0000 46 8634 SUM + 1606 0 0000 30 + 1607 0 0000 30 + +1606 OUTPUT SHOUT ( OUTSHEET ) $ CHDD0264 + 1608 0 0000 10 8679 OUTSH + 1609 0 0100 42 1609 + 1610 0 0002 20 1607 + 1611 0 0009 43 0000 + 1612 0 0000 30 1607 + 1606 1613 + 1613 0 0000 30 + 1614 0 0004 20 0500 + 1615 2 6268 54 5763 + 1616 2 5654 62 0064 + 1617 3 6245 44 1400 + 1618 0 0004 20 0300 + 1619 0 0004 10 0200 + 1620 0 0006 60 0400 + 1621 1 0000 00 1614 + +1613 FORMAT SHFORM(B5,*SYMPTOMS USED*,B3,A2,W4) $ CHDD0265 + 1613 1622 + 1622 0 0000 10 1623 + 1623 0 0000 01 1607 SHOUT + 1624 0 4400 28 8682 + 1625 1 0000 40 0000 + +1622 WRITE ( $ $ SHOUT , SHFORM ) $ CHDD0266 + 1626 0 0000 10 1627 + 1627 0 0000 01 1614 SHFOR + 1628 0 0000 44 8682 WRITE + 1629 0 0100 30 8682 + 1630 0 0000 10 9078 CONST + 1631 0 0000 40 9077 K + 1632 0 0000 44 + 1633 0 0000 30 + 1634 0 0000 10 9078 CONST + 1635 0 0000 12 9077 K + 1636 0 0000 40 9077 K + 1633 1637 + 1637 0 0000 13 9076 CONST + 1638 0 1111 31 1640 + 1639 0 0000 36 + 1640 0 0001 33 + +1630 FOR K = (1,1,33) $ CHDD0267 + 1641 0 0000 30 + 1640 1642 + 1639 1642 + +1641 SUM = SUM + PYKX (K) $ CHDD0268 + 1642 0 0000 42 9077 K + 1643 1 0000 10 9705 PYKX + 1644 0 0000 22 8634 SUM + 1645 0 0000 40 8634 SUM + 1641 1647 + 1632 1646 + 1646 0 0000 30 + 1647 0 0000 30 + 1648 0 0000 30 + +1647 OUTPUT EQOUT ( EQUATION ) $ CHDD0269 + 1649 0 0000 10 8926 EQUAT + 1650 0 0100 42 1650 + 1651 0 0002 20 1648 + 1652 0 0009 43 0000 + 1653 0 0000 30 1648 + 1647 1654 + 1654 0 0000 30 + 1655 0 0004 20 0500 + 1656 2 4558 64 4163 + 1657 2 4956 55 0064 + 1658 3 6245 44 1400 + 1659 0 0004 90 0500 + 1660 0 0006 60 0600 + 1661 1 0000 00 1655 + +1654 FORMAT EQFORM(B5,*EQUATION USED*,I5,W6) $ CHDD0270 + 1654 1662 + 1662 0 0000 10 1663 + 1663 0 0000 01 1648 EQOUT + 1664 0 4400 28 8682 + 1665 1 0000 40 0000 + +1662 WRITE ( $ $ EQOUT , EQFORM ) $ CHDD0271 + 1666 0 0000 10 1667 + 1667 0 0000 01 1655 EQFOR + 1668 0 0000 44 8682 WRITE + 1669 0 0100 30 8682 + 1670 0 0000 10 9078 CONST + 1671 0 0000 40 9077 K + 1672 0 0000 44 + 1673 0 0000 30 + 1674 0 0000 10 9078 CONST + 1675 0 0000 12 9077 K + 1676 0 0000 40 9077 K + 1673 1677 + 1677 0 0000 13 9076 CONST + 1678 0 1111 31 1680 + 1679 0 0000 36 + 1680 0 0001 33 + +1670 FOR K = (1,1,33) $ CHDD0272 + 1681 0 0000 30 + 1680 1682 + 1679 1682 + +1681 PYX (K) = PYKX (K) / SUM $ CHDD0273 + +1681 + +1681 + +1681 + 1682 0 0000 42 9077 K + 1683 1 0000 10 9705 PYKX + 1684 0 0002 45 0000 + 1685 0 0000 25 8634 SUM + 1686 1 0000 40 9672 PYX + 1681 1688 + 1672 1687 + 1687 0 0000 30 + 1688 0 0000 30 + 1689 0 0004 20 1500 + 1690 2 4449 62 4541 + 1691 3 6245 14 0000 + 1692 0 0004 20 0500 + 1693 2 5759 56 4241 + 1694 2 4249 53 4963 + 1695 3 6814 00 0000 + 1696 0 0006 60 0600 + 1697 1 0000 00 1689 + +1688 FORMAT HEAD(B15,*DISEASE*,B5,*PROBABILITY*,W6) $ CHDD0274 + 1688 1698 + +1698 WRITE ( $ $ HEAD ) $ CHDD0275 + +1698 + 1698 0 0000 10 1699 + 1699 0 0000 01 1689 HEAD + 1700 0 0000 44 8682 WRITE + 1701 0 0000 30 8682 + +1702 COMMENT THE PROBABILITIES ARE NOW PRINTED WHICH ARE ONE CHDD0276 + +1702 PERCENT OR GREATER TOGETHER WITH DISEASE I. D. . $CHDD0277 + +1702 + +1702 K = 1 $ CHDD0278 + 1702 0 0000 10 9078 CONST + 1703 0 0000 40 9077 K + 1704 0 0000 42 9077 K + 1705 1 0000 10 9672 PYX + 1706 0 0000 13 8633 CONST + 1707 0 1111 31 1709 + 1708 0 0000 36 + 1709 0 0000 33 + +1704 PRINT.. IF PYX (K) LSS 0.01 $ GO TO TALPT $ CHDD0279 + 1710 0 0000 30 0000 TALPT + 1709 1711 + 1708 1711 + 1711 0 0001 42 9077 K + 1712 1 0000 30 + +1711 SWITCH K, ( Y01,Y02,Y03,Y04,Y05,Y06,Y07,Y08,Y09, CHDD0280 + +1711 Y10,Y11,Y12,Y13,Y14,Y15,Y16,Y17,Y18,Y19,Y20,Y21, CHDD0281 + 1713 0 0000 30 0000 Y33 + 1714 0 0000 30 0000 Y32 + 1715 0 0000 30 0000 Y31 + 1716 0 0000 30 0000 Y30 + 1717 0 0000 30 0000 Y29 + 1718 0 0000 30 0000 Y28 + 1719 0 0000 30 0000 Y27 + 1720 0 0000 30 0000 Y26 + 1721 0 0000 30 0000 Y25 + 1722 0 0000 30 0000 Y24 + 1723 0 0000 30 0000 Y23 + 1724 0 0000 30 0000 Y22 + 1725 0 0000 30 0000 Y21 + 1726 0 0000 30 0000 Y20 + 1727 0 0000 30 0000 Y19 + 1728 0 0000 30 0000 Y18 + 1729 0 0000 30 0000 Y17 + 1730 0 0000 30 0000 Y16 + 1731 0 0000 30 0000 Y15 + 1732 0 0000 30 0000 Y14 + 1733 0 0000 30 0000 Y13 + 1734 0 0000 30 0000 Y12 + 1735 0 0000 30 0000 Y11 + 1736 0 0000 30 0000 Y10 + 1737 0 0000 30 0000 Y09 + 1738 0 0000 30 0000 Y08 + 1739 0 0000 30 0000 Y07 + 1740 0 0000 30 0000 Y06 + 1741 0 0000 30 0000 Y05 + 1742 0 0000 30 0000 Y04 + 1743 0 0000 30 0000 Y03 + 1744 0 0000 30 0000 Y02 + +1745 Y22,Y23,Y24,Y25,Y26,Y27,Y28,Y29,Y30,Y31,Y32,Y33 ) $CHDD0282 + 1745 0 0000 30 0000 Y01 + 1712 1746 + 1746 0 0000 30 + 1747 0 0000 30 + 1748 0 0000 10 9077 K + 1749 0 0000 40 8653 X + 1750 0 0000 44 + 1751 0 0000 30 + 1752 0 0000 30 + 1751 1753 + 1753 0 0000 42 8653 X + 1754 1 0000 10 9672 PYX + 1755 0 0000 42 1755 + 1756 0 0002 20 1747 + 1752 1758 + 1750 1757 + 1757 0 0000 30 + +1746 OUTPUT ANS ( FOR X = K $ PYX (X) ) $ CHDD0283 + 1758 0 0009 43 0000 + 1759 0 0000 30 1747 + 1746 1760 + 1760 0 0000 30 + 1761 0 0004 20 0800 + 1762 3 6880 81 1400 + 1763 0 0004 20 0700 + 1764 3 5514 00 0000 + 1765 0 0006 20 1604 + 1766 0 0006 60 0000 + 1767 1 0000 00 1761 + +1760 FORMAT FORM1 (B8,*Y01*,B7,*N*,S16.4,W0) $ CHDD0284 + 1760 1768 + 1745 1768 + 1768 0 0000 10 1769 + 1769 0 0000 01 1747 ANS + 1770 0 4400 28 8682 + 1771 1 0000 40 0000 + 1772 0 0000 10 1773 + 1773 0 0000 01 1761 FORM1 + 1774 0 0000 44 8682 WRITE + 1775 0 0100 30 8682 + +1768 Y01.. WRITE ( $ $ ANS , FORM1 ) $ GO TO TALPT $ CHDD0285 + 1776 0 0000 30 0000 TALPT + 1777 0 0000 30 + 1778 0 0004 20 0800 + 1779 3 6880 82 1400 + 1780 0 0004 20 0500 + 1781 2 4100 62 0044 + 1782 3 1400 00 0000 + 1783 0 0006 20 1404 + 1784 0 0006 60 0000 + 1785 1 0000 00 1778 + +1777 FORMAT FORM2 (B8,*Y02*,B5,*A S D*,S14.4,W0) $ CHDD0286 + 1777 1786 + 1744 1786 + 1786 0 0000 10 1787 + 1787 0 0000 01 1747 ANS + 1788 0 4400 28 8682 + 1789 1 0000 40 0000 + 1790 0 0000 10 1791 + 1791 0 0000 01 1778 FORM2 + 1792 0 0000 44 8682 WRITE + 1793 0 0100 30 8682 + +1786 Y02.. WRITE ( $ $ ANS , FORM2 ) $ GO TO TALPT $ CHDD0287 + 1794 0 0000 30 0000 TALPT + 1795 0 0000 30 + 1796 0 0004 20 0800 + 1797 3 6880 83 1400 + 1798 0 0004 20 0200 + 1799 2 4100 62 0044 + 1800 2 0020 00 5700 + 1801 3 6214 00 0000 + 1802 0 0006 20 1104 + 1803 0 0006 60 0000 + 1804 1 0000 00 1796 + +1795 FORMAT FORM3 (B8,*Y03*,B2,*A S D - P S*,S11.4,W0) $ CHDD0288 + 1795 1805 + 1743 1805 + 1805 0 0000 10 1806 + 1806 0 0000 01 1747 ANS + 1807 0 4400 28 8682 + 1808 1 0000 40 0000 + 1809 0 0000 10 1810 + 1810 0 0000 01 1796 FORM3 + 1811 0 0000 44 8682 WRITE + 1812 0 0100 30 8682 + +1805 Y03.. WRITE ( $ $ ANS , FORM3 ) $ GO TO TALPT $ CHDD0289 + 1813 0 0000 30 0000 TALPT + 1814 0 0000 30 + 1815 0 0004 20 0800 + 1816 3 6880 84 1400 + 1817 0 0004 20 0200 + 1818 2 4100 62 0044 + 1819 2 0020 00 5700 + 1820 3 4814 00 0000 + 1821 0 0006 20 1104 + 1822 0 0006 60 0000 + 1823 1 0000 00 1815 + +1814 FORMAT FORM4 (B8,*Y04*,B2,*A S D - P H*,S11.4,W0) $ CHDD0290 + 1814 1824 + 1742 1824 + 1824 0 0000 10 1825 + 1825 0 0000 01 1747 ANS + 1826 0 4400 28 8682 + 1827 1 0000 40 0000 + 1828 0 0000 10 1829 + 1829 0 0000 01 1815 FORM4 + 1830 0 0000 44 8682 WRITE + 1831 0 0100 30 8682 + +1824 Y04.. WRITE ( $ $ ANS , FORM4 ) $ GO TO TALPT $ CHDD0291 + 1832 0 0000 30 0000 TALPT + 1833 0 0000 30 + 1834 0 0004 20 0800 + 1835 3 6880 85 1400 + 1836 0 0004 20 0400 + 1837 2 4300 45 0043 + 1838 3 0044 14 0000 + 1839 0 0006 20 1304 + 1840 0 0006 60 0000 + 1841 1 0000 00 1834 + +1833 FORMAT FORM5 (B8,*Y05*,B4,*C E C D*,S13.4,W0) $ CHDD0292 + 1833 1842 + 1741 1842 + 1842 0 0000 10 1843 + 1843 0 0000 01 1747 ANS + 1844 0 4400 28 8682 + 1845 1 0000 40 0000 + 1846 0 0000 10 1847 + 1847 0 0000 01 1834 FORM5 + 1848 0 0000 44 8682 WRITE + 1849 0 0100 30 8682 + +1842 Y05.. WRITE ( $ $ ANS , FORM5 ) $ GO TO TALPT $ CHDD0293 + 1850 0 0000 30 0000 TALPT + 1851 0 0000 30 + 1852 0 0004 20 0800 + 1853 3 6880 86 1400 + 1854 0 0004 20 0300 + 1855 2 5700 41 0057 + 1856 3 0065 00 4314 + 1857 0 0006 20 1204 + 1858 0 0006 60 0000 + 1859 1 0000 00 1852 + +1851 FORMAT FORM6 (B8,*Y06*,B3,*P A P V C*,S12.4,W0) $ CHDD0294 + 1851 1860 + 1740 1860 + 1860 0 0000 10 1861 + 1861 0 0000 01 1747 ANS + 1862 0 4400 28 8682 + 1863 1 0000 40 0000 + 1864 0 0000 10 1865 + 1865 0 0000 01 1852 FORM6 + 1866 0 0000 44 8682 WRITE + 1867 0 0100 30 8682 + +1860 Y06.. WRITE ( $ $ ANS , FORM6 ) $ GO TO TALPT $ CHDD0295 + 1868 0 0000 30 0000 TALPT + 1869 0 0000 30 + 1870 0 0004 20 0800 + 1871 3 6880 87 1400 + 1872 0 0004 20 0300 + 1873 2 6300 41 0057 + 1874 3 0065 00 4314 + 1875 0 0006 20 1204 + 1876 0 0006 60 0000 + 1877 1 0000 00 1870 + +1869 FORMAT FORM7 (B8,*Y07*,B3,*T A P V C*,S12.4,W0) $ CHDD0296 + 1869 1878 + 1739 1878 + 1878 0 0000 10 1879 + 1879 0 0000 01 1747 ANS + 1880 0 4400 28 8682 + 1881 1 0000 40 0000 + 1882 0 0000 10 1883 + 1883 0 0000 01 1870 FORM7 + 1884 0 0000 44 8682 WRITE + 1885 0 0100 30 8682 + +1878 Y07.. WRITE ( $ $ ANS , FORM7 ) $ GO TO TALPT $ CHDD0297 + 1886 0 0000 30 0000 TALPT + 1887 0 0000 30 + 1888 0 0004 20 0800 + 1889 3 6880 88 1400 + 1890 0 0004 20 0600 + 1891 3 6300 41 1400 + 1892 0 0006 20 1504 + 1893 0 0006 60 0000 + 1894 1 0000 00 1888 + +1887 FORMAT FORM8 (B8,*Y08*,B6,*T A*,S15.4,W0) $ CHDD0298 + 1887 1895 + 1738 1895 + 1895 0 0000 10 1896 + 1896 0 0000 01 1747 ANS + 1897 0 4400 28 8682 + 1898 1 0000 40 0000 + 1899 0 0000 10 1900 + 1900 0 0000 01 1888 FORM8 + 1901 0 0000 44 8682 WRITE + 1902 0 0100 30 8682 + +1895 Y08.. WRITE ( $ $ ANS , FORM8 ) $ GO TO TALPT $ CHDD0299 + 1903 0 0000 30 0000 TALPT + 1904 0 0000 30 + 1905 0 0004 20 0800 + 1906 3 6880 89 1400 + 1907 0 0004 20 0500 + 1908 2 4542 62 6303 + 1909 3 1400 00 0000 + 1910 0 0006 20 1404 + 1911 0 0006 60 0000 + 1912 1 0000 00 1905 + +1904 FORMAT FORM9 (B8,*Y09*,B5,*EBST.*,S14.4,W0) $ CHDD0300 + 1904 1913 + 1737 1913 + 1913 0 0000 10 1914 + 1914 0 0000 01 1747 ANS + 1915 0 4400 28 8682 + 1916 1 0000 40 0000 + 1917 0 0000 10 1918 + 1918 0 0000 01 1905 FORM9 + 1919 0 0000 44 8682 WRITE + 1920 0 0100 30 8682 + +1913 Y09.. WRITE ( $ $ ANS , FORM9 ) $ GO TO TALPT $ CHDD0301 + 1921 0 0000 30 0000 TALPT + 1922 0 0000 30 + 1923 0 0004 20 0800 + 1924 3 6881 80 1400 + 1925 0 0004 20 0100 + 1926 2 6500 62 0044 + 1927 2 0020 00 6500 + 1928 3 5700 62 1400 + 1929 0 0006 20 1004 + 1930 0 0006 60 0000 + 1931 1 0000 00 1923 + +1922 FORMAT FORM10(B8,*Y10*,B1,*V S D - V P S*,S10.4,W0) $ CHDD0302 + 1922 1932 + 1736 1932 + 1932 0 0000 10 1933 + 1933 0 0000 01 1747 ANS + 1934 0 4400 28 8682 + 1935 1 0000 40 0000 + 1936 0 0000 10 1937 + 1937 0 0000 01 1923 FORM1 + 1938 0 0000 44 8682 WRITE + 1939 0 0100 30 8682 + +1932 Y10.. WRITE ( $ $ ANS , FORM10 ) $ GO TO TALPT $ CHDD0303 + 1940 0 0000 30 0000 TALPT + 1941 0 0000 30 + 1942 0 0004 20 0800 + 1943 3 6881 81 1400 + 1944 0 0004 20 0100 + 1945 2 6500 62 0044 + 1946 2 0020 00 4900 + 1947 3 5700 62 1400 + 1948 0 0006 20 1004 + 1949 0 0006 60 0000 + 1950 1 0000 00 1942 + +1941 FORMAT FORM11(B8,*Y11*,B1,*V S D - I P S*,S10.4,W0) $ CHDD0304 + 1941 1951 + 1735 1951 + 1951 0 0000 10 1952 + 1952 0 0000 01 1747 ANS + 1953 0 4400 28 8682 + 1954 1 0000 40 0000 + 1955 0 0000 10 1956 + 1956 0 0000 01 1942 FORM1 + 1957 0 0000 44 8682 WRITE + 1958 0 0100 30 8682 + +1951 Y11.. WRITE ( $ $ ANS , FORM11 ) $ GO TO TALPT $ CHDD0305 + 1959 0 0000 30 0000 TALPT + 1960 0 0000 30 + 1961 0 0004 20 0800 + 1962 3 6881 82 1400 + 1963 0 0004 20 0500 + 1964 2 6500 57 0062 + 1965 3 1400 00 0000 + 1966 0 0006 20 1404 + 1967 0 0006 60 0000 + 1968 1 0000 00 1961 + +1960 FORMAT FORM12(B8,*Y12*,B5,*V P S*,S14.4,W0) $ CHDD0306 + 1960 1969 + 1734 1969 + 1969 0 0000 10 1970 + 1970 0 0000 01 1747 ANS + 1971 0 4400 28 8682 + 1972 1 0000 40 0000 + 1973 0 0000 10 1974 + 1974 0 0000 01 1961 FORM1 + 1975 0 0000 44 8682 WRITE + 1976 0 0100 30 8682 + +1969 Y12.. WRITE ( $ $ ANS , FORM12 ) $ GO TO TALPT $ CHDD0307 + 1977 0 0000 30 0000 TALPT + 1978 0 0000 30 + 1979 0 0004 20 0800 + 1980 3 6881 83 1400 + 1981 0 0004 20 0500 + 1982 2 4900 57 0062 + 1983 3 1400 00 0000 + 1984 0 0006 20 1404 + 1985 0 0006 60 0000 + 1986 1 0000 00 1979 + +1978 FORMAT FORM13(B8,*Y13*,B5,*I P S*,S14.4,W0) $ CHDD0308 + 1978 1987 + 1733 1987 + 1987 0 0000 10 1988 + 1988 0 0000 01 1747 ANS + 1989 0 4400 28 8682 + 1990 1 0000 40 0000 + 1991 0 0000 10 1992 + 1992 0 0000 01 1979 FORM1 + 1993 0 0000 44 8682 WRITE + 1994 0 0100 30 8682 + +1987 Y13.. WRITE ( $ $ ANS , FORM13 ) $ GO TO TALPT $ CHDD0309 + 1995 0 0000 30 0000 TALPT + 1996 0 0000 30 + 1997 0 0004 20 0800 + 1998 3 6881 84 1400 + 1999 0 0004 20 0300 + 2000 2 5703 00 4163 + 2001 3 5945 62 0314 + 2002 0 0006 20 1204 + 2003 0 0006 60 0000 + 2004 1 0000 00 1997 + +1996 FORMAT FORM14(B8,*Y14*,B3,*P. ATRES.*,S12.4,W0) $ CHDD0310 + 1996 2005 + 1732 2005 + 2005 0 0000 10 2006 + 2006 0 0000 01 1747 ANS + 2007 0 4400 28 8682 + 2008 1 0000 40 0000 + 2009 0 0000 10 2010 + 2010 0 0000 01 1997 FORM1 + 2011 0 0000 44 8682 WRITE + 2012 0 0100 30 8682 + +2005 Y14.. WRITE ( $ $ ANS , FORM14 ) $ GO TO TALPT $ CHDD0311 + 2013 0 0000 30 0000 TALPT + 2014 0 0000 30 + 2015 0 0004 20 0800 + 2016 3 6881 85 1400 + 2017 0 0004 20 0200 + 2018 2 4356 41 5943 + 2019 2 6303 00 5700 + 2020 3 4114 00 0000 + 2021 0 0006 20 1104 + 2022 0 0006 60 0000 + 2023 1 0000 00 2015 + +2014 FORMAT FORM15(B8,*Y15*,B2,*COARCT. P A*,S11.4,W0) $ CHDD0312 + 2014 2024 + 1731 2024 + 2024 0 0000 10 2025 + 2025 0 0000 01 1747 ANS + 2026 0 4400 28 8682 + 2027 1 0000 40 0000 + 2028 0 0000 10 2029 + 2029 0 0000 01 2015 FORM1 + 2030 0 0000 44 8682 WRITE + 2031 0 0100 30 8682 + +2024 Y15.. WRITE ( $ $ ANS , FORM15 ) $ GO TO TALPT $ CHDD0313 + 2032 0 0000 30 0000 TALPT + 2033 0 0000 30 + 2034 0 0004 20 0800 + 2035 3 6881 86 1400 + 2036 0 0004 20 0600 + 2037 3 5700 48 1400 + 2038 0 0006 20 1504 + 2039 0 0006 60 0000 + 2040 1 0000 00 2034 + +2033 FORMAT FORM16(B8,*Y16*,B6,*P H*,S15.4,W0) $ CHDD0314 + 2033 2041 + 1730 2041 + 2041 0 0000 10 2042 + 2042 0 0000 01 1747 ANS + 2043 0 4400 28 8682 + 2044 1 0000 40 0000 + 2045 0 0000 10 2046 + 2046 0 0000 01 2034 FORM1 + 2047 0 0000 44 8682 WRITE + 2048 0 0100 30 8682 + +2041 Y16.. WRITE ( $ $ ANS , FORM16 ) $ GO TO TALPT $ CHDD0315 + 2049 0 0000 30 0000 TALPT + 2050 0 0000 30 + 2051 0 0004 20 0800 + 2052 3 6881 87 1400 + 2053 0 0004 20 0500 + 2054 2 4100 57 0066 + 2055 3 1400 00 0000 + 2056 0 0006 20 1404 + 2057 0 0006 60 0000 + 2058 1 0000 00 2051 + +2050 FORMAT FORM17(B8,*Y17*,B5,*A P W*,S14.4,W0) $ CHDD0316 + 2050 2059 + 1729 2059 + 2059 0 0000 10 2060 + 2060 0 0000 01 1747 ANS + 2061 0 4400 28 8682 + 2062 1 0000 40 0000 + 2063 0 0000 10 2064 + 2064 0 0000 01 2051 FORM1 + 2065 0 0000 44 8682 WRITE + 2066 0 0100 30 8682 + +2059 Y17.. WRITE ( $ $ ANS , FORM17 ) $ GO TO TALPT $ CHDD0317 + 2067 0 0000 30 0000 TALPT + 2068 0 0000 30 + 2069 0 0004 20 0800 + 2070 3 6881 88 1400 + 2071 0 0004 20 0500 + 2072 2 5700 44 0041 + 2073 3 1400 00 0000 + 2074 0 0006 20 1404 + 2075 0 0006 60 0000 + 2076 1 0000 00 2069 + +2068 FORMAT FORM18(B8,*Y18*,B5,*P D A*,S14.4,W0) $ CHDD0318 + 2068 2077 + 1728 2077 + 2077 0 0000 10 2078 + 2078 0 0000 01 1747 ANS + 2079 0 4400 28 8682 + 2080 1 0000 40 0000 + 2081 0 0000 10 2082 + 2082 0 0000 01 2069 FORM1 + 2083 0 0000 44 8682 WRITE + 2084 0 0100 30 8682 + +2077 Y18.. WRITE ( $ $ ANS , FORM18 ) $ GO TO TALPT $ CHDD0319 + 2085 0 0000 30 0000 TALPT + 2086 0 0000 30 + 2087 0 0004 20 0800 + 2088 3 6881 89 1400 + 2089 0 0004 20 0200 + 2090 2 5700 41 2065 + 2091 2 0046 49 6263 + 2092 3 0314 00 0000 + 2093 0 0006 20 1104 + 2094 0 0006 60 0000 + 2095 1 0000 00 2087 + +2086 FORMAT FORM19(B8,*Y19*,B2,*P A-V FIST.*,S11.4,W0) $ CHDD0320 + 2086 2096 + 1727 2096 + 2096 0 0000 10 2097 + 2097 0 0000 01 1747 ANS + 2098 0 4400 28 8682 + 2099 1 0000 40 0000 + 2100 0 0000 10 2101 + 2101 0 0000 01 2087 FORM1 + 2102 0 0000 44 8682 WRITE + 2103 0 0100 30 8682 + +2096 Y19.. WRITE ( $ $ ANS , FORM19 ) $ GO TO TALPT $ CHDD0321 + 2104 0 0000 30 0000 TALPT + 2105 0 0000 30 + 2106 0 0004 20 0800 + 2107 3 6882 80 1400 + 2108 0 0004 20 0600 + 2109 3 5400 62 1400 + 2110 0 0006 20 1504 + 2111 0 0006 60 0000 + 2112 1 0000 00 2106 + +2105 FORMAT FORM20(B8,*Y20*,B6,*M S*,S15.4,W0) $ CHDD0322 + 2105 2113 + 1726 2113 + 2113 0 0000 10 2114 + 2114 0 0000 01 1747 ANS + 2115 0 4400 28 8682 + 2116 1 0000 40 0000 + 2117 0 0000 10 2118 + 2118 0 0000 01 2106 FORM2 + 2119 0 0000 44 8682 WRITE + 2120 0 0100 30 8682 + +2113 Y20.. WRITE ( $ $ ANS , FORM20 ) $ GO TO TALPT $ CHDD0323 + 2121 0 0000 30 0000 TALPT + 2122 0 0000 30 + 2123 0 0004 20 0800 + 2124 3 6882 81 1400 + 2125 0 0004 20 0400 + 2126 2 5468 56 4303 + 2127 3 0044 14 0000 + 2128 0 0006 20 1304 + 2129 0 0006 60 0000 + 2130 1 0000 00 2123 + +2122 FORMAT FORM21(B8,*Y21*,B4,*MYOC. D*,S13.4,W0) $ CHDD0324 + 2122 2131 + 1725 2131 + 2131 0 0000 10 2132 + 2132 0 0000 01 1747 ANS + 2133 0 4400 28 8682 + 2134 1 0000 40 0000 + 2135 0 0000 10 2136 + 2136 0 0000 01 2123 FORM2 + 2137 0 0000 44 8682 WRITE + 2138 0 0100 30 8682 + +2131 Y21.. WRITE ( $ $ ANS , FORM21 ) $ GO TO TALPT $ CHDD0325 + 2139 0 0000 30 0000 TALPT + 2140 0 0000 30 + 2141 0 0004 20 0800 + 2142 3 6882 82 1400 + 2143 0 0004 20 0200 + 2144 2 4100 56 0043 + 2145 2 5659 03 0041 + 2146 3 1400 00 0000 + 2147 0 0006 20 1204 + 2148 0 0006 60 0000 + 2149 1 0000 00 2141 + +2140 FORMAT FORM22(B8,*Y22*,B2,*A O COR. A*,S12.4,W0) $ CHDD0326 + 2140 2150 + 1724 2150 + 2150 0 0000 10 2151 + 2151 0 0000 01 1747 ANS + 2152 0 4400 28 8682 + 2153 1 0000 40 0000 + 2154 0 0000 10 2155 + 2155 0 0000 01 2141 FORM2 + 2156 0 0000 44 8682 WRITE + 2157 0 0100 30 8682 + +2150 Y22.. WRITE ( $ $ ANS , FORM22 ) $ GO TO TALPT $ CHDD0327 + 2158 0 0000 30 0000 TALPT + 2159 0 0000 30 + 2160 0 0004 20 0800 + 2161 3 6882 83 1400 + 2162 0 0004 20 0200 + 2163 2 4100 62 0020 + 2164 2 0065 41 5365 + 2165 3 0314 00 0000 + 2166 0 0006 20 1104 + 2167 0 0006 60 0000 + 2168 1 0000 00 2160 + +2159 FORMAT FORM23(B8,*Y23*,B2,*A S - VALV.*,S11.4,W0) $ CHDD0328 + 2159 2169 + 1723 2169 + 2169 0 0000 10 2170 + 2170 0 0000 01 1747 ANS + 2171 0 4400 28 8682 + 2172 1 0000 40 0000 + 2173 0 0000 10 2174 + 2174 0 0000 01 2160 FORM2 + 2175 0 0000 44 8682 WRITE + 2176 0 0100 30 8682 + +2169 Y23.. WRITE ( $ $ ANS , FORM23 ) $ GO TO TALPT $ CHDD0329 + 2177 0 0000 30 0000 TALPT + 2178 0 0000 30 + 2179 0 0004 20 0800 + 2180 3 6882 84 1400 + 2181 0 0004 20 0200 + 2182 2 4100 62 0020 + 2183 2 0062 64 4203 + 2184 3 1400 00 0000 + 2185 0 0006 20 1204 + 2186 0 0006 60 0000 + 2187 1 0000 00 2179 + +2178 FORMAT FORM24(B8,*Y24*,B2,*A S - SUB.*,S12.4,W0) $ CHDD0330 + 2178 2188 + 1722 2188 + 2188 0 0000 10 2189 + 2189 0 0000 01 1747 ANS + 2190 0 4400 28 8682 + 2191 1 0000 40 0000 + 2192 0 0000 10 2193 + 2193 0 0000 01 2179 FORM2 + 2194 0 0000 44 8682 WRITE + 2195 0 0100 30 8682 + +2188 Y24.. WRITE ( $ $ ANS , FORM24 ) $ GO TO TALPT $ CHDD0331 + 2196 0 0000 30 0000 TALPT + 2197 0 0000 30 + 2198 0 0004 20 0800 + 2199 3 6882 85 1400 + 2200 0 0004 20 0300 + 2201 2 4356 41 5943 + 2202 3 6303 00 4114 + 2203 0 0006 20 1204 + 2204 0 0006 60 0000 + 2205 1 0000 00 2198 + +2197 FORMAT FORM25(B8,*Y25*,B3,*COARCT. A*,S12.4,W0) $ CHDD0332 + 2197 2206 + 1721 2206 + 2206 0 0000 10 2207 + 2207 0 0000 01 1747 ANS + 2208 0 4400 28 8682 + 2209 1 0000 40 0000 + 2210 0 0000 10 2211 + 2211 0 0000 01 2198 FORM2 + 2212 0 0000 44 8682 WRITE + 2213 0 0100 30 8682 + +2206 Y25.. WRITE ( $ $ ANS , FORM25 ) $ GO TO TALPT $ CHDD0333 + 2214 0 0000 30 0000 TALPT + 2215 0 0000 30 + 2216 0 0004 20 0800 + 2217 3 6882 86 1400 + 2218 0 0004 20 0400 + 2219 2 6359 64 5543 + 2220 3 0314 00 0000 + 2221 0 0006 20 1404 + 2222 0 0006 60 0000 + 2223 1 0000 00 2216 + +2215 FORMAT FORM26(B8,*Y26*,B4,*TRUNC.*,S14.4,W0) $ CHDD0334 + 2215 2224 + 1720 2224 + 2224 0 0000 10 2225 + 2225 0 0000 01 1747 ANS + 2226 0 4400 28 8682 + 2227 1 0000 40 0000 + 2228 0 0000 10 2229 + 2229 0 0000 01 2216 FORM2 + 2230 0 0000 44 8682 WRITE + 2231 0 0100 30 8682 + +2224 Y26.. WRITE ( $ $ ANS , FORM26 ) $ GO TO TALPT $ CHDD0335 + 2232 0 0000 30 0000 TALPT + 2233 0 0000 30 + 2234 0 0004 20 0800 + 2235 3 6882 87 1400 + 2236 0 0004 20 0300 + 2237 2 6359 41 5562 + 2238 3 5703 14 0000 + 2239 0 0006 20 1404 + 2240 0 0006 60 0000 + 2241 1 0000 00 2234 + +2233 FORMAT FORM27(B8,*Y27*,B3,*TRANSP.*,S14.4,W0) $ CHDD0336 + 2233 2242 + 1719 2242 + 2242 0 0000 10 2243 + 2243 0 0000 01 1747 ANS + 2244 0 4400 28 8682 + 2245 1 0000 40 0000 + 2246 0 0000 10 2247 + 2247 0 0000 01 2234 FORM2 + 2248 0 0000 44 8682 WRITE + 2249 0 0100 30 8682 + +2242 Y27.. WRITE ( $ $ ANS , FORM27 ) $ GO TO TALPT $ CHDD0337 + 2250 0 0000 30 0000 TALPT + 2251 0 0000 30 + 2252 0 0004 20 0800 + 2253 3 6882 88 1400 + 2254 0 0004 20 0300 + 2255 2 4300 63 5941 + 2256 3 5562 57 0314 + 2257 0 0006 20 1204 + 2258 0 0006 60 0000 + 2259 1 0000 00 2252 + +2251 FORMAT FORM28(B8,*Y28*,B3,*C TRANSP.*,S12.4,W0) $ CHDD0338 + 2251 2260 + 1718 2260 + 2260 0 0000 10 2261 + 2261 0 0000 01 1747 ANS + 2262 0 4400 28 8682 + 2263 1 0000 40 0000 + 2264 0 0000 10 2265 + 2265 0 0000 01 2252 FORM2 + 2266 0 0000 44 8682 WRITE + 2267 0 0100 30 8682 + +2260 Y28.. WRITE ( $ $ ANS , FORM28 ) $ GO TO TALPT $ CHDD0339 + 2268 0 0000 30 0000 TALPT + 2269 0 0000 30 + 2270 0 0004 20 0800 + 2271 3 6882 89 1400 + 2272 0 0004 20 0400 + 2273 2 4142 03 0041 + 2274 3 0056 14 0000 + 2275 0 0006 20 1304 + 2276 0 0006 60 0000 + 2277 1 0000 00 2270 + +2269 FORMAT FORM29(B8,*Y29*,B4,*AB. A O*,S13.4,W0) $ CHDD0340 + 2269 2278 + 1717 2278 + 2278 0 0000 10 2279 + 2279 0 0000 01 1747 ANS + 2280 0 4400 28 8682 + 2281 1 0000 40 0000 + 2282 0 0000 10 2283 + 2283 0 0000 01 2270 FORM2 + 2284 0 0000 44 8682 WRITE + 2285 0 0100 30 8682 + +2278 Y29.. WRITE ( $ $ ANS , FORM29 ) $ GO TO TALPT $ CHDD0341 + 2286 0 0000 30 0000 TALPT + 2287 0 0000 30 + 2288 0 0004 20 0800 + 2289 3 6883 80 1400 + 2290 0 0004 20 0500 + 2291 2 6500 62 0044 + 2292 3 1400 00 0000 + 2293 0 0006 20 1404 + 2294 0 0006 60 0000 + 2295 1 0000 00 2288 + +2287 FORMAT FORM30(B8,*Y30*,B5,*V S D*,S14.4,W0) $ CHDD0342 + 2287 2296 + 1716 2296 + 2296 0 0000 10 2297 + 2297 0 0000 01 1747 ANS + 2298 0 4400 28 8682 + 2299 1 0000 40 0000 + 2300 0 0000 10 2301 + 2301 0 0000 01 2288 FORM3 + 2302 0 0000 44 8682 WRITE + 2303 0 0100 30 8682 + +2296 Y30.. WRITE ( $ $ ANS , FORM30 ) $ GO TO TALPT $ CHDD0343 + 2304 0 0000 30 0000 TALPT + 2305 0 0000 30 + 2306 0 0004 20 0800 + 2307 3 6883 81 1400 + 2308 0 0004 20 0200 + 2309 2 6500 62 0044 + 2310 2 0020 00 5700 + 2311 3 4814 00 0000 + 2312 0 0006 20 1104 + 2313 0 0006 60 0000 + 2314 1 0000 00 2306 + +2305 FORMAT FORM31(B8,*Y31*,B2,*V S D - P H*,S11.4,W0) $ CHDD0344 + 2305 2315 + 1715 2315 + 2315 0 0000 10 2316 + 2316 0 0000 01 1747 ANS + 2317 0 4400 28 8682 + 2318 1 0000 40 0000 + 2319 0 0000 10 2320 + 2320 0 0000 01 2306 FORM3 + 2321 0 0000 44 8682 WRITE + 2322 0 0100 30 8682 + +2315 Y31.. WRITE ( $ $ ANS , FORM31 ) $ GO TO TALPT $ CHDD0345 + 2323 0 0000 30 0000 TALPT + 2324 0 0000 30 + 2325 0 0004 20 0800 + 2326 3 6883 82 1400 + 2327 0 0004 20 0200 + 2328 2 5700 44 0041 + 2329 2 0020 00 5700 + 2330 3 4814 00 0000 + 2331 0 0006 20 1104 + 2332 0 0006 60 0000 + 2333 1 0000 00 2325 + +2324 FORMAT FORM32(B8,*Y32*,B2,*P D A - P H*,S11.4,W0) $ CHDD0346 + 2324 2334 + 1714 2334 + 2334 0 0000 10 2335 + 2335 0 0000 01 1747 ANS + 2336 0 4400 28 8682 + 2337 1 0000 40 0000 + 2338 0 0000 10 2339 + 2339 0 0000 01 2325 FORM3 + 2340 0 0000 44 8682 WRITE + 2341 0 0100 30 8682 + +2334 Y32.. WRITE ( $ $ ANS , FORM32 ) $ GO TO TALPT $ CHDD0347 + 2342 0 0000 30 0000 TALPT + 2343 0 0000 30 + 2344 0 0004 20 0800 + 2345 3 6883 83 1400 + 2346 0 0004 20 0100 + 2347 2 6300 41 0020 + 2348 2 0063 59 4155 + 2349 3 6257 03 1400 + 2350 0 0006 20 1004 + 2351 0 0006 60 0000 + 2352 1 0000 00 2344 + +2343 FORMAT FORM33(B8,*Y33*,B1,*T A - TRANSP.*,S10.4,W0) $ CHDD0348 + 2343 2353 + 1713 2353 + 2353 0 0000 10 2354 + 2354 0 0000 01 1747 ANS + 2355 0 4400 28 8682 + 2356 1 0000 40 0000 + 2357 0 0000 10 2358 + 2358 0 0000 01 2344 FORM3 + 2359 0 0000 44 8682 WRITE + 2360 0 0100 30 8682 + +2353 Y33.. WRITE ( $ $ ANS , FORM33 ) $ GO TO TALPT $ CHDD0349 + +2353 + 2361 0 0000 30 0000 TALPT + 2361 2362 + 2342 2362 + 2323 2362 + 2304 2362 + 2286 2362 + 2268 2362 + 2250 2362 + 2232 2362 + 2214 2362 + 2196 2362 + 2177 2362 + 2158 2362 + 2139 2362 + 2121 2362 + 2104 2362 + 2085 2362 + 2067 2362 + 2049 2362 + 2032 2362 + 2013 2362 + 1995 2362 + 1977 2362 + 1959 2362 + 1940 2362 + 1921 2362 + 1903 2362 + 1886 2362 + 1868 2362 + 1850 2362 + 1832 2362 + 1813 2362 + 1794 2362 + 1776 2362 + 1710 2362 + +2362 TALPT.. K = K+1 $ CHDD0350 + 2362 0 0000 10 9078 CONST + 2363 0 0000 12 9077 K + 2364 0 0000 40 9077 K + 2365 0 0000 10 9077 K + 2366 0 0000 13 9076 CONST + 2367 0 1111 31 2369 + 2368 0 0000 36 2370 + 2369 0 0000 33 + +2365 IF K LEQ 33 $ GO TO PRINT $ CHDD0351 + +2365 + 2370 0 0000 30 1704 PRINT + 2369 2371 + +2371 COMMENT PROGRAM REPEATS TO BEGINNING IF THERE ARE MORE CHDD0352 + +2371 CASES TO BE RUN, AND HALTS IF NOT. THE INITIALS CHDD0353 + +2371 H W APPEAR IN THE A-REG. UPON COMPLETION. $CHDD0354 + +2371 + 2371 0 0000 10 8922 LAST + 2372 0 0000 36 2374 + 2373 0 0000 30 + +2371 IF LAST EQL 0 $ GO TO NEWCASE $ CHDD0355 + 2374 0 0000 30 0243 NEWCA + 2373 2375 + 2375 0 0000 10 8632 CONST + 2376 0 0137 00 7310 + +2375 STOP 7270061216 $ GO TO NEWCASE $ CHDD0356 + 2377 0 0000 30 0243 NEWCA + +2378 FINISH $ CHDD0357 + 2378 0 9669 00 9669 + 2379 0 1000 60 0000 + 9078 0 0000 00 0001 POOL + 8932 0 0000 00 0020 + 8931 0 0000 00 0050 + 8677 0 0000 00 0010 + 9076 0 0000 00 0033 + 9074 0 0000 00 0018 + 8680 0 6600 00 0000 + 8678 0 4200 00 0000 + 8676 0 0000 00 0008 + 8675 0 0000 00 0016 + 8674 0 0000 00 0024 + 8673 0 0000 00 0025 + 8672 0 0000 00 0030 + 8671 0 0000 00 0038 + 8670 0 0000 00 0039 + 8669 0 0000 00 1000 + 8650 0 0000 00 0015 + 8648 0 0000 00 0100 + 8647 0 0000 00 0007 + 8646 0 0000 00 0003 + 8645 0 0000 00 0026 + 8644 0 0000 00 0028 + 8643 0 0000 00 0034 + 8642 0 0000 00 0036 + 8636 0 0000 00 0046 + 8635 0 0000 00 0049 + 8632 0 7270 06 1216 + 8649 0 5310 00 0000 + 8633 0 4910 00 0000 +2380 UNPACK + 0804 2380 + 0803 2380 + 0789 2380 + 0502 2380 + 0501 2380 + 0487 2380 + 2380 0 2485 01 0000 + 2381 0 0002 40 2468 + 2382 0 0001 40 2469 + 2383 0 0000 46 2466 + 2384 0 0000 10 2480 + 2385 0 0410 40 2470 + 2386 0 0401 26 2470 + 2387 0 0000 10 2471 + 2388 0 0000 41 2481 + 2389 0 0210 37 2392 + 2390 0 0216 26 2466 + 2391 0 0000 30 2433 + 2392 0 0204 26 2466 + 2393 0 0000 44 2445 + 2394 0 0000 30 2446 + 2395 0 0205 26 2466 + 2396 0 0421 26 2470 + 2397 0 0000 10 2474 + 2398 0 0000 44 2445 + 2399 0 0000 30 2446 + 2400 0 0000 01 0000 + 2401 0 0427 26 2470 + 2402 0 0000 10 2476 + 2403 0 0000 44 2445 + 2404 0 0000 30 2446 + 2405 0 0000 10 2483 + 2406 0 0201 36 2420 + 2407 0 0000 10 2470 + 2408 0 0410 40 2415 + 2409 0 0000 01 0000 + 2410 0 0201 26 2466 + 2411 0 0433 27 2470 + 2412 0 0000 10 2472 + 2413 0 0000 44 2445 + 2414 0 0000 30 2446 + 2415 0 0000 46 0000 + 2416 0 0000 30 2440 + 2417 0 0000 01 0000 + 2418 0 0000 01 0000 + 2419 0 0000 01 0000 + 2420 0 0000 10 2480 + 2421 0 0000 12 2477 + 2422 0 0410 40 2428 + 2423 0 0000 10 2485 + 2424 0 0000 12 2473 + 2425 0 0410 40 2426 + 2426 0 0000 10 0000 + 2427 0 0000 48 0006 + 2428 0 0310 40 0000 + 2429 0 0000 01 0000 + 2430 0 0202 26 2466 + 2431 0 0409 27 2470 + 2432 0 0000 10 2475 + 2433 0 0000 44 2445 + 2434 0 0000 30 2446 + 2435 0 0000 30 2440 + 2436 0 0000 01 0000 + 2437 0 0000 01 0000 + 2438 0 0000 01 0000 + 2439 0 0000 01 0000 + 2440 0 0000 42 2468 + 2441 0 0000 41 2469 + 2442 0 0000 10 2380 + 2443 0 0410 40 2444 + 2444 0 0000 30 0000 + 2445 0 0000 30 0000 + 2446 0 0000 42 2470 + 2447 0 0000 12 2485 + 2448 0 0410 40 2452 + 2449 0 0410 40 2450 + 2450 0 0000 41 0000 + 2451 0 0401 26 2452 + 2452 0 0000 10 0000 + 2453 0 0001 49 0004 + 2454 1 0310 40 0000 + 2455 0 0001 20 2456 + 2456 0 0001 49 0003 + 2457 1 0310 40 0000 + 2458 0 0001 20 2459 + 2459 0 0001 49 0003 + 2460 1 0310 40 0000 + 2461 0 0001 20 2462 + 2462 0 0201 27 2466 + 2463 0 0000 32 2451 + 2464 0 0000 46 2466 + 2465 0 0000 30 2445 + 2466 0 0000 00 0001 + 2467 0 0000 01 0000 + 2468 0 0000 01 0000 + 2469 0 0000 01 0000 + 2470 0 0000 01 0000 + 2471 0 0000 00 0002 + 2472 0 0000 00 0007 + 2473 0 0000 00 0008 + 2474 0 0000 00 0009 + 2475 0 0000 00 0015 + 2476 0 0000 00 0018 + 2477 0 0000 00 0019 + 2478 0 0000 00 0001 +2486 FINISH $ + 8655 0 0006 45 0000 + 8656 0 2200 36 8659 + 8657 0 0000 48 0001 + 8658 0 0001 20 8656 + 8659 0 0001 48 0008 + 8660 1 0000 10 8665 + 8661 0 0001 49 0008 + 8662 0 0000 22 8668 + 8663 0 0000 42 8655 + 8664 1 0000 30 0000 + 8665 0 0000 00 0058 + 8666 0 0000 00 0059 + 8667 0 0000 00 0060 + 8668 0 5800 00 0000 + 8682 0 0100 01 0000 + 8683 0 0410 40 8718 + 8684 0 0000 42 8686 + 8685 0 0010 29 8918 + 8686 0 0300 29 0101 + 8687 0 0000 42 8682 + 8688 0 0412 40 8767 + 8689 1 0000 41 9999 + 8690 0 0009 43 7557 + 8691 0 2200 37 8695 + 8692 0 0000 42 0100 + 8693 1 0000 44 0000 + 8694 1 2201 37 0001 + 8695 0 0000 40 0132 + 8696 0 0412 40 8749 + 8697 0 0000 41 0130 + 8698 0 0000 37 8716 + 8699 0 0000 10 0134 + 8700 0 0000 46 0133 + 8701 0 5246 37 8878 + 8702 0 5267 37 8854 + 8703 0 5249 37 8792 + 8704 0 5262 37 8905 + 8705 0 5241 37 8707 + 8706 0 0000 30 8893 + 8707 0 0000 41 8725 + 8708 0 0001 27 0129 + 8709 0 0000 44 8850 + 8710 0 0000 30 8841 + 8711 0 0000 10 0129 + 8712 0 0000 36 8732 + 8713 0 2299 37 8746 + 8714 0 0001 49 0010 + 8715 0 0000 30 8708 + 8716 0 0000 42 8683 + 8717 0 0000 31 8586 ERROR + 8718 0 0000 10 9999 + 8719 0 0401 26 8718 + 8720 0 0000 33 8734 + 8721 0 0000 41 8725 + 8722 0 0001 33 8750 + 8723 0 2214 36 8718 + 8724 0 0000 44 8850 + 8725 0 9900 30 8841 + 8726 0 2299 37 8718 + 8727 0 0001 49 0010 + 8728 0 0000 30 8723 + 8729 0 0000 10 0129 + 8730 0 0000 19 0125 + 8731 0 0000 19 0125 + 8732 0 0000 10 0130 + 8733 0 3300 36 8716 + 8734 0 3300 36 8736 + 8735 0 0000 13 8919 + 8736 0 0000 40 0130 + 8737 0 0210 40 0131 + 8738 0 0001 48 0002 + 8739 0 0310 40 0129 + 8740 0 7242 36 8729 + 8741 0 7266 36 8770 + 8742 0 7257 36 8778 + 8743 0 7263 36 8780 + 8744 0 7243 36 8769 + 8745 0 0300 36 8718 + 8746 0 0000 10 0132 + 8747 0 0000 40 0134 + 8748 0 0009 33 8729 + 8749 0 0000 30 9999 + 8750 0 0000 42 8718 + 8751 0 6600 36 8766 + 8752 0 0001 49 0003 + 8753 0 0300 37 8760 + 8754 0 0000 13 8919 + 8755 0 3300 36 8762 + 8756 1 6301 27 9999 + 8757 1 0000 41 9999 + 8758 0 0411 40 8718 + 8759 0 0000 30 8718 + 8760 1 3310 40 9999 + 8761 0 0000 30 8754 + 8762 1 0000 10 9999 + 8763 0 0001 48 0003 + 8764 1 6610 40 9999 + 8765 0 0000 30 8718 + 8766 0 0000 10 0132 + 8767 0 0009 33 9999 + 8768 0 0000 30 8757 + 8769 0 1008 61 0124 + 8770 0 0001 48 0003 + 8771 0 3111 40 8772 + 8772 0 2408 44 8619 REED + 8773 0 0101 30 8619 REED + 8774 0 0000 42 8776 + 8775 0 0010 29 8918 + 8776 0 0240 29 0101 + 8777 0 0000 30 8732 + 8778 0 1008 61 0124 + 8779 0 0000 30 8774 + 8780 0 0300 36 8785 + 8781 0 0010 09 8784 + 8782 0 0001 12 8762 + 8783 0 0000 30 8780 + 8784 2 1602 02 0202 + 8785 0 0000 10 0125 + 8786 0 0000 36 8732 + 8787 0 0000 12 8855 + 8788 0 0001 48 0004 + 8789 0 3211 40 8790 + 8790 0 0990 09 0101 + 8791 0 0000 30 8774 + 8792 0 0000 42 8802 + 8793 0 0000 36 8851 + 8794 0 1100 36 8852 + 8795 0 0000 40 0134 + 8796 0 0003 45 0080 + 8797 0 0002 40 0128 + 8798 0 0000 46 0126 + 8799 0 0410 40 0126 + 8800 0 0001 40 0127 + 8801 0 0000 10 0134 + 8802 0 0002 48 0010 + 8803 0 0001 43 0023 + 8804 0 0000 12 0129 + 8805 0 0000 13 0128 + 8806 0 0001 33 8893 + 8807 0 0000 19 0125 + 8808 0 5000 19 0125 + 8809 0 0000 10 0134 + 8810 0 0000 41 8846 + 8811 0 0000 44 8850 + 8812 0 0001 33 8840 + 8813 0 0001 27 0128 + 8814 0 0000 32 8826 + 8815 0 0000 41 0127 + 8816 0 0000 37 8732 + 8817 0 0000 41 8803 + 8818 0 0000 44 8850 + 8819 0 0000 30 8840 + 8820 0 0000 10 0127 + 8821 0 0000 13 8808 + 8822 0 0000 42 8738 + 8823 0 0000 46 0129 + 8824 0 0003 26 0129 + 8825 0 0000 30 8795 + 8826 0 0001 27 0126 + 8827 0 0000 41 0126 + 8828 0 0000 37 8834 + 8829 0 0000 41 0133 + 8830 0 0000 37 8836 + 8831 0 0001 27 0133 + 8832 0 0000 41 8796 + 8833 0 0000 30 8840 + 8834 0 0000 41 8763 + 8835 0 0000 30 8840 + 8836 0 0000 10 0134 + 8837 0 0000 41 8855 + 8838 0 0001 49 0001 + 8839 0 0000 40 0134 + 8840 0 0001 49 0018 + 8841 0 0001 48 0008 + 8842 0 0001 42 0125 + 8843 1 0000 49 0008 + 8844 0 9400 28 0125 + 8845 0 0024 21 8850 + 8846 0 0000 43 0020 + 8847 1 0000 12 0125 + 8848 1 0010 40 0125 + 8849 0 0002 26 0125 + 8850 0 0000 30 9999 + 8851 0 0009 21 8796 + 8852 0 0000 49 0051 + 8853 0 0001 21 8794 + 8854 0 0002 45 7557 + 8855 0 0001 48 0008 + 8856 0 0410 18 8920 + 8857 0 0001 40 0134 + 8858 0 0001 34 8868 + 8859 0 0410 40 8866 + 8860 0 0449 27 8866 + 8861 0 0000 42 8866 + 8862 0 0000 10 0130 + 8863 0 0001 48 0004 + 8864 0 4211 40 8867 + 8865 0 0000 10 8866 + 8866 0 0002 45 9999 + 8867 0 0000 20 8797 + 8868 0 0000 43 7557 + 8869 0 0000 13 8920 + 8870 0 0210 40 0133 + 8871 0 0211 18 0130 + 8872 0 0000 35 8875 + 8873 0 0000 10 8920 + 8874 0 0000 30 8859 + 8875 0 0000 10 8852 + 8876 0 1110 40 0134 + 8877 0 0000 30 8859 + 8878 0 0304 27 0129 + 8879 0 0000 32 8882 + 8880 0 0000 30 8892 + 8881 0 0000 10 8921 + 8882 0 0000 36 8881 + 8883 0 0002 45 7557 + 8884 0 2210 40 8807 + 8885 0 0001 48 0008 + 8886 0 0001 40 0134 + 8887 0 0002 48 0010 + 8888 0 0000 12 0130 + 8889 0 0000 17 8852 + 8890 0 0310 18 0129 + 8891 0 0001 34 8901 + 8892 0 0004 26 0129 + 8893 0 0000 10 0129 + 8894 0 0000 19 0125 + 8895 0 0000 19 0125 + 8896 0 0002 27 0125 + 8897 0 0000 41 8908 + 8898 0 0000 44 8850 + 8899 0 0000 30 8840 + 8900 0 0000 30 8732 + 8901 0 0000 41 8807 + 8902 0 0000 10 8838 + 8903 0 0000 42 0131 + 8904 0 0001 20 8797 + 8905 0 0002 45 7557 + 8906 0 0001 48 0008 + 8907 0 0001 40 0134 + 8908 0 0000 43 0014 + 8909 0 0000 13 8920 + 8910 0 0002 45 7557 + 8911 0 0001 33 8916 + 8912 0 0210 18 0130 + 8913 0 0000 34 8893 + 8914 0 0000 12 8838 + 8915 0 0000 30 8903 + 8916 0 0010 40 0133 + 8917 0 0000 30 8902 + 8918 2 0000 00 0000 + 8919 0 0010 00 0000 + 8920 0 0000 00 0050 + 8921 0 5000 00 0000 + 8934 0 9062 01 0000 + 8935 0 0410 40 9024 + 8936 0 0410 40 9025 + 8937 0 0401 26 9025 + 8938 0 0000 44 9031 + 8939 0 0000 30 9024 + 8940 0 0000 42 9062 + 8941 1 0000 46 0000 + 8942 0 0000 46 9070 + 8943 0 0000 44 8562 RITE + 8944 0 0117 30 8562 RITE + 8945 0 0000 46 9072 + 8946 0 0502 26 9072 + 8947 0 0000 42 9062 + 8948 0 9999 20 8952 + 8949 0 6400 28 9070 + 8950 0 0000 10 0101 + 8951 0 9999 20 9046 + 8952 0 9400 28 9072 + 8953 1 0000 10 0101 + 8954 0 0000 42 9072 + 8955 1 0000 49 0000 + 8956 0 0502 26 9072 + 8957 0 0000 41 9070 + 8958 0 0000 37 8972 + 8959 0 0160 21 8943 + 8960 0 4400 28 9070 + 8961 0 2213 36 8987 + 8962 0 0000 48 0008 + 8963 1 0000 49 0000 + 8964 0 0000 19 9069 + 8965 0 4102 27 9070 + 8966 0 0000 32 8952 + 8967 0 0000 10 9069 + 8968 0 0000 44 9031 + 8969 0 0000 30 9024 + 8970 0 5212 27 9070 + 8971 0 0000 30 8952 + 8972 0 0162 21 8943 + 8973 0 1108 36 9003 + 8974 0 2203 36 8999 + 8975 0 2220 36 8997 + 8976 0 2234 36 8997 + 8977 0 2223 36 8992 + 8978 0 2213 36 9054 + 8979 0 2214 36 8985 + 8980 0 0000 42 9066 + 8981 0 9999 20 8952 + 8982 0 0000 44 9031 + 8983 0 0000 30 9010 + 8984 0 0000 30 8952 + 8985 0 9416 26 9072 + 8986 0 0000 30 8980 + 8987 0 0000 46 9070 + 8988 0 0000 10 9069 + 8989 0 0000 44 9031 + 8990 0 9992 20 9024 + 8991 0 0000 30 8952 + 8992 0 0001 26 9068 + 8993 0 0000 44 9031 + 8994 0 0000 30 9010 + 8995 0 0001 26 9065 + 8996 0 0000 30 8952 + 8997 0 0001 26 9064 + 8998 0 0000 30 8952 + 8999 0 0000 41 9058 + 9000 0 2211 40 9063 + 9001 0 0001 26 9067 + 9002 0 0000 30 8952 + 9003 0 0000 49 0001 + 9004 0 0000 41 9069 + 9005 0 0001 49 0001 + 9006 0 0001 40 9069 + 9007 0 2201 27 9063 + 9008 0 0001 26 9066 + 9009 0 0000 30 8952 + 9010 0 0000 41 9065 + 9011 0 0000 37 9037 + 9012 0 0000 42 9064 + 9013 0 0000 11 9069 + 9014 0 0000 49 0008 + 9015 0 9999 20 9017 + 9016 0 0000 43 0000 + 9017 0 0001 13 9071 + 9018 0 1210 27 9071 + 9019 0 0000 32 9024 + 9020 0 0000 43 0000 + 9021 0 0000 30 9024 + 9022 0 0000 42 9068 + 9023 0 0001 21 9032 + 9024 0 0000 44 0090 + 9025 0 0000 30 0091 + 9026 0 0009 33 9034 + 9027 0 0412 40 9025 + 9028 0 0000 42 9042 + 9029 0 0000 46 9063 + 9030 0 0070 29 9063 + 9031 0 0000 30 0097 + 9032 0 0000 40 9071 + 9033 0 0000 30 9028 + 9034 0 0000 42 8934 + 9035 0 0000 46 9062 + 9036 1 0000 30 0000 + 9037 0 0000 10 9069 + 9038 0 0000 42 9067 + 9039 0 9999 20 9042 + 9040 0 0000 12 9063 + 9041 0 0000 22 9063 + 9042 0 0000 42 9064 + 9043 0 9999 20 9022 + 9044 0 0001 43 0000 + 9045 0 0000 30 9022 + 9046 0 0810 18 9059 + 9047 0 0001 35 8952 + 9048 0 0000 41 0102 + 9049 0 0011 18 9060 + 9050 0 0001 35 8952 + 9051 0 0000 42 9062 + 9052 1 0001 26 0000 + 9053 0 0000 30 9034 + 9054 0 0000 42 9066 + 9055 0 9999 20 8970 + 9056 0 0502 27 9072 + 9057 0 0000 30 8982 + 9058 0 5800 00 0000 + 9059 2 8562 45 5563 + 9060 2 4955 45 5300 + 9061 0 5110 00 0000 + 9062 0 0000 00 0000 + 9063 0 0000 00 0000 + 9064 0 0000 00 0000 + 9065 0 0000 00 0000 + 9066 0 0000 00 0000 + 9067 0 0000 00 0000 + 9068 0 0000 00 0000 + 9069 0 0000 00 0000 + 9070 0 0000 00 0000 + 9071 0 0000 00 0000 + 9072 0 0000 00 0000 + 8565 0 0000 44 8598 + 8566 0 0000 30 8594 + 8567 2 5945 62 6453 + 8568 2 6300 56 6463 + 8569 2 0056 46 0059 + 8570 2 4155 47 4500 + 8571 2 4955 00 0000 + 8572 0 0000 44 8598 + 8573 0 0000 30 8594 + 8574 2 5945 62 6453 + 8575 2 6300 64 5544 + 8576 2 4546 49 5545 + 8577 2 4400 46 5659 + 8578 2 0000 00 0000 + 8579 0 0000 44 8598 + 8580 0 0000 30 8594 + 8581 2 5945 62 6453 + 8582 2 6300 49 5353 + 8583 2 2044 45 4649 + 8584 2 5545 44 0046 + 8585 2 5659 00 0000 + 8586 0 0000 46 8607 + 8587 0 0000 44 8598 + 8588 0 0000 30 8596 + 8589 0 0000 00 0000 + 8590 2 0041 59 4963 + 8591 2 4854 45 6349 + 8592 2 4300 56 6545 + 8593 2 5946 53 5666 + 8594 0 0001 40 8607 + 8595 0 0003 45 0000 + 8596 0 0412 40 8601 + 8597 0 0000 42 8618 + 8598 0 0050 29 0033 + 8599 0 1106 44 8619 REED + 8600 0 8602 30 8619 REED + 8601 0 0000 30 0036 + 8602 0 0000 00 0000 + 8603 0 0000 00 0000 + 8604 0 0000 00 0000 + 8605 0 0000 00 0000 + 8606 0 0000 00 0000 + 8607 0 0000 00 0000 + 8608 0 0000 00 0000 + 8609 0 0000 00 0000 + 8610 0 0000 00 0000 + 8611 0 0000 00 0000 + 8612 0 0000 00 0000 + 8613 0 5000 00 0000 + 8614 0 0000 00 0000 + 8615 0 0000 00 0000 + 8616 0 5110 00 0000 + 8617 0 0000 00 0000 + 8618 0 0000 00 8602 + 8562 0 0000 01 0000 + 8563 0 1000 60 0117 + 8564 0 0000 30 8945 READ + 8619 0 0000 01 0000 + 8620 0 0000 42 8619 + 8621 1 0000 10 9999 + 8622 0 0000 48 0006 + 8623 0 0410 40 8629 + 8624 1 0000 10 9998 + 8625 0 4210 40 8629 + 8626 0 0000 48 0008 + 8627 0 0000 13 8631 + 8628 0 0000 19 8629 + 8629 0 2000 61 0000 + 8630 1 0000 30 0000 + 8631 0 0000 00 0001 +COMPILED PROGRAM ENDS AT 2485 +PROGRAM VARIABLES BEGIN AT 8562 + + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS OMITTED 0 + + SYMPTOMS USED W + + EQUATION USED 10 + + + DISEASE PROBABILITY + + Y10 V S D - V P S .0286 + Y11 V S D - I P S .0201 + Y12 V P S .7307 + Y13 I P S .2154 + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS OMITTED 11 0 + + SYMPTOMS USED W + + EQUATION USED 10 + + + DISEASE PROBABILITY + + Y10 V S D - V P S .0297 + Y11 V S D - I P S .0209 + Y12 V P S .7290 + Y13 I P S .2150 + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS USED W + + EQUATION USED 9 + + + DISEASE PROBABILITY + + Y02 A S D .0171 + Y10 V S D - V P S .1983 + Y11 V S D - I P S .2314 + Y12 V P S .4245 + Y13 I P S .1226 + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS OMITTED 0 + + SYMPTOMS USED B + + EQUATION USED 10 + + + DISEASE PROBABILITY + + Y02 A S D .0162 + Y10 V S D - V P S .0610 + Y11 V S D - I P S .0429 + Y12 V P S .6861 + Y13 I P S .1982 + Y31 V S D - P H .0640 + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS OMITTED 11 0 + + SYMPTOMS USED B + + EQUATION USED 10 + + + DISEASE PROBABILITY + + Y02 A S D .0166 + Y10 V S D - V P S .0626 + Y11 V S D - I P S .0440 + Y12 V P S .6761 + Y13 I P S .1953 + Y31 V S D - P H .0780 + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS USED B + + EQUATION USED 9 + + + DISEASE PROBABILITY + + Y02 A S D .0113 + Y10 V S D - V P S .3490 + Y11 V S D - I P S .4072 + Y12 V P S .1680 + Y13 I P S .0485 + Y31 V S D - P H .0163 + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS USED B + + EQUATION USED 9 + + + DISEASE PROBABILITY + + Y02 A S D .0113 + Y10 V S D - V P S .3490 + Y11 V S D - I P S .4072 + Y12 V P S .1680 + Y13 I P S .0485 + Y31 V S D - P H .0163 + diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card index c7c5623..d43b2d6 100644 --- a/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card +++ b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card @@ -407,20 +407,20 @@ 2 STOP 7270061216 $ GO TO NEWCASE $ CHDD0356 2 FINISH $ CHDD0357 2 UNPACK -605 7009901000080002400088800014000898000046008680000100104 -605 8041040009080401260090800001000918000041010380210370012 +605 7010501000080002400088800014000898000046008680000100100 +605 8041040009080401260090800001000918000041010180210370012 605 8021626008680000300053802042600868000044006580000300066 605 8020526008680421260090800001000948000044006580000300066 605 0000001000080427260090800001000968000044006580000300066 -605 8000010010180201360040800001000908041040003500000010000 +605 8000010010380201360040800001000908041040003500000010000 605 8020126008680433270090800001000928000044006580000300066 605 0000046000080000300060000000100000000001000000000010000 -605 8000010010480000120097804104000488000010009980000120093 +605 8000010010080000120097804104000488000010010580000120093 605 8041040004600000100000000004800060031040000000000010000 605 8020226008680409270090800001000958000044006580000300066 605 8000030006000000010000000000100000000001000000000010000 605 8000042008880000410089800001000008041040006400000300000 -605 0000030000080000420090800001200998041040007280410400070 +605 0000030000080000420090800001201058041040007280410400070 605 0000041000080401260072000001000000000149000410310400000 605 8000120007600001490003103104000008000120007900001490003 605 1031040000080001200082802012700868000032007180000460086 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.lst b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.lst new file mode 100644 index 0000000..0aab55a --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.lst @@ -0,0 +1,972 @@ +0200 BAC-220 STANDARD VERSION 2/1/62 + +0200 COMMENT CONGENITAL HEART DISEASE DIAGNOSIS PROGRAM. CHDD0001 + +0200 FROM A SET OF CLINICAL SYMPTOMS, THE PROBABILITIES CHDD0002 + +0200 FOR EACH OF THE 33 CONGENITAL HEART DISEASES BEING CHDD0003 + +0200 PRESENT IN THE PATIENT UNDER CONSIDERATION IS CHDD0004 + +0200 CALCULATED AND THOSE GREATER THAN ONE PERCENT CHDD0005 + +0200 ARE PRINTED OUT TOGETHER WITH DISEASE IDENTIFICATION CHDD0006 + +0200 AND CASE INFORMATION. CHDD0007 + +0200 + +0200 FRED B FIELDING CHDD0008 + +0200 SAN FRANCISCO DISTRICT OFFICE CHDD0009 + +0200 + +0200 CARD SEQUENCE CODE FOR THE PROGRAM STARTS WITH CHDD0010 + +0200 CHDD0001 AND ROW 01-1 FOR SYMPTOM-DISEASE MATRIX. CHDD0011 + +0200 FIRST RELEASE 05 - 31 - 61 $CHDD0012 + +0200 + +0200 + +0200 INTEGER CASENO , CASEIN , SHEET , XRAY , EQUATION , CHDD0013 + +0200 MO , DAY , YEAR , LAST , CHDD0014 + +0200 E , J , K , P , X , CHDD0015 + +0200 TOTE , TOTP , TOTX , OUTSHEET , CHDD0016 + +0200 T22 , T2021 , T4243 , T4445 , T6789 , CHDD0017 + +0200 ( SYE() , SYP() ) , ( TE() , TP() ) , CHDD0018 + +0200 ROW () , MX () , M (,) $ CHDD0019 + +0200 REAL SUM , FTROW () , FTMX () , PYKX () , PYX () $ CHDD0020 + +0200 + +0200 ARRAY ( SYE(20) , SYP(20) ) , ( TE(50) , TP(50) ) , CHDD0021 + +0200 ( ROW(51) , FTROW(50) ) , ( MX(10) , FTMX(10) ) , CHDD0022 + +0200 PYKX (33) , PYX (33) , M (33,18) $ CHDD0023 + +0200 + +0200 EXTERNAL PROCEDURE UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $CHDD0024 + +0200 + +0200 COMMENT READ DATA FOR SYMPTOM-DISEASE MATRIX. $CHDD0025 + +0202 INPUT MATRIX(FOR K=(1,1,33) $ FOR J=(1,1,18) $ M(K,J) ) $CHDD0026 + +0239 READ ( $ $ MATRIX ) $ CHDD0027 + +0239 + +0243 COMMENT THE PROGRAM BEGINS HERE. THE FIRST TWO INPUT CARDS CHDD0028 + +0243 ARE READ, THE FIRST TWO LINES OF OUTPUT ARE PRINTED, CHDD0029 + +0243 THE NUMBER OF SYMPTOMS ARE CALCULATED, CHDD0030 + +0243 AND THE EQUATION TYPE DETERMINED. $ CHDD0031 + +0243 + +0243 NEWCASE.. FOR P = (1,1,20) $ SYP (P) = 0 $ CHDD0032 + +0258 FOR J = (1,1,50) $ TP (J) = ROW (J) = 0 $ CHDD0033 + +0274 FOR J = (1,1,50) $ FTROW (J) = 0.0 $ CHDD0034 + +0289 INPUT CASE (CASENO,CASEIN,SHEET,XRAY,EQUATION, CHDD0035 + +0306 MO,DAY,YEAR,LAST ) $ CHDD0036 + +0320 CARD1.. READ ( $ $ CASE ) $ CHDD0037 + +0324 OUTPUT IDOUT ( CASENO , CASEIN , MO , DAY , YEAR ) $ CHDD0038 + +0343 FORMAT IDFORM (B5,*CASE NUMBER*,I7,B5, CHDD0039 + +0343 *PATIENT*,B2,A3,B5,*DATE*,B1,3(I3),W3 ) $ CHDD0040 + +0361 WRITE ( $ $ IDOUT , IDFORM) $ CHDD0041 + +0369 INPUT PRESENT ( FOR P = (1,1,20) $ SYP (P) ) $ CHDD0042 + +0390 CARD2.. READ ( $ $ PRESENT ) $ CHDD0043 + +0394 P = 1 $ CHDD0044 + +0396 FOR J = (1,1,50) $ CHDD0045 + +0407 BEGIN CHDD0046 + +0407 IF SYP (P) EQL J $ CHDD0047 + +0417 ( TP (J) = 1 $ P = P+1 ) CHDD0048 + +0420 END $ CHDD0049 + +0421 TOTP = P - 1 $ CHDD0050 + +0424 OUTPUT POUT ( FOR P = (1,1,TOTP) $ SYP (P) ) $ CHDD0051 + +0445 FORMAT PFORM (B5,*SYMPTOMS PRESENT*,B4,20(I4),W4) $ CHDD0052 + +0456 WRITE ( $ $ POUT , PFORM ) $ CHDD0053 + +0464 K = 1 $ CHDD0054 + +0466 IF SHEET EQL 1 $ CHDD0055 + +0473 ( OUTSHEET = 6600000000 $ GO TO EQTEST ) $ CHDD0056 + +0474 OUTSHEET = 4200000000 $ CHDD0057 + +0476 EQTEST.. IF EQUATION EQL 10 $ GO TO EQ10 $ CHDD0058 + +0476 + +0482 COMMENT CALCULATE PROBABILITIES USING EQUATION 9. $ CHDD0059 + +0482 + +0482 + +0482 COMMENT ONE ROW OF THE MATRIX IS UNPACKED AND THE CHDD0060 + +0482 INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED. $CHDD0061 + +0482 + +0482 XP9.. UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $ CHDD0062 + +0503 FOR J = (8,1,16), 24, 25, (30,1,33), 38, 39, 50 $ CHDD0063 + +0543 ( IF TP (J) EQL 1 $ ROW (J) = 1000 - ROW (J) ) $CHDD0064 + +0543 + +0557 COMMENT THE ROW-PRODUCT IS CALCULATED AND ZEROES TESTED FOR.$CHDD0065 + +0557 PYKX (K) = M (K,1) $ CHDD0066 + +0566 FOR P = (1,1,TOTP) $ CHDD0067 + +0577 BEGIN CHDD0068 + +0577 IF ROW ( SYP(P) ) EQL 0 $ CHDD0069 + +0585 ( PYKX (K) = 0.0 $ GO TO TAL9 ) $ CHDD0070 + +0586 FTROW (P) = ROW ( SYP(P) ) CHDD0071 + +0593 END $ CHDD0072 + +0593 + +0594 FOR P = (1,1,TOTP) $ CHDD0073 + +0605 PYKX (K) = PYKX (K).FTROW (P) $ CHDD0074 + +0605 + +0613 TAL9.. K = K+1 $ CHDD0075 + +0616 IF K LEQ 33 $ GO TO XP9 $ CHDD0076 + +0622 GO TO NORM $ CHDD0077 + +0622 + +0622 + +0623 COMMENT CALCULATE PROBABILITIES USING EQUATION 10. $ CHDD0078 + +0623 + +0623 EQ10.. FOR J = (1,1,50) $ TE (J) = 0 $ CHDD0079 + +0638 FOR E = (1,1,20) $ SYE (E) = 0 $ CHDD0080 + +0653 FOR X = (1,1,10) $ MX (X) = 0 $ CHDD0081 + +0668 FOR X = (1,1,10) $ FTMX (X) = 0.0 $ CHDD0082 + +0668 + +0683 COMMENT THE THIRD INPUT CARD IS READ, THE THIRD LINE OF CHDD0083 + +0683 OUTPUT IS PRINTED, AND THE NUMBER OF SYMPTOMS CHDD0084 + +0683 TO BE OMITTED FOR THIS CASE IS CALCULATED. $ CHDD0085 + +0683 + +0685 INPUT ( EXCLUDE ( FOR E = (1,1,20) $ SYE (E) ) ) $ CHDD0086 + +0704 CARD3.. READ ( $ $ EXCLUDE ) $ CHDD0087 + +0708 E = 1 $ CHDD0088 + +0710 FOR J = (1,1,50) $ CHDD0089 + +0721 BEGIN CHDD0090 + +0721 IF SYE (E) EQL J $ CHDD0091 + +0731 ( TE (J) = 1 $ E = E+1 ) CHDD0092 + +0734 END $ CHDD0093 + +0735 TOTE = E-1 $ CHDD0094 + +0738 OUTPUT EOUT ( FOR E = (1,1,TOTE+1) $ SYE (E) ) $ CHDD0095 + +0762 FORMAT EFORM (B5,*SYMPTOMS OMITTED*,B4,20(I4),W4) $ CHDD0096 + +0773 WRITE ( $ $ EOUT , EFORM ) $ CHDD0097 + +0781 TOTX = SHEET+8 $ CHDD0098 + +0781 + +0784 COMMENT ONE ROW OF THE MATRIX IS UNPACKED, THE CHDD0099 + +0784 INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED, CHDD0100 + +0784 AND THE SYMPTOMS OMITTED FOR THIS CASE DELETED. $CHDD0101 + +0784 + +0784 XP10.. UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $ CHDD0102 + +0805 FOR J = (8,1,15) , 24, 25, (30,1,33), 38, 39, 50 $CHDD0103 + +0845 BEGIN CHDD0104 + +0845 IF TP(J) EQL 1 $ ROW (J) = 1000 - ROW (J) $ CHDD0105 + +0858 IF ROW (J) EQL 0 $ CHDD0106 + +0864 ( PYKX (K) = 0.0 $ GO TO TAL10 ) $ CHDD0107 + +0865 IF TE (J) EQL 1 $ ROW (J) = 0 CHDD0108 + +0873 END $ CHDD0109 + +0873 + +0874 COMMENT THE ROW-PRODUCT IS CALCULATED FOR THOSE INDEPENDENT CHDD0110 + +0874 SYMPTOMS COMMON TO BOTH SHEETS, ZERO VALUES TESTED CHDD0111 + +0874 FOR, AND EACH ELEMENT SCALED. $CHDD0112 + +0874 + +0874 PYKX (K)= M (K,1) $ CHDD0113 + +0883 FOR J= (8,1,15), 24, 25, (30,1,33), 38, 39, 50 $ CHDD0114 + +0923 BEGIN CHDD0115 + +0932 FTROW(J) = ROW(J) $ FTROW(J) = FTROW(J)/100.0 $ CHDD0116 + +0937 IF FTROW (J) NEQ 0.0 $ CHDD0117 + +0937 PYKX (K) = PYKX(K).FTROW(J) CHDD0118 + +0946 END $ CHDD0119 + +0946 + +0946 + +0947 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0120 + +0947 EXCLUSIVE SYMPTOM-SETS COMMON TO BOTH BROWN AND CHDD0121 + +0947 WHITE SYMPTOM CHECK SHEETS PER TABLE V. $ CHDD0122 + +0947 + +0947 X1TO3.. MX (1) = ROW ( SYP (1) ) $ CHDD0123 + +0950 X4TO7.. IF TE (4) EQL 1 $ CHDD0124 + +0957 ( MX (2) = 100 $ GO TO X26 ) $ CHDD0125 + +0958 IF SYP (2) LEQ 7 $ CHDD0126 + +0966 ( MX (2) = ROW ( SYP(2) ) $ GO TO X26 ) $ CHDD0127 + +0967 MX (2) = 1000 - ROW(4) - ROW(5) - ROW(6) - ROW(7) $CHDD0128 + +0973 X26.. X = 3 $ CHDD0129 + +0975 FOR J = 26 , 28, 34, 36 $ CHDD0130 + +0989 BEGIN CHDD0131 + +0989 IF TE (J) EQL 1 $ CHDD0132 + +1001 ( MX (X) = 100 $ GO TO LAB5 ) $ CHDD0133 + +1002 IF TP (J) EQL TP (J+1) $ CHDD0134 + +1014 ( MX(X) = 1000 - ROW(J) - ROW(J+1) $ GO TO LAB5 ) $CHDD0135 + +1015 IF TP (J) EQL 1 $ CHDD0136 + +1025 ( MX (X) = ROW (J) $ GO TO LAB5 ) $ CHDD0137 + +1026 MX (X) = ROW (J+1) $ CHDD0138 + +1030 LAB5.. X = X+1 CHDD0139 + +1033 END $ CHDD0140 + +1033 + +1034 BNORWH.. IF SHEET EQL 1 $ GO TO WHITE $ CHDD0141 + +1034 + +1040 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0142 + +1040 EXCLUSIVE SYMPTOM-SETS FOR THE BROWN SHEET OPTION. $CHDD0143 + +1040 + +1040 BROWN.. IF TP (16) EQL 1 $ ROW (16) = 1000 - ROW (16) $CHDD0144 + +1048 IF ROW (16) EQL 0 $ CHDD0145 + +1053 ( PYKX (K) = 0.0 $ GO TO TAL10 ) $ CHDD0146 + +1054 IF TE (16) EQL 1 $ CHDD0147 + +1060 ( ROW (16) = 0 $ GO TO X17TO19 ) $ CHDD0148 + +1061 BEGIN CHDD0149 + +1061 FTROW (16) = ROW (16) $ CHDD0150 + +1065 PYKX (K) = PYKX (K).FTROW (16) / 100.0 CHDD0151 + +1071 END $ CHDD0152 + +1071 X17TO19.. IF TE (17) EQL 1 $ CHDD0153 + +1078 ( MX (7) =100 $ GO TO X20 ) $ CHDD0154 + +1079 IF ( TP(17) EQL TP(18) ) AND ( TP(18) EQL TP(19) ) $CHDD0155 + +1079 BEGIN CHDD0156 + +1098 MX(7) =(1000-ROW(17)).(1000-ROW(18)).(1000-ROW(19)) $CHDD0157 + +1107 GO TO X20 CHDD0158 + +1108 END $ CHDD0159 + +1108 IF TP (19) EQL 1 $ CHDD0160 + +1115 ( MX (7) = ROW (19) $ GO TO X20 ) $ CHDD0161 + +1116 IF TP (17) EQL 0 $ CHDD0162 + +1121 ( MX(7) = ROW(18).(1000 - ROW(17) ) $ GO TO X20 ) $CHDD0163 + +1124 IF TP (18) EQL 0 $ CHDD0164 + +1129 ( MX(7) = ROW(17).(1000 - ROW(18) ) $ GO TO X20 ) $CHDD0165 + +1132 MX (7) = ROW(17).ROW(18) $ CHDD0166 + +1132 + +1135 X20.. IF TE (20) EQL 1 $ CHDD0167 + +1142 ( MX (8) = 100 $ GO TO FLTMX ) $ CHDD0168 + +1143 T2021 = ( 1000 - ROW (20) - ROW (21) ) $ CHDD0169 + +1147 T22 = ( 1000 0 ROW (22) ) $ CHDD0170 + +1147 + +1150 IF ( TP(20) EQL TP(21) ) AND ( TP(21) EQL TP(22) ) CHDD0171 + +1165 AND ( TP(22) EQL TP(23) ) $ CHDD0172 + +1178 (MX(8) = T2021.T22.(1000 - ROW(23) ) $ GO TO FLTMX )$CHDD0173 + +1183 IF TP (20) EQL 1 $ CHDD0174 + +1183 BEGIN CHDD0175 + +1183 IF TP (22) EQL 1 $ CHDD0176 + +1196 ( MX(8) = ROW(20).ROW(22) $ GO TO FLTMX ) $ CHDD0177 + +1197 MX (8) = ROW (20).T22 $ GO TO FLTMX CHDD0178 + +1201 END $ CHDD0179 + +1201 CHDD0180 + +1201 IF TP (21) EQL 1 $ CHDD0181 + +1201 BEGIN CHDD0182 + +1201 IF TP (22) EQL 1 $ CHDD0183 + +1214 ( MX(8) = ROW(21).ROW(22) $ GO TO FLTMX ) $ CHDD0184 + +1215 MX (8) = ROW (21).T22 $ GO TO FLTMX CHDD0185 + +1219 END $ CHDD0186 + +1219 IF TP (22) EQL 1 $ CHDD0187 + +1227 ( MX(8) = ROW(22).T2021 $ GO TO FLTMX ) $ CHDD0188 + +1228 MX (8) = ROW (23) $ GO TO FLTMX $ CHDD0189 + +1228 + +1231 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0190 + +1231 EXCLUSIVE SYMPTOM-SETS FOR THE WHITE SHEET OPTION. $CHDD0191 + +1231 + +1238 WHITE.. IF (TE(19) EQL TE(42) ) AND ( TE(42) EQL TE(44) ) CHDD0192 + +1246 AND ( TE(44) EQL 1 ) $ CHDD0193 + +1259 ( MX (7) = 100 $ GO TO X40 ) $ CHDD0194 + +1260 T4243 = ( 1000 - ROW(42) - ROW(43) ) $ CHDD0195 + +1264 T4445 = ( 1000 - ROW(44) - ROW(45) ) $ CHDD0196 + +1264 + +1268 IF ( TP(19) EQL TP(42) ) AND ( TP(42) EQL TP(43) ) CHDD0197 + +1283 AND ( TP(43) EQL TP(44) ) AND ( TP(44) EQL TP(45) ) $CHDD0198 + +1305 ( MX(7) = (1000 - ROW(19)).T4243.T4445 $ GO TO X40 )$CHDD0199 + +1310 IF TP (19) EQL 1 $ CHDD0200 + +1317 ( MX(7) = ROW(19) $ GO TO X40 ) $ CHDD0201 + +1318 IF TP (42) EQL 1 $ CHDD0202 + +1318 BEGIN CHDD0203 + +1318 IF TP(44) EQL 1 $ CHDD0204 + +1331 ( MX(7) = ROW(42).ROW(44) $ GO TO X40 ) $ CHDD0205 + +1332 IF TP (45) EQL 1 $ CHDD0206 + +1340 ( MX(7) = ROW(42).ROW(45) $ GO TO X40 ) $ CHDD0207 + +1341 MX (7) = ROW (42).T4445 $ GO TO X40 CHDD0208 + +1345 END $ CHDD0209 + +1345 IF TP (43) EQL 1 $ CHDD0210 + +1345 BEGIN CHDD0211 + +1345 IF TP (44) EQL 1 $ CHDD0212 + +1358 ( MX(7) = ROW(43).ROW(44) $ GO TO X40 ) $ CHDD0213 + +1359 IF TP (45) EQL 1 $ CHDD0214 + +1367 ( MX(7) = ROW(43).ROW(45) $ GO TO X40 ) $ CHDD0215 + +1368 MX (7) = ROW (43).T4445 $ GO TO X40 CHDD0216 + +1372 END $ CHDD0217 + +1372 IF TP (44) EQL 1 $ CHDD0218 + +1380 ( MX(7) = ROW(44).T4243 $ GO TO X40 ) $ CHDD0219 + +1381 MX (7) = ROW (45).T4243 $ CHDD0220 + +1381 + +1384 X40.. IF TE (40) EQL 1 $ CHDD0221 + +1391 ( MX (8) = 100 $ GO TO X2369 ) $ CHDD0222 + +1392 IF TP (40) EQL TP (41) $ CHDD0223 + +1401 ( MX(8) = 1000 - ROW(40) - ROW(41) $ GO TO X2369 ) $CHDD0224 + +1402 IF TP (40) EQL 1 $ CHDD0225 + +1409 ( MX(8) = ROW(40) $ GO TO X2369 ) $ CHDD0226 + +1410 MX (8) = ROW (41) $ CHDD0227 + +1410 + +1412 X2369.. IF ( TE(22) EQL TE(46) ) AND ( TE(46) EQL 1 ) $ CHDD0228 + +1431 ( MX (9) = 100 $ GO TO FLTMX ) $ CHDD0229 + +1432 T22 = 1000 - ROW (22) $ CHDD0230 + +1435 T6789 = 1000 - ROW(46) - ROW(47) - ROW(48) - ROW(49)$CHDD0231 + +1441 IF ( TP(22) EQL TP(23) ) AND ( TP(23) EQL TP(46) ) CHDD0232 + +1456 AND ( TP(46) EQL TP(47) ) AND ( TP(47) EQL TP(48) ) CHDD0233 + +1474 AND ( TP(48) EQL TP(49) ) $ CHDD0234 + +1487 ( MX(9) = T22.(1000 - ROW(23)).T6789 $ GO TO FLTMX)$CHDD0235 + +1492 IF TP (22) EQL 1 $ CHDD0236 + +1492 BEGIN CHDD0237 + +1497 FOR J = (46,1,49) $ CHDD0238 + +1508 BEGIN CHDD0239 + +1508 IF TP (J) EQL 1 $ CHDD0240 + +1519 ( MX(9) = ROW(J).ROW(22) $ GO TO FLTMX ) CHDD0241 + +1520 END $ CHDD0242 + +1521 MX (9) = ROW (22).T6789 $ GO TO FLTMX CHDD0243 + +1525 END $ CHDD0244 + +1525 FOR J = (46,1,49) $ CHDD0245 + +1536 BEGIN CHDD0246 + +1536 IF TP (J) EQL 1 $ CHDD0247 + +1547 ( MX(9) = ROW(J).T22 $ GO TO FLTMX ) CHDD0248 + +1548 END $ CHDD0249 + +1549 MX (9) = ROW (23) $ GO TO FLTMX $ CHDD0250 + +1549 + +1552 FLTMX.. FOR X = (1,1,TOTX) $ CHDD0251 + +1563 ( FTMX(X) = MX(X) $ FTMX(X) = FTMX(X)/100.00 ) $ CHDD0252 + +1576 FOR X = (1,1,TOTX) $ CHDD0253 + +1587 PYKX (K) = PYKX (K).FTMX (X) $ CHDD0254 + +1587 + +1595 COMMENT AT THIS POINT, THE ROW-PRODUCT HAS BEEN COMPUTED CHDD0255 + +1595 AND A TEST IS MADE TO DETERMINE WHETHER THERE CHDD0256 + +1595 ARE MORE ROWS YET TO BE PROCESSED, OR TO PRINT-OUT. $CHDD0257 + +1595 + +1595 TAL10.. K = K+1 $ CHDD0258 + +1598 IF K LEQ 33 $ GO TO XP10 $ CHDD0259 + +1604 GO TO NORM $ CHDD0260 + +1604 + +1605 COMMENT THE ROW-PROBABILITIES ARE FIRST NORMALIZED TO GIVE A CHDD0261 + +1605 TRUE PERCENTAGE FIGURE AND LINES 4 - 6 ARE PRINTED. $CHDD0262 + +1605 + +1605 NORM.. SUM = 0.0 $ CHDD0263 + +1606 OUTPUT SHOUT ( OUTSHEET ) $ CHDD0264 + +1613 FORMAT SHFORM(B5,*SYMPTOMS USED*,B3,A2,W4) $ CHDD0265 + +1622 WRITE ( $ $ SHOUT , SHFORM ) $ CHDD0266 + +1630 FOR K = (1,1,33) $ CHDD0267 + +1641 SUM = SUM + PYKX (K) $ CHDD0268 + +1647 OUTPUT EQOUT ( EQUATION ) $ CHDD0269 + +1654 FORMAT EQFORM(B5,*EQUATION USED*,I5,W6) $ CHDD0270 + +1662 WRITE ( $ $ EQOUT , EQFORM ) $ CHDD0271 + +1670 FOR K = (1,1,33) $ CHDD0272 + +1681 PYX (K) = PYKX (K) / SUM $ CHDD0273 + +1681 + +1681 + +1681 + +1688 FORMAT HEAD(B15,*DISEASE*,B5,*PROBABILITY*,W6) $ CHDD0274 + +1698 WRITE ( $ $ HEAD ) $ CHDD0275 + +1698 + +1702 COMMENT THE PROBABILITIES ARE NOW PRINTED WHICH ARE ONE CHDD0276 + +1702 PERCENT OR GREATER TOGETHER WITH DISEASE I. D. . $CHDD0277 + +1702 + +1702 K = 1 $ CHDD0278 + +1704 PRINT.. IF PYX (K) LSS 0.01 $ GO TO TALPT $ CHDD0279 + +1711 SWITCH K, ( Y01,Y02,Y03,Y04,Y05,Y06,Y07,Y08,Y09, CHDD0280 + +1711 Y10,Y11,Y12,Y13,Y14,Y15,Y16,Y17,Y18,Y19,Y20,Y21, CHDD0281 + +1745 Y22,Y23,Y24,Y25,Y26,Y27,Y28,Y29,Y30,Y31,Y32,Y33 ) $CHDD0282 + +1746 OUTPUT ANS ( FOR X = K $ PYX (X) ) $ CHDD0283 + +1760 FORMAT FORM1 (B8,*Y01*,B7,*N*,S16.4,W0) $ CHDD0284 + +1768 Y01.. WRITE ( $ $ ANS , FORM1 ) $ GO TO TALPT $ CHDD0285 + +1777 FORMAT FORM2 (B8,*Y02*,B5,*A S D*,S14.4,W0) $ CHDD0286 + +1786 Y02.. WRITE ( $ $ ANS , FORM2 ) $ GO TO TALPT $ CHDD0287 + +1795 FORMAT FORM3 (B8,*Y03*,B2,*A S D - P S*,S11.4,W0) $ CHDD0288 + +1805 Y03.. WRITE ( $ $ ANS , FORM3 ) $ GO TO TALPT $ CHDD0289 + +1814 FORMAT FORM4 (B8,*Y04*,B2,*A S D - P H*,S11.4,W0) $ CHDD0290 + +1824 Y04.. WRITE ( $ $ ANS , FORM4 ) $ GO TO TALPT $ CHDD0291 + +1833 FORMAT FORM5 (B8,*Y05*,B4,*C E C D*,S13.4,W0) $ CHDD0292 + +1842 Y05.. WRITE ( $ $ ANS , FORM5 ) $ GO TO TALPT $ CHDD0293 + +1851 FORMAT FORM6 (B8,*Y06*,B3,*P A P V C*,S12.4,W0) $ CHDD0294 + +1860 Y06.. WRITE ( $ $ ANS , FORM6 ) $ GO TO TALPT $ CHDD0295 + +1869 FORMAT FORM7 (B8,*Y07*,B3,*T A P V C*,S12.4,W0) $ CHDD0296 + +1878 Y07.. WRITE ( $ $ ANS , FORM7 ) $ GO TO TALPT $ CHDD0297 + +1887 FORMAT FORM8 (B8,*Y08*,B6,*T A*,S15.4,W0) $ CHDD0298 + +1895 Y08.. WRITE ( $ $ ANS , FORM8 ) $ GO TO TALPT $ CHDD0299 + +1904 FORMAT FORM9 (B8,*Y09*,B5,*EBST.*,S14.4,W0) $ CHDD0300 + +1913 Y09.. WRITE ( $ $ ANS , FORM9 ) $ GO TO TALPT $ CHDD0301 + +1922 FORMAT FORM10(B8,*Y10*,B1,*V S D - V P S*,S10.4,W0) $ CHDD0302 + +1932 Y10.. WRITE ( $ $ ANS , FORM10 ) $ GO TO TALPT $ CHDD0303 + +1941 FORMAT FORM11(B8,*Y11*,B1,*V S D - I P S*,S10.4,W0) $ CHDD0304 + +1951 Y11.. WRITE ( $ $ ANS , FORM11 ) $ GO TO TALPT $ CHDD0305 + +1960 FORMAT FORM12(B8,*Y12*,B5,*V P S*,S14.4,W0) $ CHDD0306 + +1969 Y12.. WRITE ( $ $ ANS , FORM12 ) $ GO TO TALPT $ CHDD0307 + +1978 FORMAT FORM13(B8,*Y13*,B5,*I P S*,S14.4,W0) $ CHDD0308 + +1987 Y13.. WRITE ( $ $ ANS , FORM13 ) $ GO TO TALPT $ CHDD0309 + +1996 FORMAT FORM14(B8,*Y14*,B3,*P. ATRES.*,S12.4,W0) $ CHDD0310 + +2005 Y14.. WRITE ( $ $ ANS , FORM14 ) $ GO TO TALPT $ CHDD0311 + +2014 FORMAT FORM15(B8,*Y15*,B2,*COARCT. P A*,S11.4,W0) $ CHDD0312 + +2024 Y15.. WRITE ( $ $ ANS , FORM15 ) $ GO TO TALPT $ CHDD0313 + +2033 FORMAT FORM16(B8,*Y16*,B6,*P H*,S15.4,W0) $ CHDD0314 + +2041 Y16.. WRITE ( $ $ ANS , FORM16 ) $ GO TO TALPT $ CHDD0315 + +2050 FORMAT FORM17(B8,*Y17*,B5,*A P W*,S14.4,W0) $ CHDD0316 + +2059 Y17.. WRITE ( $ $ ANS , FORM17 ) $ GO TO TALPT $ CHDD0317 + +2068 FORMAT FORM18(B8,*Y18*,B5,*P D A*,S14.4,W0) $ CHDD0318 + +2077 Y18.. WRITE ( $ $ ANS , FORM18 ) $ GO TO TALPT $ CHDD0319 + +2086 FORMAT FORM19(B8,*Y19*,B2,*P A-V FIST.*,S11.4,W0) $ CHDD0320 + +2096 Y19.. WRITE ( $ $ ANS , FORM19 ) $ GO TO TALPT $ CHDD0321 + +2105 FORMAT FORM20(B8,*Y20*,B6,*M S*,S15.4,W0) $ CHDD0322 + +2113 Y20.. WRITE ( $ $ ANS , FORM20 ) $ GO TO TALPT $ CHDD0323 + +2122 FORMAT FORM21(B8,*Y21*,B4,*MYOC. D*,S13.4,W0) $ CHDD0324 + +2131 Y21.. WRITE ( $ $ ANS , FORM21 ) $ GO TO TALPT $ CHDD0325 + +2140 FORMAT FORM22(B8,*Y22*,B2,*A O COR. A*,S12.4,W0) $ CHDD0326 + +2150 Y22.. WRITE ( $ $ ANS , FORM22 ) $ GO TO TALPT $ CHDD0327 + +2159 FORMAT FORM23(B8,*Y23*,B2,*A S - VALV.*,S11.4,W0) $ CHDD0328 + +2169 Y23.. WRITE ( $ $ ANS , FORM23 ) $ GO TO TALPT $ CHDD0329 + +2178 FORMAT FORM24(B8,*Y24*,B2,*A S - SUB.*,S12.4,W0) $ CHDD0330 + +2188 Y24.. WRITE ( $ $ ANS , FORM24 ) $ GO TO TALPT $ CHDD0331 + +2197 FORMAT FORM25(B8,*Y25*,B3,*COARCT. A*,S12.4,W0) $ CHDD0332 + +2206 Y25.. WRITE ( $ $ ANS , FORM25 ) $ GO TO TALPT $ CHDD0333 + +2215 FORMAT FORM26(B8,*Y26*,B4,*TRUNC.*,S14.4,W0) $ CHDD0334 + +2224 Y26.. WRITE ( $ $ ANS , FORM26 ) $ GO TO TALPT $ CHDD0335 + +2233 FORMAT FORM27(B8,*Y27*,B3,*TRANSP.*,S14.4,W0) $ CHDD0336 + +2242 Y27.. WRITE ( $ $ ANS , FORM27 ) $ GO TO TALPT $ CHDD0337 + +2251 FORMAT FORM28(B8,*Y28*,B3,*C TRANSP.*,S12.4,W0) $ CHDD0338 + +2260 Y28.. WRITE ( $ $ ANS , FORM28 ) $ GO TO TALPT $ CHDD0339 + +2269 FORMAT FORM29(B8,*Y29*,B4,*AB. A O*,S13.4,W0) $ CHDD0340 + +2278 Y29.. WRITE ( $ $ ANS , FORM29 ) $ GO TO TALPT $ CHDD0341 + +2287 FORMAT FORM30(B8,*Y30*,B5,*V S D*,S14.4,W0) $ CHDD0342 + +2296 Y30.. WRITE ( $ $ ANS , FORM30 ) $ GO TO TALPT $ CHDD0343 + +2305 FORMAT FORM31(B8,*Y31*,B2,*V S D - P H*,S11.4,W0) $ CHDD0344 + +2315 Y31.. WRITE ( $ $ ANS , FORM31 ) $ GO TO TALPT $ CHDD0345 + +2324 FORMAT FORM32(B8,*Y32*,B2,*P D A - P H*,S11.4,W0) $ CHDD0346 + +2334 Y32.. WRITE ( $ $ ANS , FORM32 ) $ GO TO TALPT $ CHDD0347 + +2343 FORMAT FORM33(B8,*Y33*,B1,*T A - TRANSP.*,S10.4,W0) $ CHDD0348 + +2353 Y33.. WRITE ( $ $ ANS , FORM33 ) $ GO TO TALPT $ CHDD0349 + +2353 + +2362 TALPT.. K = K+1 $ CHDD0350 + +2365 IF K LEQ 33 $ GO TO PRINT $ CHDD0351 + +2365 + +2371 COMMENT PROGRAM REPEATS TO BEGINNING IF THERE ARE MORE CHDD0352 + +2371 CASES TO BE RUN, AND HALTS IF NOT. THE INITIALS CHDD0353 + +2371 H W APPEAR IN THE A-REG. UPON COMPLETION. $CHDD0354 + +2371 + +2371 IF LAST EQL 0 $ GO TO NEWCASE $ CHDD0355 + +2375 STOP 7270061216 $ GO TO NEWCASE $ CHDD0356 + +2378 FINISH $ CHDD0357 +2380 UNPACK +2486 FINISH $ +COMPILED PROGRAM ENDS AT 2485 +PROGRAM VARIABLES BEGIN AT 3562 + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS OMITTED 0 + + SYMPTOMS USED W + + EQUATION USED 10 + + + DISEASE PROBABILITY + + Y10 V S D - V P S .0286 + Y11 V S D - I P S .0201 + Y12 V P S .7307 + Y13 I P S .2154 + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS OMITTED 11 0 + + SYMPTOMS USED W + + EQUATION USED 10 + + + DISEASE PROBABILITY + + Y10 V S D - V P S .0297 + Y11 V S D - I P S .0209 + Y12 V P S .7290 + Y13 I P S .2150 + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 29 34 36 43 48 50 + + SYMPTOMS USED W + + EQUATION USED 9 + + + DISEASE PROBABILITY + + Y02 A S D .0171 + Y10 V S D - V P S .1983 + Y11 V S D - I P S .2314 + Y12 V P S .4245 + Y13 I P S .1226 + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS OMITTED 0 + + SYMPTOMS USED B + + EQUATION USED 10 + + + DISEASE PROBABILITY + + Y02 A S D .0162 + Y10 V S D - V P S .0610 + Y11 V S D - I P S .0429 + Y12 V P S .6861 + Y13 I P S .1982 + Y31 V S D - P H .0640 + + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS OMITTED 11 0 + + SYMPTOMS USED B + + EQUATION USED 10 + + + DISEASE PROBABILITY + + Y02 A S D .0166 + Y10 V S D - V P S .0626 + Y11 V S D - I P S .0440 + Y12 V P S .6761 + Y13 I P S .1953 + Y31 V S D - P H .0780 + + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS USED B + + EQUATION USED 9 + + + DISEASE PROBABILITY + + Y02 A S D .0113 + Y10 V S D - V P S .3490 + Y11 V S D - I P S .4072 + Y12 V P S .1680 + Y13 I P S .0485 + Y31 V S D - P H .0163 + + + + + CASE NUMBER 967 PATIENT LDR DATE 5 11 61 + + SYMPTOMS PRESENT 3 10 17 21 29 34 36 + + SYMPTOMS USED B + + EQUATION USED 9 + + + DISEASE PROBABILITY + + Y02 A S D .0113 + Y10 V S D - V P S .3490 + Y11 V S D - I P S .4072 + Y12 V P S .1680 + Y13 I P S .0485 + Y31 V S D - P H .0163 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/README.txt b/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/README.txt new file mode 100644 index 0000000..ea0c6aa --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/README.txt @@ -0,0 +1,41 @@ +Index of folder retro-220/software/BALGOL/BALGOL-Examples/MRS-081/ +ORIGINAL-1961: + + +UNPACK.card + Source deck for the machine-language UNPACK subprogram used by the + BALGOL program to unpack rows from the symptom-disease probability + matrix during execution. This deck was reverse-engineered from the + numeric object code in the MRS-081 report. Assemble with the + BAC-Assembler. + + As published, the machine-language routine was written for the + BALGOL parameter-passing sequence used in the compiler dated + 1961-02-20 -- the one used in the report. The compiler available to + and recovered as part of the retro-220 project (dated 1962-02-01) + passes parameters in the reverse order. + + Thus, this version of the subprogram cannot be used with the + available compiler. See Appendix F, "Construction of Machine + Language Programs" in the March 1963 Revised Edition of the BAC-220 + Burroughs Algebraic Compiler manual (220-21017). + +UNPACK.lst + Assembly listing generated from UNPACK.card. + +UNPACK-ML.card + Object machine-language card deck generated by assembling + UNPACK.card. The BAC-Assembler produces a machine-language deck with + six words per card. That output has been manually reformatted to + match the (mostly) five word-per-card layout shown in the report. + This reformatting was done to match the machine-language deck as + presented in the report and to allow direct verification of the + assembled object code with the transcribed object code. The + transcribed object code may never have had an assembler source and + was likely programmed directly in numeric machine language. + + +Paul Kimpel +December 2019 + Original version. + diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK-ML.card b/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK-ML.card new file mode 100644 index 0000000..09b0267 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK-ML.card @@ -0,0 +1,23 @@ +605 7009901000080002400088800014000898000046008680000100104 +605 8041040009080401260090800001000918000041010380210370012 +605 8021626008680000300053802042600868000044006580000300066 +605 8020526008680421260090800001000948000044006580000300066 +605 0000001000080427260090800001000968000044006580000300066 +605 8000010010180201360040800001000908041040003500000010000 +605 8020126008680433270090800001000928000044006580000300066 +605 0000046000080000300060000000100000000001000000000010000 +605 8000010010480000120097804104000488000010009980000120093 +605 8041040004600000100000000004800060031040000000000010000 +605 8020226008680409270090800001000958000044006580000300066 +605 8000030006000000010000000000100000000001000000000010000 +605 8000042008880000410089800001000008041040006400000300000 +605 0000030000080000420090800001200998041040007280410400070 +605 0000041000080401260072000001000000000149000410310400000 +605 8000120007600001490003103104000008000120007900001490003 +605 1031040000080001200082802012700868000032007180000460086 +602 8000030006500000000001 +604 00000010000000000100000000001000000000010000 +604 00000 2000000000070000000000800000000009 +604 00000 15000000000180000000001900000000001 +601 40000000007 +601 40000990000 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK.card b/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK.card new file mode 100644 index 0000000..39d22b8 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK.card @@ -0,0 +1,150 @@ +1 REM UNPACK WORDS ROUTINE FOR MRS-081 PROGRAM +1 REM +1 REM UNPACKS THREE 3-DIGIT CODES PER WORD FROM A ROW OF THE +1 REM PROGRAM-S M(,) ARRAY TO ANOTHER ARRAY ROW. +1 REM PARAMETERS.. +1 REM M() 1-DIMENSIONAL SOURCE ROW +1 REM (HIDDEN) STRIDE OF M PASSED BY BALGOL +1 REM SHEET SHEET TYPE (0=BROWN, 1=WHITE) +1 REM XRAY XRAY DATA (0=EXCL, 1=INCL, NOT IMPL) +1 REM EQUATION EQUATION NUMBER (9 OR 10) +1 REM ROW() DESTINATION ROW FOR UNPACKED CODES +1 REM (HIDDEN) STRIDE OF ROW PASSED IN A-REG +1 REM +1 REM THIS IS THE ORIGINAL VERSION, DISASSEMBLED FROM THE +1 REM PUBLISHED CODE, WITH PARAMETERS IN ASCENDING LOCATIONS +1 REM WITH RESPECT TO THEIR ORDER IN THE BALGOL CALLING +1 REM SEQUENCE, WITH THE (44) FIELD OF THE ENTRY POINT WORD +1 REM SPECIFYING THE BEGINNING OF THE PARAMETER AREA, AS FOR +1 REM THE VERSION OF THE COMPILER DATED 1961-02-20. +1 REM +1 UNPAK NOP 7 *-*,PARAM ENTRY POINT +1 STB 8 SAVEB SAVE B+R REGS +1 STR 8 SAVER +1 CLL 8 COUNT ZERO THE WORD COUNT +1 CAD 8 ROW LOAD ROW() BASE ADDR +1 STA 8 ROWA,04 SET ADDR IN ROWA +1 IFL 8 ROWA,04,1 INCR ROWA TO ROW(1) +1 CAD 8 K2 OFFSET TO M(2) +1 LDR 8 EQNR R = EQUATION NR +1 BFR 8 A+,02,10 BRANCH IF EQNR=10 +1 REM +1 REM UNPACK FOR EQUATION NR NEQ 10 +1 REM +1 IFL 8 COUNT,02,16 SET COUNT=16 +1 BUN 8 F+ BRANCH TO FINISH UP +1 REM +1 REM UNPACK FOR EQUATION NR EQL 10 +1 REM +1 *A IFL 8 COUNT,02,4 SET COUNT = 4 +1 STP 8 UPW CALL TO UPACK 5 WORDS +1 BUN 8 UPW+1 +1 IFL 8 COUNT,02,5 SET COUNT = 5 +1 IFL 8 ROWA,04,21 INCR ROWA TO ROW(22) +1 CAD 8 K9 OFFSET TO M(9) +1 STP 8 UPW CALL TO UNPACK 6 WORDS +1 BUN 8 UPW+1 +1 NOP 0 (NOT USED) +1 IFL 8 ROWA,04,27 INCR ROWA BY 27 TO ROW(49) +1 CAD 8 K18 OFFSET TO M(18) +1 STP 8 UPW CALL TO UNPACK 1 WORD (COUNT=0) +1 BUN 8 UPW+1 +1 CAD 8 SHEET A = SHEET PARAM +1 BFA 8 B+,02,1 BRANCH IF SHEET=01 +1 REM +1 REM PROCESS SHEET NEQ 1 CASE +1 REM +1 CAD 8 ROWA LOAD CURR ROW() ADDR +1 STA 8 C+,04 SET CLL ADDRESS BELOW +1 NOP 0 (NOT USED) +1 IFL 8 COUNT,02,1 SET COUNT = 1 +1 DFL 8 ROWA,04,33 DECR ROWA BY 33 TO ROW(16) +1 CAD 8 K7 OFFSET TO M(7) +1 STP 8 UPW CALL TO UNPACK 2 WORDS +1 BUN 8 UPW+1 +1 *C CLL *-* CLEAR ROW() CELL SET ABOVE +1 BUN 8 EXIT ALL DONE +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 REM +1 REM PROCESS SHEET EQL 1 CASE +1 REM +1 *B CAD 8 ROW LOAD ROW() BASE ADDRESS +1 ADD 8 K19 OFFSET TO ROW(19) +1 STA 8 D+,04 SET STA ADDRESS BELOW +1 CAD 8 M LOAD BASE ADDRESS OF M() +1 ADD 8 K8 OFFSET TO M(8) +1 STA 8 *+1,04 SET CAD ADDRESS, NEXT +1 CAD *-* LOAD M(8) WORD AS SET ABOVE +1 SRA 6 SHIFT WORD TO 1ST CODE +1 *D STA *-*,03 STORE CODE IN ROW() AS SET ABOVE +1 NOP 0 (NOT USED) +1 IFL 8 COUNT,02,2 SET COUNT = 2 +1 DFL 8 ROWA,04,9 DECR ROWA BY 9 TO ROW(10) +1 CAD 8 K15 OFFSET TO M(15) +1 *F STP 8 UPW CALL TO UNPACK 3 WORDS +1 BUN 8 UPW+1 +1 BUN 8 EXIT ALL DONE +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 EXIT LDB 8 SAVEB RESTORE B-REG +1 LDR 8 SAVER RESTORE R-REG +1 CAD 8 UNPAK EXTRACT RETURN ADDRESS +1 STA 8 *+1,04 SET RETURN ADDRESS, NEXT +1 BUN *-* RETURN TO CALLER +1 REM +1 REM UPW.. SUBROUTINE TO UNPACK A RANGE OF WORDS +1 REM A-REG OFFSET IN M() TO 1ST SOURCE WORD +1 REM COUNT COUNT -1 OF WORDS TO UNPACK +1 REM ROWA ADDR IN ROW() TO 1ST DESTINATION WORD +1 REM RETURNS WITH A, R, AND B OVERWRITTEN, COUNT SET TO 0 +1 REM +1 UPW BUN *-* RETURN TO CALLER +1 LDB 8 ROWA ENTRY POINT, B = CURR ROW() ADDR +1 ADD 8 M ADD ADDRESS OF M() TO OFFSET +1 STA 8 MA+,04 SET CAD ADDRESS AT OFFSET +1 STA 8 *+1,04 SET LDR ADDRESS AT OFFSET +1 LDR *-* LOAD FIRST WORD OF RANGE +1 *NW IFL 8 *+1,04,1 INCR CAD ADDRESS +1 *MA CAD *-* LOAD NEXT WORD INTO A +1 SLT 4 ROTATE A+R LEFT TO 1ST CODE +1 STA - 0,03 STORE 1ST 3-DIGIT CODE TO ROW() +1 IBB 8 *+1,1 INCR ROW() ADDR +1 SLT 3 ROTATE A+R TO 2ND CODE +1 STA - 0,03 STORE 2ND 3-DIGIT CODE TO ROW() +1 IBB 8 *+1,1 INCR ROW() ADDR +1 SLT 3 ROTATE A+R TO 3RD CODE +1 STA - 0,03 STORE 3RD 3-DIGIT CODE TO ROW() +1 IBB 8 *+1,1 INCR ROW() ADDR +1 DFL 8 COUNT,02,1 DECREMENT WORD COUNT +1 BRP 8 NW- LOOP IF COUNT NOT EXHAUSTED +1 CLL 8 COUNT OTHERWISE, CLEAR COUNT AND +1 BUN 8 UPW EXIT SUBROUTINE +1 REM +1 REM STORAGE, CONSTANTS, AND PARAMETERS +1 REM +1 COUNT CNST 1 WORD COUNT FOR UNPACKING +1 NOP 0 (NOT USED) +1 SAVEB NOP 0 SAVED B-REG +1 SAVER NOP 0 SAVED R-REG +1 ROWA NOP 0 CURRENT ROW() ADDR +1 K2 HLT 2 CONSTANT 2 +1 K7 HLT 7 CONSTANT 7 +1 K8 HLT 8 CONSTANT 8 +1 K9 HLT 9 CONSTANT 9 +1 K15 HLT 15 CONSTANT 15 +1 K18 HLT 18 CONSTANT 18 +1 K19 HLT 19 CONSTANT 19 +1 HLT 1 (NOT USED) +1 PARAM CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS +1 M DEFN PARAM+0 ADDR OF ARRAY M() +1 M1STR DEFN PARAM+1 STRIDE FOR M() (NOT USED, =1) +1 SHEET DEFN PARAM+2 SHEET TYPE +1 XRAY DEFN PARAM+3 XRAY PARAM (NOT USED) +1 EQNR DEFN PARAM+4 EQUATION NUMBER +1 ROW DEFN PARAM+5 ADDR OF OUTPUT ROW() ARRAY +1 CNST 40000990000 +1 FINI diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK.lst b/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK.lst new file mode 100644 index 0000000..7e11685 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK.lst @@ -0,0 +1,168 @@ +Assembler for the Burroughs 220 BALGOL Compiler & Library -- 2019-12-21 15:07 + +Source File: UNPACK.card + +START PASS 2 + + UNPACK WORDS ROUTINE FOR MRS-081 PROGRAM + + UNPACKS THREE 3-DIGIT CODES PER WORD FROM A ROW OF THE + PROGRAM-S M(,) ARRAY TO ANOTHER ARRAY ROW. + PARAMETERS.. + M() 1-DIMENSIONAL SOURCE ROW + (HIDDEN) STRIDE OF M PASSED BY BALGOL + SHEET SHEET TYPE (0=BROWN, 1=WHITE) + XRAY XRAY DATA (0=EXCL, 1=INCL, NOT IMPL) + EQUATION EQUATION NUMBER (9 OR 10) + ROW() DESTINATION ROW FOR UNPACKED CODES + (HIDDEN) STRIDE OF ROW PASSED IN A-REG + + THIS IS THE ORIGINAL VERSION, DISASSEMBLED FROM THE + PUBLISHED CODE, WITH PARAMETERS IN ASCENDING LOCATIONS + WITH RESPECT TO THEIR ORDER IN THE BALGOL CALLING + SEQUENCE, WITH THE (44) FIELD OF THE ENTRY POINT WORD + SPECIFYING THE BEGINNING OF THE PARAMETER AREA, AS FOR + THE VERSION OF THE COMPILER DATED 1961-02-20. + + 21 0000 7 0099 01 0000 UNPAK NOP 7 *-*,PARAM ENTRY POINT + 22 0001 8 0002 40 0088 STB 8 SAVEB SAVE B+R REGS + 23 0002 8 0001 40 0089 STR 8 SAVER + 24 0003 8 0000 46 0086 CLL 8 COUNT ZERO THE WORD COUNT + 25 0004 8 0000 10 0104 CAD 8 ROW LOAD ROW() BASE ADDR + 26 0005 8 0410 40 0090 STA 8 ROWA,04 SET ADDR IN ROWA + 27 0006 8 0401 26 0090 IFL 8 ROWA,04,1 INCR ROWA TO ROW(1) + 28 0007 8 0000 10 0091 CAD 8 K2 OFFSET TO M(2) + 29 0008 8 0000 41 0103 LDR 8 EQNR R = EQUATION NR + 30 0009 8 0210 37 0012 BFR 8 A+,02,10 BRANCH IF EQNR=10 + + UNPACK FOR EQUATION NR NEQ 10 + + 34 0010 8 0216 26 0086 IFL 8 COUNT,02,16 SET COUNT=16 + 35 0011 8 0000 30 0053 BUN 8 F+ BRANCH TO FINISH UP + + UNPACK FOR EQUATION NR EQL 10 + + 39 0012 8 0204 26 0086 *A IFL 8 COUNT,02,4 SET COUNT = 4 + 40 0013 8 0000 44 0065 STP 8 UPW CALL TO UPACK 5 WORDS + 41 0014 8 0000 30 0066 BUN 8 UPW+1 + 42 0015 8 0205 26 0086 IFL 8 COUNT,02,5 SET COUNT = 5 + 43 0016 8 0421 26 0090 IFL 8 ROWA,04,21 INCR ROWA TO ROW(22) + 44 0017 8 0000 10 0094 CAD 8 K9 OFFSET TO M(9) + 45 0018 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 6 WORDS + 46 0019 8 0000 30 0066 BUN 8 UPW+1 + 47 0020 0 0000 01 0000 NOP 0 (NOT USED) + 48 0021 8 0427 26 0090 IFL 8 ROWA,04,27 INCR ROWA BY 27 TO ROW(49) + 49 0022 8 0000 10 0096 CAD 8 K18 OFFSET TO M(18) + 50 0023 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 1 WORD (COUNT=0) + 51 0024 8 0000 30 0066 BUN 8 UPW+1 + 52 0025 8 0000 10 0101 CAD 8 SHEET A = SHEET PARAM + 53 0026 8 0201 36 0040 BFA 8 B+,02,1 BRANCH IF SHEET=01 + + PROCESS SHEET NEQ 1 CASE + + 57 0027 8 0000 10 0090 CAD 8 ROWA LOAD CURR ROW() ADDR + 58 0028 8 0410 40 0035 STA 8 C+,04 SET CLL ADDRESS BELOW + 59 0029 0 0000 01 0000 NOP 0 (NOT USED) + 60 0030 8 0201 26 0086 IFL 8 COUNT,02,1 SET COUNT = 1 + 61 0031 8 0433 27 0090 DFL 8 ROWA,04,33 DECR ROWA BY 33 TO ROW(16) + 62 0032 8 0000 10 0092 CAD 8 K7 OFFSET TO M(7) + 63 0033 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 2 WORDS + 64 0034 8 0000 30 0066 BUN 8 UPW+1 + 65 0035 0 0000 46 0000 *C CLL *-* CLEAR ROW() CELL SET ABOVE + 66 0036 8 0000 30 0060 BUN 8 EXIT ALL DONE + 67 0037 0 0000 01 0000 NOP 0 (NOT USED) + 68 0038 0 0000 01 0000 NOP 0 (NOT USED) + 69 0039 0 0000 01 0000 NOP 0 (NOT USED) + + PROCESS SHEET EQL 1 CASE + + 73 0040 8 0000 10 0104 *B CAD 8 ROW LOAD ROW() BASE ADDRESS + 74 0041 8 0000 12 0097 ADD 8 K19 OFFSET TO ROW(19) + 75 0042 8 0410 40 0048 STA 8 D+,04 SET STA ADDRESS BELOW + 76 0043 8 0000 10 0099 CAD 8 M LOAD BASE ADDRESS OF M() + 77 0044 8 0000 12 0093 ADD 8 K8 OFFSET TO M(8) + 78 0045 8 0410 40 0046 STA 8 *+1,04 SET CAD ADDRESS, NEXT + 79 0046 0 0000 10 0000 CAD *-* LOAD M(8) WORD AS SET ABOVE + 80 0047 0 0000 48 0006 SRA 6 SHIFT WORD TO 1ST CODE + 81 0048 0 0310 40 0000 *D STA *-*,03 STORE CODE IN ROW() AS SET ABOVE + 82 0049 0 0000 01 0000 NOP 0 (NOT USED) + 83 0050 8 0202 26 0086 IFL 8 COUNT,02,2 SET COUNT = 2 + 84 0051 8 0409 27 0090 DFL 8 ROWA,04,9 DECR ROWA BY 9 TO ROW(10) + 85 0052 8 0000 10 0095 CAD 8 K15 OFFSET TO M(15) + 86 0053 8 0000 44 0065 *F STP 8 UPW CALL TO UNPACK 3 WORDS + 87 0054 8 0000 30 0066 BUN 8 UPW+1 + 88 0055 8 0000 30 0060 BUN 8 EXIT ALL DONE + 89 0056 0 0000 01 0000 NOP 0 (NOT USED) + 90 0057 0 0000 01 0000 NOP 0 (NOT USED) + 91 0058 0 0000 01 0000 NOP 0 (NOT USED) + 92 0059 0 0000 01 0000 NOP 0 (NOT USED) + 93 0060 8 0000 42 0088 EXIT LDB 8 SAVEB RESTORE B-REG + 94 0061 8 0000 41 0089 LDR 8 SAVER RESTORE R-REG + 95 0062 8 0000 10 0000 CAD 8 UNPAK EXTRACT RETURN ADDRESS + 96 0063 8 0410 40 0064 STA 8 *+1,04 SET RETURN ADDRESS, NEXT + 97 0064 0 0000 30 0000 BUN *-* RETURN TO CALLER + + UPW.. SUBROUTINE TO UNPACK A RANGE OF WORDS + A-REG OFFSET IN M() TO 1ST SOURCE WORD + COUNT COUNT -1 OF WORDS TO UNPACK + ROWA ADDR IN ROW() TO 1ST DESTINATION WORD + RETURNS WITH A, R, AND B OVERWRITTEN, COUNT SET TO 0 + + 105 0065 0 0000 30 0000 UPW BUN *-* RETURN TO CALLER + 106 0066 8 0000 42 0090 LDB 8 ROWA ENTRY POINT, B = CURR ROW() ADDR + 107 0067 8 0000 12 0099 ADD 8 M ADD ADDRESS OF M() TO OFFSET + 108 0068 8 0410 40 0072 STA 8 MA+,04 SET CAD ADDRESS AT OFFSET + 109 0069 8 0410 40 0070 STA 8 *+1,04 SET LDR ADDRESS AT OFFSET + 110 0070 0 0000 41 0000 LDR *-* LOAD FIRST WORD OF RANGE + 111 0071 8 0401 26 0072 *NW IFL 8 *+1,04,1 INCR CAD ADDRESS + 112 0072 0 0000 10 0000 *MA CAD *-* LOAD NEXT WORD INTO A + 113 0073 0 0001 49 0004 SLT 4 ROTATE A+R LEFT TO 1ST CODE + 114 0074 1 0310 40 0000 STA - 0,03 STORE 1ST 3-DIGIT CODE TO ROW() + 115 0075 8 0001 20 0076 IBB 8 *+1,1 INCR ROW() ADDR + 116 0076 0 0001 49 0003 SLT 3 ROTATE A+R TO 2ND CODE + 117 0077 1 0310 40 0000 STA - 0,03 STORE 2ND 3-DIGIT CODE TO ROW() + 118 0078 8 0001 20 0079 IBB 8 *+1,1 INCR ROW() ADDR + 119 0079 0 0001 49 0003 SLT 3 ROTATE A+R TO 3RD CODE + 120 0080 1 0310 40 0000 STA - 0,03 STORE 3RD 3-DIGIT CODE TO ROW() + 121 0081 8 0001 20 0082 IBB 8 *+1,1 INCR ROW() ADDR + 122 0082 8 0201 27 0086 DFL 8 COUNT,02,1 DECREMENT WORD COUNT + 123 0083 8 0000 32 0071 BRP 8 NW- LOOP IF COUNT NOT EXHAUSTED + 124 0084 8 0000 46 0086 CLL 8 COUNT OTHERWISE, CLEAR COUNT AND + 125 0085 8 0000 30 0065 BUN 8 UPW EXIT SUBROUTINE + + STORAGE, CONSTANTS, AND PARAMETERS + + 129 0086 0 0000 00 0001 COUNT CNST 1 WORD COUNT FOR UNPACKING + 130 0087 0 0000 01 0000 NOP 0 (NOT USED) + 131 0088 0 0000 01 0000 SAVEB NOP 0 SAVED B-REG + 132 0089 0 0000 01 0000 SAVER NOP 0 SAVED R-REG + 133 0090 0 0000 01 0000 ROWA NOP 0 CURRENT ROW() ADDR + 134 0091 0 0000 00 0002 K2 HLT 2 CONSTANT 2 + 135 0092 0 0000 00 0007 K7 HLT 7 CONSTANT 7 + 136 0093 0 0000 00 0008 K8 HLT 8 CONSTANT 8 + 137 0094 0 0000 00 0009 K9 HLT 9 CONSTANT 9 + 138 0095 0 0000 00 0015 K15 HLT 15 CONSTANT 15 + 139 0096 0 0000 00 0018 K18 HLT 18 CONSTANT 18 + 140 0097 0 0000 00 0019 K19 HLT 19 CONSTANT 19 + 141 0098 0 0000 00 0001 HLT 1 (NOT USED) + 142 0099 4 0000 00 0007 PARAM CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS + 143 0100 M DEFN PARAM+0 ADDR OF ARRAY M() + 144 0100 M1STR DEFN PARAM+1 STRIDE FOR M() (NOT USED, =1) + 145 0100 SHEET DEFN PARAM+2 SHEET TYPE + 146 0100 XRAY DEFN PARAM+3 XRAY PARAM (NOT USED) + 147 0100 EQNR DEFN PARAM+4 EQUATION NUMBER + 148 0100 ROW DEFN PARAM+5 ADDR OF OUTPUT ROW() ARRAY + 149 0100 4 0000 99 0000 CNST 40000990000 + 150 0101 FINI + + +SYMBOL TABLE + + 12 *A..1 40 *B..1 35 *C..1 48 *D..1 53 *F..1 + 72 *MA.1 71 *NW.1 8 BMOD 86 COUNT 103 EQNR + 60 EXIT 95 K15 96 K18 97 K19 91 K2 + 92 K7 93 K8 94 K9 99 M 100 M1STR + 99 PARAM 1 RLO 104 ROW 90 ROWA 88 SAVEB + 89 SAVER 101 SHEET 0 UNPAK 65 UPW 102 XRAY + +END PASS 2, ERRORS = 0 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/README.txt b/software/BALGOL/BALGOL-Examples/MRS-081/README.txt index 39bf46a..21714b1 100644 --- a/software/BALGOL/BALGOL-Examples/MRS-081/README.txt +++ b/software/BALGOL/BALGOL-Examples/MRS-081/README.txt @@ -1,25 +1,27 @@ Index of folder retro-220/software/BALGOL/BALGOL-Examples/MRS-081: -Source, object, and compilation listings for BALGOL program from +Source, object, and compilation listings for a BALGOL program from Burroughs Technical Bulletin 156, 8 June 1961, Mathematical Report Series MRS-081, "Diagnosis of Congenital Heart Disease from Clinical Data Using the Burroughs 220 Computer". The program listing is included in the report and is noted as having been written by Fred B. Fielding of the Burroughs San Francisco District office in May 1961. -This report was discovered in the Burroughs Corporation Records, Product -Literature (CBI 90), Charles Babbage Institute, University of -Minnesota, Minneapolis, Series 74, Box 43, Folder 8. +This report was discovered during October 2019 in the Burroughs +Corporation Records, Product Literature (CBI 90), Charles Babbage +Institute, University of Minnesota, Minneapolis, Series 74, Box 43, +Folder 8. The program and report are based on a paper, "A Mathematical Approach to Medical Diagnosis Applied to Congenital Heart Disease" by H. R. Warner, A. F. Toronto, L.G. Veasy, and R. Stevenson. Journal of the American -Medical Association, +Medical Association, 22 July 1961: 177(3), pp. 171-183, +doi:10.1001/jama.1961.03040290005002. The report describes a program for computing the probability of a set of congenital heart diseases occurring in a patient given the presence of a set of symptoms observed in the patient. It includes sample data and an -example of using a machine-language routine with a BALGOL program. +example of using a machine-language subroutine with a BALGOL program. To run the program, load the following decks into the Cardatron card reader in the order indicated and compile with the BALGOL compiler: @@ -27,15 +29,25 @@ reader in the order indicated and compile with the BALGOL compiler: 1. BALGOL compiler call-out card. 2. MRS-081.card deck -- BALGOL source and machine-language cards. 3. SYMPTOM-DATA.card deck. - 4. Case-data card deck, e.g., MRS-081-DATA.card. + 4. Case-data card deck, e.g., CASE-DATA.card. MRS-081.card The BALGOL source deck, including the object deck for the machine- - language subprogram. This is the original version, as transcribed - from the report. + language subprogram. This is the original version of the BALGOL + program, as transcribed from the report, but with a corrected + version of the machine-language code for the UNPACK subroutine as + discussed below. -MRS-081-DATA.card +MRS-081.lst + Compilation and run listing generated from MRS-081.card with the + SYMPTOM-DATA.card and CASE-DATA.card decks appended. + +MRS-081-Code.lst + Compilation and run listing generated from MRS-081.card as above, + but including the object code generated by the compiler. + +CASE-DATA.card Sample case-data card deck for input to the program, derived from sample run data in the report. This data must be inserted at the end of MRS-081.card deck when the program is run. @@ -49,18 +61,22 @@ UNPACK.card Source deck for the machine-language UNPACK subprogram used by the BALGOL program to unpack rows from the symptom-disease probability matrix during execution. This deck was reverse-engineered from the - numeric object code in the MRS-081.card deck. Assemble with the - BAC-Assembler. + numeric object code in the MRS-081.card deck and then modified to + support the available compiler's parameter-passing scheme. Assemble + with the BAC-Assembler. As published, the machine-language routine was written for the BALGOL parameter-passing sequence used in the compiler dated 1961-02-20 -- the one used in the report. The compiler available to and recovered as part of the retro-220 project (dated 1962-02-01) passes parameters in the reverse order. Thus, this version of the - subprogram cannot be used with the available compiler. See Appendix - F, "Construction of Machine Language Programs" in the March 1963 - Revised Edition of the BAC-220 Burroughs Algebraic Compiler manual - (220-21017). + subprogram was modified to use the recovered compiler's scheme. See + Appendix F, "Construction of Machine Language Programs" in the March + 1963 Revised Edition of the BAC-220 Burroughs Algebraic Compiler + manual (220-21017). + + The transcribed object code may never have had an assembler source + and was likely programmed directly in numeric machine language. UNPACK.lst Assembly listing generated from UNPACK.card. @@ -71,10 +87,35 @@ UNPACK-ML.card six words per card. That output has been manually reformatted to match the (mostly) five word-per-card layout shown in the report. This reformatting was done to match the machine-language deck as - presented in the report and to allow direct verification of the - assembled object code with the transcribed object code. The - transcribed object code may never have had an assembler source and - was likely programmed directly in numeric machine language. + presented in the report. + +ORIGINAL-1961/ + Directory containing the original version of the UNPACK subroutine. + See the included README file for details. + +B5500/ + The BALGOL source, UNPACK subroutine, and data converted to + Burroughs B5500 Extended Algol, as supported by the retro-b5500 + emulator. + +E-MODE/ + The BALGOL source, UNPACK subroutine, and data converted to modern + Unisys ClearPath MCP Extended Algol. + +Note that the results from the BALGOL program differ somewhat from those +published in the report. The results from the B5500/ and E-MODE/ +versions of the program agree with each other and much more closely with +those in the report. Some variance between the 220 results and those for +the B5500 and modern E-Mode systems is to be expected, as the 220 +carries only eight decimal digits of floating-point precision and does +not round floating-point add/subtract, while the latter two systems +carry 11.5 digits (39 bits) and round. + +The more significant variance between the BALGOL results and the report +is probably due to the way the arithmetic operators are presently +implemented in the retro-220 emulator, as we do not have complete +information on the way those operators were actually mechanized in a +real 220. These variances remain under investigation. Paul Kimpel @@ -82,4 +123,8 @@ December 2019 Original version, transcribe program listing and data, disassemble machine-language routine to BAC-Assembler notation, prepare sample data deck. +27 December 2019 + Revise UNPACK subroutine for parameter-passing sequence used by + 1962-02-01 compiler, archive original UNPACK subroutine files, + include additional listings. diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card index 09b0267..1d5dc82 100644 --- a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card +++ b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card @@ -1,17 +1,17 @@ -605 7009901000080002400088800014000898000046008680000100104 -605 8041040009080401260090800001000918000041010380210370012 +605 7010501000080002400088800014000898000046008680000100100 +605 8041040009080401260090800001000918000041010180210370012 605 8021626008680000300053802042600868000044006580000300066 605 8020526008680421260090800001000948000044006580000300066 605 0000001000080427260090800001000968000044006580000300066 -605 8000010010180201360040800001000908041040003500000010000 +605 8000010010380201360040800001000908041040003500000010000 605 8020126008680433270090800001000928000044006580000300066 605 0000046000080000300060000000100000000001000000000010000 -605 8000010010480000120097804104000488000010009980000120093 +605 8000010010080000120097804104000488000010010580000120093 605 8041040004600000100000000004800060031040000000000010000 605 8020226008680409270090800001000958000044006580000300066 605 8000030006000000010000000000100000000001000000000010000 605 8000042008880000410089800001000008041040006400000300000 -605 0000030000080000420090800001200998041040007280410400070 +605 0000030000080000420090800001201058041040007280410400070 605 0000041000080401260072000001000000000149000410310400000 605 8000120007600001490003103104000008000120007900001490003 605 1031040000080001200082802012700868000032007180000460086 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card index 39d22b8..7fd4068 100644 --- a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card +++ b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card @@ -11,12 +11,12 @@ 1 REM ROW() DESTINATION ROW FOR UNPACKED CODES 1 REM (HIDDEN) STRIDE OF ROW PASSED IN A-REG 1 REM -1 REM THIS IS THE ORIGINAL VERSION, DISASSEMBLED FROM THE -1 REM PUBLISHED CODE, WITH PARAMETERS IN ASCENDING LOCATIONS -1 REM WITH RESPECT TO THEIR ORDER IN THE BALGOL CALLING -1 REM SEQUENCE, WITH THE (44) FIELD OF THE ENTRY POINT WORD -1 REM SPECIFYING THE BEGINNING OF THE PARAMETER AREA, AS FOR -1 REM THE VERSION OF THE COMPILER DATED 1961-02-20. +1 REM THIS IS THE REVISED VERSION OF THE DISASSEMBLED CODE +1 REM WITH PARAMETERS IN DESCENDING LOCATIONS WITH RESPECT +1 REM TO THEIR ORDER IN THE BALGOL CALLING SEQUENCE, AND +1 REM WITH THE (44) FIELD OF THE ENTRY POINT WORD SPECIFYING +1 REM THE END OF THE PARAMETER AREA, AS FOR THE VERSION OF +1 REM THE COMPILER DATED 1962-02-11. 1 REM 1 UNPAK NOP 7 *-*,PARAM ENTRY POINT 1 STB 8 SAVEB SAVE B+R REGS @@ -139,12 +139,13 @@ 1 K18 HLT 18 CONSTANT 18 1 K19 HLT 19 CONSTANT 19 1 HLT 1 (NOT USED) -1 PARAM CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS -1 M DEFN PARAM+0 ADDR OF ARRAY M() -1 M1STR DEFN PARAM+1 STRIDE FOR M() (NOT USED, =1) -1 SHEET DEFN PARAM+2 SHEET TYPE -1 XRAY DEFN PARAM+3 XRAY PARAM (NOT USED) -1 EQNR DEFN PARAM+4 EQUATION NUMBER -1 ROW DEFN PARAM+5 ADDR OF OUTPUT ROW() ARRAY +1 PBLK CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS +1 PARAM DEFN PBLK+6 LOCATION OF END OF PARAMETER BLOCK +1 M DEFN PARAM-0 ADDR OF ARRAY M() +1 M1STR DEFN PARAM-1 STRIDE FOR M() (NOT USED, =1) +1 SHEET DEFN PARAM-2 SHEET TYPE +1 XRAY DEFN PARAM-3 XRAY PARAM (NOT USED) +1 EQNR DEFN PARAM-4 EQUATION NUMBER +1 ROW DEFN PARAM-5 ADDR OF OUTPUT ROW() ARRAY 1 CNST 40000990000 1 FINI diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst index 7e11685..f68bcf5 100644 --- a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst +++ b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst @@ -1,4 +1,4 @@ -Assembler for the Burroughs 220 BALGOL Compiler & Library -- 2019-12-21 15:07 +Assembler for the Burroughs 220 BALGOL Compiler & Library -- 2019-12-21 13:16 Source File: UNPACK.card @@ -17,22 +17,22 @@ START PASS 2 ROW() DESTINATION ROW FOR UNPACKED CODES (HIDDEN) STRIDE OF ROW PASSED IN A-REG - THIS IS THE ORIGINAL VERSION, DISASSEMBLED FROM THE - PUBLISHED CODE, WITH PARAMETERS IN ASCENDING LOCATIONS - WITH RESPECT TO THEIR ORDER IN THE BALGOL CALLING - SEQUENCE, WITH THE (44) FIELD OF THE ENTRY POINT WORD - SPECIFYING THE BEGINNING OF THE PARAMETER AREA, AS FOR - THE VERSION OF THE COMPILER DATED 1961-02-20. + THIS IS THE REVISED VERSION OF THE DISASSEMBLED CODE + WITH PARAMETERS IN DESCENDING LOCATIONS WITH RESPECT + TO THEIR ORDER IN THE BALGOL CALLING SEQUENCE, AND + WITH THE (44) FIELD OF THE ENTRY POINT WORD SPECIFYING + THE END OF THE PARAMETER AREA, AS FOR THE VERSION OF + THE COMPILER DATED 1962-02-11. - 21 0000 7 0099 01 0000 UNPAK NOP 7 *-*,PARAM ENTRY POINT + 21 0000 7 0105 01 0000 UNPAK NOP 7 *-*,PARAM ENTRY POINT 22 0001 8 0002 40 0088 STB 8 SAVEB SAVE B+R REGS 23 0002 8 0001 40 0089 STR 8 SAVER 24 0003 8 0000 46 0086 CLL 8 COUNT ZERO THE WORD COUNT - 25 0004 8 0000 10 0104 CAD 8 ROW LOAD ROW() BASE ADDR + 25 0004 8 0000 10 0100 CAD 8 ROW LOAD ROW() BASE ADDR 26 0005 8 0410 40 0090 STA 8 ROWA,04 SET ADDR IN ROWA 27 0006 8 0401 26 0090 IFL 8 ROWA,04,1 INCR ROWA TO ROW(1) 28 0007 8 0000 10 0091 CAD 8 K2 OFFSET TO M(2) - 29 0008 8 0000 41 0103 LDR 8 EQNR R = EQUATION NR + 29 0008 8 0000 41 0101 LDR 8 EQNR R = EQUATION NR 30 0009 8 0210 37 0012 BFR 8 A+,02,10 BRANCH IF EQNR=10 UNPACK FOR EQUATION NR NEQ 10 @@ -55,7 +55,7 @@ START PASS 2 49 0022 8 0000 10 0096 CAD 8 K18 OFFSET TO M(18) 50 0023 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 1 WORD (COUNT=0) 51 0024 8 0000 30 0066 BUN 8 UPW+1 - 52 0025 8 0000 10 0101 CAD 8 SHEET A = SHEET PARAM + 52 0025 8 0000 10 0103 CAD 8 SHEET A = SHEET PARAM 53 0026 8 0201 36 0040 BFA 8 B+,02,1 BRANCH IF SHEET=01 PROCESS SHEET NEQ 1 CASE @@ -76,10 +76,10 @@ START PASS 2 PROCESS SHEET EQL 1 CASE - 73 0040 8 0000 10 0104 *B CAD 8 ROW LOAD ROW() BASE ADDRESS + 73 0040 8 0000 10 0100 *B CAD 8 ROW LOAD ROW() BASE ADDRESS 74 0041 8 0000 12 0097 ADD 8 K19 OFFSET TO ROW(19) 75 0042 8 0410 40 0048 STA 8 D+,04 SET STA ADDRESS BELOW - 76 0043 8 0000 10 0099 CAD 8 M LOAD BASE ADDRESS OF M() + 76 0043 8 0000 10 0105 CAD 8 M LOAD BASE ADDRESS OF M() 77 0044 8 0000 12 0093 ADD 8 K8 OFFSET TO M(8) 78 0045 8 0410 40 0046 STA 8 *+1,04 SET CAD ADDRESS, NEXT 79 0046 0 0000 10 0000 CAD *-* LOAD M(8) WORD AS SET ABOVE @@ -110,7 +110,7 @@ START PASS 2 105 0065 0 0000 30 0000 UPW BUN *-* RETURN TO CALLER 106 0066 8 0000 42 0090 LDB 8 ROWA ENTRY POINT, B = CURR ROW() ADDR - 107 0067 8 0000 12 0099 ADD 8 M ADD ADDRESS OF M() TO OFFSET + 107 0067 8 0000 12 0105 ADD 8 M ADD ADDRESS OF M() TO OFFSET 108 0068 8 0410 40 0072 STA 8 MA+,04 SET CAD ADDRESS AT OFFSET 109 0069 8 0410 40 0070 STA 8 *+1,04 SET LDR ADDRESS AT OFFSET 110 0070 0 0000 41 0000 LDR *-* LOAD FIRST WORD OF RANGE @@ -145,24 +145,26 @@ START PASS 2 139 0096 0 0000 00 0018 K18 HLT 18 CONSTANT 18 140 0097 0 0000 00 0019 K19 HLT 19 CONSTANT 19 141 0098 0 0000 00 0001 HLT 1 (NOT USED) - 142 0099 4 0000 00 0007 PARAM CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS - 143 0100 M DEFN PARAM+0 ADDR OF ARRAY M() - 144 0100 M1STR DEFN PARAM+1 STRIDE FOR M() (NOT USED, =1) - 145 0100 SHEET DEFN PARAM+2 SHEET TYPE - 146 0100 XRAY DEFN PARAM+3 XRAY PARAM (NOT USED) - 147 0100 EQNR DEFN PARAM+4 EQUATION NUMBER - 148 0100 ROW DEFN PARAM+5 ADDR OF OUTPUT ROW() ARRAY - 149 0100 4 0000 99 0000 CNST 40000990000 - 150 0101 FINI + 142 0099 4 0000 00 0007 PBLK CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS + 143 0100 PARAM DEFN PBLK+6 LOCATION OF END OF PARAMETER BLOCK + 144 0100 M DEFN PARAM-0 ADDR OF ARRAY M() + 145 0100 M1STR DEFN PARAM-1 STRIDE FOR M() (NOT USED, =1) + 146 0100 SHEET DEFN PARAM-2 SHEET TYPE + 147 0100 XRAY DEFN PARAM-3 XRAY PARAM (NOT USED) + 148 0100 EQNR DEFN PARAM-4 EQUATION NUMBER + 149 0100 ROW DEFN PARAM-5 ADDR OF OUTPUT ROW() ARRAY + 150 0100 4 0000 99 0000 CNST 40000990000 + 151 0101 FINI SYMBOL TABLE 12 *A..1 40 *B..1 35 *C..1 48 *D..1 53 *F..1 - 72 *MA.1 71 *NW.1 8 BMOD 86 COUNT 103 EQNR + 72 *MA.1 71 *NW.1 8 BMOD 86 COUNT 101 EQNR 60 EXIT 95 K15 96 K18 97 K19 91 K2 - 92 K7 93 K8 94 K9 99 M 100 M1STR - 99 PARAM 1 RLO 104 ROW 90 ROWA 88 SAVEB - 89 SAVER 101 SHEET 0 UNPAK 65 UPW 102 XRAY + 92 K7 93 K8 94 K9 105 M 104 M1STR + 105 PARAM 99 PBLK 1 RLO 100 ROW 90 ROWA + 88 SAVEB 89 SAVER 103 SHEET 0 UNPAK 65 UPW + 102 XRAY END PASS 2, ERRORS = 0