mirror of
https://github.com/pkimpel/retro-220.git
synced 2026-04-10 06:46:01 +00:00
Commit revised MRS-081 sample BALGOL program and results.
1. Revise UNPACK subroutine to use the available compiler's parameter- passing sequence. 2. Archive original UNPACK subroutine files in ORIGINAL-1961/. 3. Include compile listings and sample run results. 4. Port BALGOL program to B5500 and modern Unisys E-Mode dialects in order to generate comparative results.
This commit is contained in:
Paul Kimpel
829
software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.card
Normal file
829
software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.card
Normal file
@@ -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
|
||||
859
software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.lst
Normal file
859
software/BALGOL/BALGOL-Examples/MRS-081/B5500/MRS-081.lst
Normal file
@@ -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
|
||||
786
software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.lst
Normal file
786
software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.lst
Normal file
@@ -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
|
||||
|
||||
|
||||
830
software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.wfl_m
Normal file
830
software/BALGOL/BALGOL-Examples/MRS-081/E-MODE/MRS-081.wfl_m
Normal file
@@ -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
|
||||
4175
software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-Code.lst
Normal file
4175
software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-Code.lst
Normal file
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
|
||||
972
software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.lst
Normal file
972
software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.lst
Normal file
@@ -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
|
||||
@@ -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.
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
168
software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK.lst
Normal file
168
software/BALGOL/BALGOL-Examples/MRS-081/ORIGINAL-1961/UNPACK.lst
Normal file
@@ -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
|
||||
@@ -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.
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user