ACT Apricot disk image㐞>PC Toolsp 3м|66xV> | &=t&3أzx |s.0|2|61|r6b} u  t6x} u|  ur3ҡ6 |8|.3|5|64||*PXr=(8|vR& |Zر:6|rŶ%u@@ȸ6|p6}6} t };w2xzIBMBIO COMIBMDOS COMIO SYSMSDOS SYS Disk Boot Failure Non-System disk or disk error Replace and press any key when ready U㐞@`  @`! #@%`')+-/1 3@5`79;=?A C@E`GIKMOQ S@U`WY[]a c@e`gikmoq s@u`wy{} @` @ ` @ ` @ ` @ ` ɠ @ ` ׀ ٠  @` @`!Aa  !Aa!!#A%a')+-/1!3A5a79;=?A!CAEaGIKMOQ!SAUa㐞WY[_a!cAeagikmoq!sAuawy{}!Aa!Aa!Z>㐞@`  @`! #@%`')+-/1 3@5`79;=?A C@E`GIKMOQ S@U`WY[]a c@e`gikmoq s@u`wy{} @` @ ` @ ` @ ` @ ` ɠ @ ` ׀ ٠  @` @`!Aa  !Aa!!#A%a')+-/1!3A5a79;=?A!CAEaGIKMOQ!SAUa㐞WY[_a!cAeagikmoq!sAuawy{}!Aa!Aa!Z>㐞ANAST BAS %`uCALC1CP BAS $ 9CALC2CP BAS w%_CHECKCP BAS ,S$FLTCP BAS % MAINCP BAS ʃ% ;RDCP BAS [V$JKWORKCP BAS |R$]?㐞 㐞㐞㐞㐞㐞㐞2 '************************************************************ 5 ' ANAST lancement parametres methodes mode BASIC/ONE BY ONE 6 '************************************************************ 7 ' version 27/10/1988 15 DEFINT A-D, F-J, L-V, X-Z 17 DIM L(5), C(5) 19 DIM PAT$(48), K1(100), PL(50), PLM(50), PLP(50), PLPM(50), PZ(48) 25 DIM P64(64), LE(48), PLACE(48), PAR(60), B$(32), MTT$(32) 30 COMMON STATUS, METH, P64(), LE(), PLACE(), O1!, C1!, O2, C2, AIG1, AIG3, PAR(), M, M1, RE,㐞 VER, BUT, PAS, PA$, LIGNE, METP, DEMET, LIMI, NONL$, TEMPER$, DATEF$, ATTEN, MEP 31 LPRINT "in anast": GOSUB 30000: SCREEN 0: DEV% = 52: GOSUB 602: GOSUB 8240: GOSUB 45: AFFICH = 1 32 MA% = 1: F9% = 2 ^ 8: SUP% = F9%: GOSUB 600: IF BUT = 0 THEN GOSUB 1290: GOTO 3030 ELSE 3033 34 LOCATE 24, 26: PRINT SPACE$(30): RETURN 35 GOSUB 592 39 CLOSE #1: CLOSE #2: CLOSE #3: GOSUB 2207 40 WFREE = FRE(""): CHAIN PA$ 45 RESTORE 1535: GOSUB 120: FOR CVB = 0 TO 6: LOCATE 5 + CVB, 10: GOSUB 1700: NEXT CVB: RETURN 5㐞0 IF PAR(23) = 0 THEN RETURN ELSE IF AFFICH THEN 60 ELSE IF BUT = 0 THEN MSE = PAR(19 + (3 * PAR(37))) AND 31 ELSE GOSUB 2162: GET #1, (PAR(19 + (3 * PAR(37))) AND 992) / 32: NMLI$ = ST$: CLOSE #1: MSE = VAL(MID$(NMLI$, (PAR(40) * 3) - 1, 2)) 51 MME = (PAR(19 + (3 * PAR(37))) AND 992) / 32: DPL = (PAR(20 + (3 * PAR(37))) AND 496) / 16: DPL$ = RIGHT$(STR$(DPL), LEN(STR$(DPL)) - 1) 52 IF BUT = 0 THEN BV% = (PAR(19 + (3 * PAR(37))) AND 15360) / 1024 ELSE BV% = PAR(40) 53 IF (PLM(49) AND 2 ^ (BV% - 1)) <> 0 㐞 OR (METP = 0 AND PLM(49) <> 0) THEN ST$ = " Std" ELSE ST$ = " " 55 IF MME THEN ECRI$ = LEFT$(MTT$(MME), 6) + " Tray:" + DPL$ + " " + LEFT$(B$(MSE), 6) + ST$ ELSE ECRI$ = LEFT$(B$(MSE), 6) + " Tray : " + DPL$ + ST$ 60 COLOR 5, 0: LOCATE 2, 50: PRINT ECRI$ + SPACE$(30 - LEN(ECRI$)): RETURN 100 READ A$ 105 IF LON = 0 THEN 110 106 IF A$ = "" THEN A$ = SPACE$(10) 107 N = INT(LEN(A$) / 2): RETURN 110 PRINT A$; : LON = 0: RETURN 120 COLOR 5, 0: LOCATE 1, 20, 0: PRINT SPACE$(40): LOCATE 2, 30: PRINT S㐞PACE$(20): COLOR 1, 2 121 GOSUB 602: COLOR 5, 0: CB = 5 122 FOR I = 1 TO 7: READ A$: CUR = 11 * (I - 1) + INT(.4 * I) 160 IF I > 1 THEN LOCATE 20, 2 + CUR ELSE LOCATE 20, 1 + CUR 162 A3$ = SPACE$(5 - LEN(A$) / 2) + A$: A$ = A3$ + SPACE$(10 - LEN(A3$)): PRINT A$ 164 LOCATE 21, CB: IF A$ <> SPACE$(10) THEN PRINT "F" + RIGHT$(STR$(I), 1) ELSE PRINT " " 165 CB = CB + 11 + CINT(I / 2 - INT(I / 2)): NEXT I 166 L(1) = 24: C(1) = 7: L(2) = 24: C(2) = 75: L(3) = 1: C(3) = 39: L(4) = 1: C(4) = 6: L(5) = 2: C(㐞5) = 40 170 FOR I = 8 TO 12: LON = 1: GOSUB 100: LOCATE L(I - 7), C(I - 7) - N: GOSUB 110: NEXT I 205 IF STATUS <> 8 OR PASSAG = 0 THEN A1$ = SPACE$(11): A2$ = SPACE$(11) ELSE A1$ = " Start ": A2$ = " F8 " 210 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 1: GOSUB 110: A$ = A2$: LOCATE 25, 1: GOSUB 110 220 IF (STATUS <> 9 AND PAR(17) = 0) THEN A1$ = SPACE$(11): A2$ = SPACE$(11) ELSE A1$ = " Abort ": A2$ = " S F9 " 225 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 70: GOSUB 110: A$ = A2$: LOCA㐞TE 25, 70: GOSUB 110 250 LOCATE 2, 2: PRINT DATEF$; : LOCATE 2, 50 280 GOSUB 50 300 COLOR 1, 2: LOCATE 3, 1: RETURN 591 DOV% = &H32: CUM% = &HF: CALL IO(DOV%, CUM%, DAT%, RET%): RETURN 592 GOSUB 740: DAT% = &HFF40: GOSUB 591: RETURN'out 593 GOSUB 750: DAT% = &HBF00: GOSUB 591: RETURN'in 600 CALL CLA(MA%, SUP%): RETURN 601 DEV% = &H32: CIM% = 5: RET% = 0: GOSUB 2095: RETURN 602 VIEW PRINT 3 TO 19: CLS : VIEW PRINT: IF DEJAP THEN GOSUB 1530: IF MESS$ <> "0" AND MESS$ <> " " AND MESS$ <> CHR$(0) AND M㐞ESS$ <> "" THEN EFFAC% = 1: GOSUB 1400: EFFAC% = 0 603 DEJAP = 1: RETURN 675 GOSUB 2450 678 ATTEN = 0: MEP = 0: IF PAS THEN PA$ = "rdcp" ELSE PA$ = "ltcp" 679 GOTO 35 740 COLOR 5, 0: LOCATE 25, 70: PRINT SPACE$(11); : LOCATE 24, 70: PRINT SPACE$(11): COLOR 1, 2 745 RETURN 750 IF ENVPARAM% = 1 THEN GOSUB 740: RETURN ELSE IF PAR(17) = 0 OR ABORT = 1 THEN COLOR 5, 0: LOCATE 24, 70: PRINT " Abort ": LOCATE 25, 70: PRINT " S F9 "; : COLOR 1, 2 752 'IF CHANGE=1 AND ATTEN=1 THEN GOSUB 2285 755 RE㐞TURN 855 GOSUB 885: SOUND 2000, 18: RETURN 865 IF NOSOUN% = 1 THEN RETURN ELSE GOSUB 885: FOR WTY = 1 TO 5: SOUND 2400, 5: FOR WBV = 1 TO 600 + (CINT(O2 / 16) - 1) * 75: NEXT WBV: NEXT WTY: RETURN 885 DAV% = 56: CIM% = 2: DAT% = 0: RET% = 0: CALL IO(DAV%, CIM%, DAT%, RET%): RETURN 887 IF PAR(17) = 0 THEN COLOR 1, 2: LOCATE 14, 4, 0: PRINT SPACE$(4) 888 RETURN 900 IF PAR(37) <> 1 THEN RETURN 901 'Q$ = "IND": GOSUB 1949: NBFO% = 0: FLAGSORT% = 0 905 'Q$ = "SECU": GOSUB 1949: IF ARRET THEN 951 910 'R$㐞 = MID$(R$, 6, 6) 912 'LOCATE 17, 1 914 'IF MID$(R$, 3, 2) = "00" AND MID$(R$, 6, 1) = "0" THEN 951 915 'COLOR 5, 0: PRINT " WARNING : "; 916 'IF MID$(R$, 3, 1) = "1" THEN PRINT " Full Waste-"; 920 'IF MID$(R$, 4, 1) = "1" THEN PRINT " Low Prefill-"; 925 'IF MID$(R$, 6, 1) = "1" THEN PRINT " Cover"; 930 'COLOR 1, 2: LOCATE 18, 1: PRINT "[Change if necessary and Press Enter When Ready] " 940 'NBFO% = NBFO% + 1 941 'IF NBFO% MOD 30 = 1 AND NBFO% < 300 THEN GOSUB 855 942 'IF NBFO% MOD 30 = 1 THEN G㐞OTO 912 943 'IF FLAGSORT% = 1 THEN 950 945 'GOTO 940 950 SOUND 1, 0 951 'Q$ = "OUD": GOSUB 1949 952 LOCATE 18, 1: PRINT SPACE$(80); : LOCATE 17, 1: PRINT SPACE$(78); 955 RETURN 960 FLAGSORT% = 1: RETURN 970 IF NOSOUN% = 2 THEN NOSOUN% = 1: L = 20: C(2) = 27: A$ = SPACE$(7): C(1) = 28: A3$ = " ": GOSUB 1527: RETURN ELSE RETURN 1000 R$ = "": CIM% = &HC: DAT% = 0: GOSUB 2095: CIM% = 2: DAT% = 0 1005 GOSUB 2095: CHAR = RET% 1010 IF CHAR = -1 THEN 1005 ELSE R$ = R$ + CHR$(CHAR) 1015 IF CHAR <> 10 T㐞HEN 1005 ELSE CIM% = &HC: DAT% = 1: GOSUB 2095: RETURN 1040 FOR ECH% = 1 TO 64: IF MID$(REP$, (ECH% * 2) - 1, 1) = "0" THEN 1060 1042 IF P64(ECH%) THEN PLACE(P64(ECH%)) = 0: P64(ECH%) = 255: GOTO 1070 ELSE P64(ECH%) = 255: PAR(34) = PAR(34) + 1: GOTO 1070 1045 IF PLACE(ECH%) = 0 THEN 1065 1050 IF MID$(REP$, (PLACE(ECH%) * 2) - 1, 1) = "1" THEN P64(PLACE(ECH%)) = 255: PLACE(ECH%) = 0: GOTO 1065 1060 IF P64(ECH%) THEN PLACE(P64(ECH%)) = 0: P64(ECH%) = 0 ELSE 1070 1065 PAR(34) = PAR(34) - 1 1070 DISPO =㐞  64 - PAR(34): NEXT ECH% 1072 IF DISPO = 0 THEN ARRET = 1 1075 RETURN 1080 'Q$ = "DST": GOSUB 1949: IF AJUMP THEN RETURN ELSE MESS$ = MID$(R$, 4, 1): IF MESS$ = "0" OR MESS$ = " " OR MESS$ = CHR$(0) THEN MESS = 0: GOTO 1081 ELSE IF MESS$ <> MESB$ THEN MESB$ = MESS$: NOSOUN% = 0: GOSUB 1400: MUSIC = 0'test dst 1081 RETURN 1100 V$ = RIGHT$(STR$(WV), LEN(STR$(WV)) - 1): RETURN 1130 PAR(17) = 0: PAR(24) = LIMIB + (LIMI1B * 256): IF PAR(40) <> 0 THEN PAR(40) = (PAR(22) AND 15360) / 1024 1135 LIMIB = 0: LI㐞MI1B = 0: PAR(50) = 0: PAR(51) = 0: VER = 64: RETURN 1140 IF NOSOUN% = 0 THEN MESB$ = "0" 1141 IF NOSOUN% = 2 THEN RESTORE 1536 ELSE RESTORE 1535 1142 LOCATE 7, 29: PRINT "Method Aborted": RETURN 1145 IF ABCAL THEN RETURN ELSE LOCATE 18, 40: PRINT "For a Complete Abort Press S F9"; : IF PAR(17) = 1 THEN PRINT " Again" ELSE PRINT " " 1147 RETURN 1150 'Q$ = "IND": GOSUB 1949: Q$ = LEFT$(V$, 3): QP$ = V$ + T1$ + CHR$(13) + CHR$(10): GOSUB 2055: Q$ = "@" + LEFT$(V$, 2): GOSUB 2100: Q$ = LEFT$(V$, 3): GOSU㐞B 2100 1155 'Q$ = "OUD": GOSUB 1949: RETURN 1175 IF PAR(17) <= 1 OR Z$ = SPACE$(23) THEN RETURN ELSE GOSUB 1180 1176 GOSUB 1180: FOR TY% = 1 TO 7: NEXT TY% 1177 RETURN 1180 FOR TY% = 1 TO 39: NEXT TY%: RETURN 1185 PAR(7 + METCO) = 0: IF PAR(16) = METCO THEN IF PAR(40 - METCO) THEN PAR(16) = 3 - METCO ELSE PAR(16) = 0 1186 RETURN 1190 COLOR 5, 0: ANAST = 1: GOSUB 2540: ANAST = 0: TE$ = MID$(R$, 15, 1): RETURN 1200 STATUS = 0: AIG1 = 0: GOSUB 1175: GOSUB 2207: CHANGE = 0: GOSUB 2280: ES% = 1: IF AIG2㐞 > 0 OR ABCAL <> 0 OR RBL <> 0 THEN 1220 1202 GOSUB 1205: GOSUB 1215: GOTO 1225 1205 FOR TY% = ES% TO 48: IF PLACE(TY%) <> 0 THEN PAR(54) = TY%: TY% = 48: GOTO 1210 1207 IF TY% = 48 THEN PAR(54) = 50 1210 NEXT TY%: RETURN 1215 BV% = (PAR(22) AND 15360) / 1024: RETURN 1220 GOSUB 1215: IF (((PLM(49) AND 2 ^ (BV% - 1)) <> 0 OR (PLM(49) <> 0 AND METP = 0)) AND LIMI = 1 AND ETP% <> 4) OR ABCAL <> 0 OR RBL <> 0 THEN PAR(54) = 1: GOTO 1225 1222 IF (((PLM(49) AND 2 ^ (BV% - 1)) <> 0 OR (PLM(49) <> 0 AND METP㐞 = 0)) AND LIMI = 1 AND ETP% = 4) AND AIG2 < 17 THEN ES% = 17: GOSUB 1205 ELSE IF (AIG3 AND 255) = 49 THEN PAR(54) = 51 ELSE PAR(54) = AIG2 1225 'IF K1(6)=3 OR K1(6)=12 OR CALF<>0 THEN 1240 1227 'IF ((PLM(49) AND 2^(BV%-1))<>0 OR (METP=0 AND PLM(49)<>0)) AND LIMI=1 AND ETP%=4 AND ABAND=0 THEN ATTEN=0:GOSUB 740:LOCATE 18,40:PRINT SPACE$(40) ELSE 1240 1230 'IF ATTEN=0 THEN FOR WTY=1 TO 700:NEXT WTY:GOTO 1230 1235 'IF PAR(37)>1 THEN GOSUB 1145:GOSUB 750 1240 RETURN 'ENTET%=0:GOSUB 2245:GOSUB 2019:NONL$="㐞":RETURN 1250 GOSUB 1270: AIGUILLAGE = 4: RETURN 1255 'ATTEN=1: GOSUB 1480:RETURN 1260 'ATTEN=1:GOSUB 4010: GOSUB 1480:'GOSUB 6117:RETURN 1270 COLOR 1, 2: LOCATE 25, 24: PRINT SPACE$(10); "ABORT REQUESTED"; SPACE$(10); : LOCATE 19, 1: RETURN 1280 IF PAR(17) = 2 THEN DEJARET = 0: GOSUB 1948 1285 RETURN 1290 PTREM = PAR(23) AND 15: UNE = 1: GOSUB 2415: GET #1, 49: PLM(49) = CVI(F4$): CLOSE #1: RETURN 1380 FLG = 0 ': Q$ = "DMA": GOSUB 1946 1382 'IF (MID$(R$, 4, 1) = "1") THEN FLG = 1 1384 'GOSUB 108㐞0 1386 'IF ERE% > 18 THEN ARRET = 1: RETURN 1387 'IF FLG THEN 2728 ELSE FOR WTY = 0 TO 3000: NEXT WTY: GOTO 1380 1400 'COLOR 1, 2: IF LEN(MESS$) = 0 THEN MESS = VAL(MESS$): GOTO 1420 ELSE MESS = ASC(MESS$): IF MESS > 57 THEN MESS = MESS - 7 1405 'ERE% = MESS - 33: IF ERE% > 30 THEN GOSUB 1430 ELSE IF ERE% > 18 THEN GOSUB 1460 1410 'GOSUB 2206: IF Z$ = SPACE$(23) THEN 1420 ELSE IF ERE% = 29 THEN 1411 ELSE LOCATE 25, 38: PRINT Z$; SPACE$(2); : IF ERE% < 19 THEN LOCATE 25, 25: PRINT " WARNING : "; ELSE㐞 LOCATE 25, 25: PRINT " ERROR : "; 1411 'IF EFFAC% THEN RETURN 1412 'IF FRE(0) < 2500 THEN WFREE = FRE("") 1413 'IF ERE% <> 0 AND NOSOUN% = 0 THEN NOSOUN% = 2: A$ = "Acknow": L = 20: C(2) = 27: A3$ = "F3": C(1) = 28: GOSUB 1527 1414 'IF ERE% < 19 THEN GOSUB 855 ELSE GOSUB 865 1420 RETURN 1430 PAR(17) = 4: ERREUR% = 1: DEJARET = 1: PAR(56) = ERE%: IF FLECH THEN RETURN ELSE GOSUB 887: FLECH = 1: RETURN 1460 PAR(17) = 2: ERREUR% = 1: DEJARET = 1: PAR(55) = PAR(55) OR 2 ^ (ERE% - 19): IF PAR(54) = 0 㐞THEN PAR(54) = VAL(MID$(R$, 17, 2)) 1465 IF FLECH THEN RETURN ELSE GOSUB 887: FLECH = 1: RETURN 1527 COLOR 5, 0: LOCATE L + 1, C(1): PRINT A3$: LOCATE L, C(2): PRINT A$: COLOR 1, 2: RETURN 1530 LOCATE 25, 16: PRINT (64 - PAR(34)); SPACE$(2); : LOCATE 24, 13: PRINT "Free cuvet.": RETURN 1535 DATA ,,,,,,,,,< CPA >,, 1536 DATA ,,Acknow,,,,,,,< CPA >,, 1541 Y$ = " SET UP AND START ": RETURN 1542 Y$ = " SAMPLE PROGRAMMING AND REPORTING ": RETURN 1543 Y$ = " INSTRUMENT PROTOCOL AND QC ": RETURN 1544 Y㐞 $ = " CREATION AND METHOD REVISION ": RETURN 1545 Y$ = " PATIENT FILE REVIEW ": RETURN 1546 Y$ = " MATH FUNCTIONS ": RETURN 1547 Y$ = " MAINTENANCE ": RETURN 1700 ON CVB + 1 GOSUB 1541, 1542, 1543, 1544, 1545, 1546, 1547 1701 PRINT Y$: RETURN 1935 TB = 1: IF PAR(37) <> 0 AND PAR(17) = 0 THEN AIGUILLAGE = 3: PAR(17) = 1 ELSE 1945 1940 GOSUB 887: GOSUB 1270: IF FLECH = 0 THEN GOSUB 887: FLECH = 1 1945 RETURN 1946 'QP$ = Q$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 1000: RETURN 1948 IF DEJARET THE㐞N RETURN ' ELSE Q$ = "STO": PAR(34) = 64 1949 'QP$ = Q$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 2100: RETURN 2055 'I = 1 2056 'IF Q$ = "SECU" THEN Q$ = "@SE" 2065 'CIM% = &H10: GOSUB 2095: IF RET% = 0 THEN 2065 ELSE CHAR = ASC(MID$(QP$, I, 1)): CIM% = 1: DAT% = CHAR 2075 'GOSUB 2095: I = I + 1: IF CHAR <> 10 THEN 2065 ELSE RETURN 2095 RETURN 'CALL IO(DEV%, CIM%, DAT%, RET%): RETURN 2100 'R$ = "": INU = 0: BUFFER = 0: CIM% = &HC: DAT% = 0: GOSUB 2095 2110 'CIM% = 2: DAT% = 0 2115 'GOSUB 2095: CHAR 㐞= RET% 2125 'IF CHAR = -1 THEN INU = INU + 1 ELSE R$ = R$ + CHR$(CHAR): GOTO 2135 2130 'IF INU = 6000 AND REPET THEN ARRET = 1: RETURN ELSE IF INU = 6000 THEN REPET = 1: GOTO 2152 ELSE 2115 2135 'IF CHAR <> 10 THEN 2115 2140 'GOSUB 2095: IF RET% = -1 AND BUFFER <> 0 THEN R$ = "ERR" ELSE IF RET% <> -1 AND (Q$ <> "@PI") THEN BUFFER = 1: INU = 5900: GOTO 2115 2150 'IF Q$ <> LEFT$(R$, 3) AND REPET THEN ARRET = 1: AJUMP = 1: GOTO 2155 ELSE IF Q$ <> LEFT$(R$, 3) THEN REPET = 1: FOR WYU = 1 TO 3000: NEXT WYU 㐞ELSE 2155 2152 'IF Q$ <> "PIP" AND Q$ <> "@PI" THEN GOSUB 2055: GOTO 2100 2155 RETURN 'CIM% = &HC: DAT% = 1: GOSUB 2095: RETURN 2158 GOSUB 2194: LSET P1$ = MKI$(PAR(X)): PUT #1, X: CLOSE #1: RETURN 2162 OPEN "r", #1, "nameth", 105: FIELD #1, 6 AS T$, 6 AS DA$, 32 AS ST$, 32 AS TI$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$: RETURN 2193 OPEN "r", #1, "temper", 4: FIELD #1, 4 AS T1$: RETURN 2194 OPEN "R", #1, "pargen", 2: FIELD #1, 2 AS P1$: RETURN 2198 OPEN "r", #1, "method㐞", 4: FIELD #1, 4 AS A2$: RETURN 2199 OPEN "r", #1, "cyclec", 96: FIELD #1, 96 AS FF$: RETURN 2200 OPEN "r", #1, "plac", 96: FIELD #1, 96 AS FF$: RETURN 2205 OPEN "r", #1, "erreur", 23: FIELD #1, 23 AS E$: RETURN 2206 GOSUB 2205: GET #1, ERE%: Z$ = E$: CLOSE #1: RETURN 2207 IF ERE% > 18 THEN GOSUB 2205: LSET E$ = MKI$(ERE%) + SPACE$(21): PUT #1, 1: CLOSE #1: RETURN ELSE RETURN 2210 GOSUB 2198 2225 FOR K% = 1 TO 100: GET #1, (METI - 1) * 100 + K%: K1(K%) = CVS(A2$): NEXT K% 2240 CLOSE #1: RETURN 228㐞0 GOSUB 2193: LSET T1$ = MKS$(CHANGE): PUT #1, 21: CLOSE #1: RETURN 2290 OPEN "r", #1, FIL$, 14: FIELD #1, 2 AS F1$, 2 AS F2$, 2 AS F3$, 2 AS F4$, 2 AS F5$, 2 AS F6$, 2 AS F7$: RETURN 2415 RESTORE 2440: FOR TY% = 1 TO PTREM: READ FIL$: NEXT TY% 2420 GOSUB 2290 2425 RETURN 2430 FOR IND = 1 TO 50: GET #1, IND: PL(IND) = CVI(F1$): PLP(IND) = CVI(F2$): PLM(IND) = CVI(F4$): PLPM(IND) = CVI(F5$) 2432 NEXT IND: CLOSE #1: RETURN 2435 GOSUB 2200 2436 GET #1, UNE: FOR IND = 1 TO 48: PLACE(IND) = CVI(MID$(FF$,㐞 (IND * 2) - 1, 2)): NEXT IND 2437 CLOSE #1: RETURN 2440 DATA tray11,tray12,tray13,tray14,tray21,tray22,tray23,tray24 2450 GOSUB 2194 2460 FOR IND = 1 TO 60: LSET P1$ = MKI$(PAR(IND)): PUT #1, IND 2475 NEXT IND: CLOSE #1: RETURN 2480 IF (K1(30) = 0 OR (K1(30) < K1(28)) OR (K1(29) <> 0 AND K1(30) < K1(29))) AND (K1(6) = 1 OR ((K1(6) = 5 OR K1(6) = 6 OR K1(6) = 10) AND K1(5) = 1)) THEN BLACOR = 1 2482 RETURN 2540 GOSUB 1080: IF AJUMP THEN AJUMP = 0: GOTO 2560 2541 IF MESS = 0 AND ANAST <> 0 THEN 2550㐞 ELSE IF MESS$ <> MESB$ AND PAR(17) = 0 THEN COLOR 1, 2: LOCATE 25, 25: PRINT SPACE$(30); : LOCATE 19, 1: MESB$ = MESS$ 2542 IF PAR(37) = 4 THEN 2550 2543 IF VAR <> 0 OR ATTEN = 1 THEN 2545 2544 IF PASUI OR ANAST THEN 2550 2545 IF MID$(R$, 6, 1) = "1" THEN ADTER = 1 2550 WTEMPER = VAL(MID$(R$, 8, 4)): IF WTEMPER < 1 THEN 2557 2556 TEMPER$ = MID$(STR$(WTEMPER), 2, 4) 2557 IF ANAST THEN 2559 2558 AFTEM = AFTEM + 1: GOSUB 592: IF AFTEM = 1 AND ADTER = 0 AND METI THEN GOSUB 2193: LSET T1$ = TEMPER$: PUT㐞 #1, (PAR(19 + (3 * PAR(37))) AND 31): CLOSE #1 2559 COLOR 1, 2: IF WTEMPER > 1 THEN LOCATE 23, 64: PRINT USING "##.#"; WTEMPER 2560 GOSUB 593: RETURN 2590 FOR K% = 1 TO 16: IF PLP(K%) <> ECH% THEN 2595 2591 IF (PLPM(K%) AND 2 ^ (DEMET - 1)) THEN 2615 2595 NEXT K% 2600 P64(MESURES) = ECH%: PLACE(ECH%) = MESURES 2601 LIMI1 = ECH% + 1: DISPO = DISPO - 1: PAR(34) = PAR(34) + 1 2602 MESURES = MESURES + 1: IF (MESURES > 64) OR (DISPO = 0) THEN RETURN 2603 IF P64(MESURES) THEN 2602 ELSE RETURN 2610 FOR 㐞 K% = 1 TO 16: IF PLP(K%) = ECH% THEN 2615 2611 NEXT K% 2615 P64(MESURES) = K%: PLACE(K%) = MESURES: PLACE(ECH%) = MESURES: GOSUB 2601: RETURN 2677 ATTEN = 0: IF MEP = PAR(8) THEN POINTE = 1 ELSE POINTE = 2 2678 METP = MEP: DEMET = PAR(40): GOSUB 2685: METI = VAL(MID$(TIT$, (DEMET * 3) - 1, 2)): PAR(37) = 1: VER = 0: PAR(22) = METI + (32 * METP) + (1024 * DEMET) 2679 PTE = PAR(11 + POINTE) + (4 * (POINTE - 1)): PAR(23) = PTE + ((PAR(41 + PTE) AND 511) * 16): PAR(24) = 1: PAR(40) = PAR(40) + 1 2682 RETU㐞RN 2684 'anast 2685 CLOSE #1: GOSUB 2162 2687 GET #1, METP: TIT$ = ST$: CLOSE #1: RETURN 2689 QP$ = Q$: TOTAL = 0 2690 IF PRED = 0 THEN 2713 2691 FOR ECH% = 1 TO 16: IF PLP(ECH%) = 0 THEN 2709 2693 IF PLP(ECH%) < LIMI THEN 2709 2694 IF PLP(ECH%) >= LIMI1 THEN 2709 2695 IF METP < 21 THEN 2699 2696 IF (PLPM(ECH%) AND 2 ^ (DEMET - 1)) = 0 THEN 2709 2699 WV = PLP(ECH%): GOSUB 1100 2705 QP$ = QP$ + V$ + ",": TOTAL = TOTAL + 1: GOTO 2711 2709 QP$ = QP$ + "0," 2711 NEXT ECH% 2713 IF TOTAL THEN ENVOI㐞% = 1 ELSE ENVOI% = 2 2715 RETURN 2717 IF K1(58) THEN ENVOI% = 1 ELSE ENVOI% = 2 2719 WV = INT(K1(58) * 9.448 * 2): GOSUB 1100 2723 QP$ = Q$ + V$ 2725 RETURN 2727 IF CHFL = 0 THEN ENVOI% = 2: RETURN ELSE 1380 2728 'Q$ = "MAT": GOSUB 1946: REP$ = RIGHT$(R$, LEN(R$) - 3) 2729 'IF LEN(REP$) > 2 THEN PBFL = 1: GOSUB 1040: IF PAR(34) > 8 THEN ARRET = 1: PAR(17) = 1: X = 34: GOSUB 2158: GOSUB 3995: X = 35 2730 RETURN 2731 GOSUB 2743: IF ALLOU THEN RETURN 2732 P64(MESURES) = K1(K%): PLACE(K1(K%)) = MESU㐞RES 2733 MESURES = MESURES + 1: IF MESURES = 65 THEN 2735 2734 IF P64(MESURES) THEN 2733 2735 DISPO = DISPO - 1: PAR(34) = PAR(34) + 1: RETURN 2736 FOR ECH% = 1 TO 16: IF ECH% < LIMI THEN 2741 2737 IF ((PL(ECH%) = 255) OR (PL(ECH%) = 254) OR (PL(ECH%) = 0)) THEN 2741 2738 IF METP = 0 THEN 2740 2739 IF (PLM(ECH%) AND 2 ^ (DEMET - 1)) = 0 THEN 2741 2740 GOSUB 2600 2741 NEXT ECH%: RETURN 2743 ALLOU = 0 2745 FOR IND = 64 TO K% - 1: IF K1(IND) = K1(K%) THEN ALLOU = IND: GOTO 2750 2749 NEXT IND 2750 㐞RETURN 2755 K% = 64: GOSUB 2731: RETURN 2761 IF PAR(37) <> 0 THEN PTREM = PAR(20 + (3 * PAR(37))) AND 15: GOTO 2763 ELSE IF MEP = PAR(8) THEN POINTE = 1 ELSE POINTE = 2 2762 PTREM = PAR(11 + POINTE) + (4 * (POINTE - 1)) 2763 GOSUB 2415: GOSUB 2430: RETURN 2771 CHFL = 0: PBFL = 0 2772 IF ARRET AND X = 36 THEN 2774 2773 LIMI1B = 0: LIMIB = 0 2774 RETURN 2777 DATA DEP,TCY,BAS,MOE,PRM,CYC,SAV,TEC,LON,DIP,R1P,R2P,PRV,R1T,R2T,PRP,PRE 2779 DATA IN1,NB1,LE1,IN2,NB2,LE2,IN3,NB3,LE3,VDI,VR1,VR2,PRS,WAI,DIAD㐞,TOP,MAT 2791 ON ENVOI% GOTO 2793, 2799 2793 QP$ = QP$ + CHR$(13) + CHR$(10): XBA = X 2795 GOSUB 2055: GOSUB 2100 2797 GOSUB 2540: IF ERE% > 18 THEN ARRET = 1: X = 34 ELSE X = XBA 2799 RETURN 2801 K1(90) = 1 2803 QP$ = Q$: RETURN 2804 'IF PBFL THEN 2812 ELSE IF PAR(34) <> 0 THEN 2805 ELSE LIMIB = LIMI: LIMI1B = LIMI1: DISPO = 64: Q$ = "DEP": QP$ = Q$ + "1": CHFL = 1: RETURN 2805 DISPO = 64 - PAR(34): IF PAR(37) > 1 THEN 2807 2806 IF DEMET < 2 THEN 2809 2807 'Q$ = "MDP": QP$ = Q$: RETURN 2809 IF 㐞LIMI <> 1 THEN 2812 2811 QP$ = Q$: RETURN 2812 'Q$ = "DEP": QP$ = Q$ + "0": RETURN 2813 IF K1(63) = 2 THEN ENVOI% = 2: GOTO 2817 2815 QP$ = Q$ + "1" 2817 RETURN 2818 MESURES = 0: IF PBFL THEN LIMI = LIMIB: LIMI1 = LIMI1B: CHFL = 0: PBFL = 0 2819 FOR ES% = 1 TO 64: IF P64(ES%) THEN MESURES = ES% ELSE 2823 2821 NEXT ES%: ARRET = 1: PAR(17) = 1: PAR(34) = 64: X = 34: GOSUB 2158: X = 35: RETURN 2823 MESURES = MESURES + 1: QP$ = Q$: CALIB = 0 2824 IF (PLM(49) AND 2 ^ (DEMET - 1)) <> 0 OR (METP = 0 AND 㐞PLM(49) <> 0) THEN CALIB = 1 2827 IF (K1(6) = 5 OR K1(6) = 6 OR K1(6) = 10) AND PRED <> 0 THEN 2834 2828 IF LIMI1 <= 1 AND CALIB <> 0 AND K1(64) <> 1 THEN K164 = K1(64): K1(64) = 1: GOSUB 2755: K1(64) = K164: GOSUB 2755: GOTO 2830 2829 IF LIMI1 <= 1 THEN K1(64) = 1: GOSUB 2755 ELSE 2832 2830 IF K1(6) = 4 THEN K1(65) = 2: K% = 65: GOSUB 2731 2831 IF CALIB = 1 THEN GOSUB 2890 2832 LIMI1 = 17 2834 IF ((MESURES > 64) OR (DISPO = 0)) THEN 2859 2835 IF LIMI1 <= 17 THEN GOSUB 2736 2836 IF ((MESURES > 64) 㐞OR (DISPO = 0)) THEN 2859 2839 FOR ECH% = 17 TO 48: IF ECH% < LIMI THEN 2857 2841 IF PL(ECH%) = 0 THEN 2857 2842 IF METP < 21 THEN 2854 2843 IF (PLM(ECH%) AND 2 ^ (DEMET - 1)) = 0 THEN 2857 2844 IF (PLPM(ECH%) AND 2 ^ (DEMET - 1)) THEN GOSUB 2590: GOTO 2856 ELSE GOSUB 2600: GOTO 2856 2854 IF PLP(ECH%) THEN GOSUB 2610 ELSE GOSUB 2600 2856 IF (MESURES > 64) OR (DISPO = 0) THEN 2859 2857 NEXT ECH% 2859 FOR ECH% = 1 TO 48: IF PLACE(ECH%) = 0 THEN 2868 ELSE IF ECH% >= LIMI THEN 2863 2860 IF (PLP(ECH%) 㐞 < LIMI) OR (PLP(ECH%) >= LIMI1) THEN 2868 2861 IF METP > 20 THEN 2862 ELSE 2869 2862 IF (PLPM(ECH%) AND 2 ^ (DEMET - 1)) THEN 2869 ELSE 2868 2863 IF ECH% >= LIMI1 THEN 2875 2864 IF (PRED = 0) OR (ECH% < 17) THEN 2869 2865 IF METP > 20 THEN 2867 2866 IF PLP(ECH%) THEN 2868 ELSE 2869 2867 IF (PLPM(ECH%) AND 2 ^ (DEMET - 1)) THEN 2868 ELSE 2869 2868 QP$ = QP$ + "0,": GOTO 2873 2869 WV = PLACE(ECH%): GOSUB 1100: P$ = V$ 2871 QP$ = QP$ + P$ + "," 2873 NEXT ECH% 2875 IF LIMI1 = 49 THEN 2885 2877 FOR 㐞IND = LIMI1 TO 48: IF METP = 0 THEN IF PL(IND) THEN 2885 2879 IF (PLM(IND) AND 2 ^ (DEMET - 1)) THEN 2885 2881 NEXT IND 2883 LIMI1 = 49 2885 PAR(21 + (3 * PAR(37))) = PAR(21 + (3 * PAR(37))) OR (LIMI1 * 256): RETURN 2887 FOR TY% = 1 TO 16: QP$ = QP$ + "0,": NEXT TY%: RETURN 2890 FOR K% = 65 TO 77: IF K1(K%) THEN GOSUB 2731 2891 IF COEF THEN RETURN 2892 NEXT K%: RETURN 2893 IF K1(24) = 0 THEN CYCLE$ = "1": GOTO 2897 2895 IF K1(25) = 0 THEN CYCLE$ = "2" ELSE CYCLE$ = "3" 2897 QP$ = Q$ + CYCLE$ 289㐞9 RETURN 2901 WV = INT(K1(22) * 9.448 * 2): GOTO 2933 2903 WV = K1(20): TEMPOK = 30 + (7 * (K1(20) - 1)): GOTO 2933 2905 WV = K1(21): GOTO 2933 2907 WV = (K1(59) AND 15): PDIL = WV 2909 PARA = K1(23): GOTO 2931 2911 WV = (K1(60) AND 240) / 16: PRF1 = WV 2913 PARA = K1(24): GOTO 2931 2915 WV = K1(60) AND 15: PRF2 = WV 2917 PARA = K1(25): GOTO 2931 2919 WV = INT(K1(27) * .9448 * 2): PARA = K1(27): GOTO 2931 2921 PARA = K1(28): WV = K1(28) / 15: GOTO 2931 2923 PARA = K1(29): WV = K1(29) / 15: GOTO 㐞2931 2925 WV = INT(K1(4) * .9448 * 2): PARA = K1(4): GOTO 2931 2927 WV = (K1(59) AND 240) / 16 2929 PARA = K1(4): GOTO 2931 2931 IF PARA = 0 THEN ENVOI% = 2: GOTO 2935 2933 GOSUB 1100: QP$ = Q$ + V$ 2935 RETURN 2937 PARA = NB1: WV = IN1: GOTO 2931 2938 PARA = IN1: WV = NB1: GOTO 2931 2939 PARA = NB1: WV = NB1: GOTO 2931 2940 PARA = LE1: WV = IN1: GOTO 2931 2941 PARA = NB2: WV = IN2: GOTO 2931 2943 PARA = NB2: WV = NB2: GOTO 2931 2945 PARA = NB3: WV = IN3: GOTO 2931 2947 PARA = NB3: WV = NB3: G㐞OTO 2931 2949 WV = INT(K1(23) * .9448 * 2): PARA = PDIL: GOTO 2931 2951 WV = INT(K1(24) * .9448 * 2): PARA = PRF1: GOTO 2931 2953 WV = INT(K1(25) * .9448 * 2): PARA = PRF2: GOTO 2931 2955 PARA = K1(51): WV = K1(51): GOTO 2931 2959 QP$ = Q$ 2961 RETURN 2963 PARA = PL1: WV = PL1: GOTO 2931 2965 PARA = PL2: WV = PL2: GOTO 2931 2967 PARA = PL3: WV = PL3: GOTO 2931 2969 ENVOI% = 2: RETURN 2973 QP$ = Q$ + STR$(K1(20)) 2975 RETURN 2981 IF K1(48) = 0 THEN INC2 = K1(45): NB2 = K1(44) - 1: NB3 = 0: GOTO 㐞3007 2983 INC2 = K1(48): NB2 = K1(44) - 1 2987 NB3 = ((K1(44) - 1) * (K1(45) - K1(48))) / K1(45) 2993 NBL = 1: TEST = K1(45): CAL = K1(48) * (K1(44) - 1) 2995 IF TEST >= CAL THEN 3003 2997 TEST = TEST + K1(45): NBL = NBL + 1 2999 GOTO 2995 3003 IF TEST > CAL THEN PL2 = (K1(30) + 6 + TEST) / 12'FL2=1 3007 NBL = 48 - NB2 - NB3 3011 TEX = K1(30) + 6 3013 'IF TEX>NBL*12 THEN 3013 3015 IF TEX = NBL * 12 THEN 3023 3017 NBL = NBL - 1 3019 IF TEX < NBL * 12 THEN 3017 3023 NB1 = NBL 3027 PL1 = NB1 30㐞29 GOTO 2937 3030 ENVPARAM% = 1:GOSUB 593: GOSUB 750: GOSUB 900: GOSUB 3250: IF PAR(57) THEN PAR(57) = 0: X = 57: GOSUB 2158 3031 IF (PAR(24) AND 255) = 1 AND PAR(37) = 1 AND PAR(40) > 2 AND ((PAR(22) AND 992) / 32) > 20 THEN MEMO = 1 3033 GOSUB 592: ANAST = 1: NOEUD = 0: BUT = 15: LOCATE 25, 24, 0: PRINT SPACE$(8); "Method Initialization"; : LOCATE 19, 1 3034 FOR ECH% = 1 TO 48: PLACE(ECH%) = 0: LE(ECH%) = 0: NEXT ECH% 3035 IF PAR(37) = 0 AND ATTEN <> 0 THEN GOSUB 2677: GOSUB 1290: GOTO 3041 ELSE IF V㐞ER = 16 THEN GOSUB 3219: GOTO 3041 3037 METI = PAR(19 + (3 * PAR(37))) AND 31: METP = (PAR(19 + (3 * PAR(37))) AND 992) / 32 3039 DEMET = (PAR(19 + (3 * PAR(37))) AND 15360) / 1024 3041 LIMI = PAR(21 + (3 * PAR(37))) AND 255: LIMI1 = LIMI 3043 GOSUB 2210: IF MEMO THEN GOSUB 3995: MEMO = 0 3045 IF (K1(6) = 1 OR ((K1(6) = 5 OR K1(6) = 6 OR K1(6) = 10) AND K1(5) = 1)) AND K1(30) = 0 THEN BLACOR = 1: K1(30) = 8 3046 GOSUB 3300 3049 IF (K1(6) = 1 OR K1(6) = 2 OR K1(6) = 5 OR K1(6) = 6 OR K1(6) = 10) AND K㐞1(33) <> 0 THEN K1(1) = 1 3053 GOSUB 2761: GOSUB 2480 3054 IF DEJARET THEN 3065 ELSE GOSUB 592 3055 X = 1: ARRET = 0: RESTORE 2777: ENVOI% = 1: DEV% = 52 3059 READ Q$ 3061 ON X GOSUB 2804, 2801, 2813, 2818, 2689, 2893, 2901, 2903, 2905, 2907, 2911, 2915, 2919, 2921, 2923, 2927, 2925, 3083, 2939, 2963, 2941, 2943, 2965, 2945, 2947, 2967, 2949, 2951, 2953, 2717, 2955, 2969, 2959, 2727 3062 IF ARRET THEN 3065 ELSE IF X = 34 THEN IF PBFL THEN 3055 ELSE 3065 3063 IF DIALOGUE THEN GOSUB 1940: ARRET = 1: X 㐞 = 34: DIALOGUE = 0 ELSE IF PAR(17) = 0 THEN GOSUB 2791'envoi sur i/o 3065 REPET = 0: ENVOI% = 1: X = X + 1: IF X >= 35 THEN GOSUB 2771 ELSE 3059 3066 GOSUB 3290: IF ARRET THEN PAR(17) = 1: GOSUB 1948: DEJARET = 1: IF ARRET AND X = 36 THEN GOSUB 1130: GOTO 675 3067 IF ARRET = 0 THEN LOCATE 25, 25: PRINT SPACE$(36); : ENVPARAM% = 0: GOSUB 750 3068 GOSUB 592: GOSUB 3235: COLOR 1, 2: GOSUB 1530: LOCATE 19, 1: AFTEM = 0: BLACOR = 0: MESB$ = "": GOSUB 593 3069 IF PAR(37) = 1 AND PAR(17) = 1 THEN V$ = "PIPE":㐞 T1$ = ":H,0": GOSUB 1150: GOSUB 1200: PAR(54) = 1: PAS = 32: GOTO 675 ELSE 4980 3071 NBL = NBL - 1: RETURN 3073 INC = INC + 15: RETURN 3074 PL1 = K1(30): IN1 = K1(85): NB1 = K1(84) - 1: LE(1) = 1: LE(K1(84)) = K1(84): GOTO 2937 3083 IN1 = 0: NB1 = 0: IN2 = 0: NB2 = 0: IN3 = 0: NB3 = 0: IF K1(6) = 3 OR K1(6) = 12 OR K1(6) = 7 THEN 3175 3091 TOTAL = K1(31) - K1(30) 'substrats,emits,spline,qualitatif 3093 INC = 15: NBL = 46 3095 IF NBL * INC > TOTAL THEN GOSUB 3071: GOTO 3095 3097 IF NBL * INC < TO㐞TAL THEN GOSUB 3073: GOTO 3095 3099 IF K1(30) <= 8 THEN IN1 = INC: NB1 = NBL: LE(1) = 1: LE(2) = NB1 + 1: GOTO 2937 3101 IN1 = K1(30) - 8: NB1 = 1: LE(1) = 2: IN2 = INC: NB2 = NBL: LE(2) = NB2 + 2: GOTO 2937 3175 FOR IK = 1 TO 48: PZ(IK) = 0: NEXT IK'enzymes,hemostase 3176 IF K1(63) = 2 THEN TEMPORIG = 8: PERIODMIN = 15 ELSE TEMPORIG = 3: PERIODMIN = 1 3177 PZ(1) = TEMPORIG: LZ1 = 0 3178 IF K1(6) = 7 THEN NBLECT = K1(84): WTPERIOD = K1(85) ELSE NBLECT = K1(44): WTPERIOD = K1(45): IF K1(48) = 0 THEN 31㐞85 3181 IF K1(28) THEN LZ1 = K1(28) 3182 IF K1(29) THEN LZ1 = K1(29) 3183 LZ1 = LZ1 + TEMPORIG: IF PZ(1) = LZ1 THEN IKB = 1 ELSE PZ(2) = LZ1: IKB = 2: IF K1(6) = 7 THEN 3185 3184 FOR IN = IKB + 1 TO NBLECT + IKB - 1: PZ(IN) = PZ(IN - 1) + K1(48): NEXT IN 3185 FOR IN = 0 TO NBLECT - 1: LZB = K1(30) + (IN * WTPERIOD): IK = 1 3186 IF (PZ(IK) = 0) OR (LZB < PZ(IK)) THEN GOSUB 3205 3187 IF LZB > PZ(IK) THEN IK = IK + 1: GOTO 3186 3188 NEXT IN: ACT = 1 3189 FOR IN = 0 TO NBLECT - 1: IF K1(6) <> 7 THEN 31㐞90 ELSE IF ACT = 1 THEN LZB = K1(30) + (IN * WTPERIOD) ELSE LZB = LZ1 + IN 3190 IF ACT = 1 THEN LZB = K1(30) + (IN * WTPERIOD) ELSE LZB = LZ1 + (IN * K1(48)) 3191 IK = 1 3192 IF LZB = PZ(IK) THEN LE(ACT + IN) = IK ELSE IK = IK + 1: GOTO 3192 3193 NEXT IN: IF ACT = 24 THEN 3195 3194 IF K1(6) <> 7 AND K1(48) <> 0 THEN ACT = 24: GOTO 3189 3195 IK = 1 'QP$ = "CLE": Q$ = "CLE": IK = 1 3196 'WHILE PZ(IK) <> 0 3197 'UL = ((PZ(IK) - TEMPORIG) / PERIODMIN) + 1: QP$ = QP$ + RIGHT$(STR$(UL), LEN(STR$(UL)) - 1)㐞 + ",": IK = IK + 1 3198 RETURN 'WEND: ENVOI% = 1: RETURN 3205 FOR IJ = 48 TO IK + 1 STEP -1: PZ(IJ) = PZ(IJ - 1): NEXT IJ: PZ(IK) = LZB: RETURN 3219 METP = (PAR(19 + (3 * PAR(37))) AND 992) / 32: IF PAR(37) = 0 THEN METP = (PAR(22) AND 992) / 32 3220 IF METP = 0 THEN METP = MEP 3221 DEMET = PAR(40): GOSUB 2685 3223 METI = VAL(MID$(TIT$, (DEMET * 3) - 1, 2)) 3225 PAR(37) = PAR(37) + 1: VER = 0 3227 PAR(19 + (3 * PAR(37))) = METI + (32 * METP) + (1024 * DEMET) 3229 PAR(20 + (3 * PAR(37))) = PAR(17 +㐞 (3 * PAR(37))) AND ((2 ^ 13) - 1) 3231 PAR(21 + (3 * PAR(37))) = 1: PAR(40) = PAR(40) + 1 3233 RETURN 3235 GOSUB 2199: D$ = SPACE$(96) 3239 FOR LEC = 1 TO 48: MID$(D$, (LEC * 2) - 1, 2) = MKI$(LE(LEC)): NEXT LEC 3240 LSET FF$ = D$: PUT #1, PAR(37): CLOSE #1 3241 PAR(21 + (3 * PAR(37))) = LIMI + (256 * LIMI1): IF LIMI1 <> 49 THEN 3246 3242 IF METP = 0 THEN 3245 ELSE IF PAR(40) THEN GOSUB 2162: GET #1, METP: NMLI$ = ST$: CLOSE #1 ELSE 3245 3243 IF VAL(MID$(NMLI$, (PAR(40) * 3) - 1, 2)) = 0 THEN 3245 㐞 3244 IF (PLM(50) AND 2 ^ (PAR(40) - 1)) <> 0 THEN PAR(40) = PAR(40) + 1: GOTO 3243 ELSE 3246 3245 PAR(19 + (3 * PAR(37))) = PAR(19 + (3 * PAR(37))) OR 16384: PAR(40) = 0 3246 GOSUB 2450: GOSUB 2200 3247 FOR IND = 1 TO 48: MID$(D$, (IND * 2) - 1, 2) = MKI$(PLACE(IND)): NEXT IND 3249 LSET FF$ = D$: PUT #1, PAR(37): CLOSE #1: RETURN 3250 IF BUT = 0 THEN METP = (PAR(19 + (3 * PAR(37))) AND 992) / 32: GOSUB 2761 3252 RETURN 3290 IF ARRET AND X = 35 THEN GOSUB 1175 3295 RETURN 3300 IF K1(58) THEN PRED =㐞 1 ELSE PRED = 0 3305 RETURN 3965 GOSUB 1940 3970 DIALOGUE = 1: ERREUR% = 1: RETURN 3995 PAR(50) = K1(20): PAR(51) = K1(21): GOSUB 4000: RETURN 4000 X = 50: GOSUB 2158: X = 51: GOSUB 2158: RETURN 4980 METI = PAR(22) AND 31 4983 GOSUB 2198 4984 GET #1, (METI - 1) * 100 + 6: K1(6) = CVS(A2$): CLOSE #1 4985 ON K1(6) GOTO 4987, 4987, 4988, 4990, 4989, 4989, 4991, 5000, 4992, 4990, 4992, 4988 4987 PA$ = "calc1cp": GOTO 35 4988 PA$ = "calc2cp": GOTO 35 4989 PA$ = "calc3cp": GOTO 35 4990 PA$ = "calc4c㐞 p": GOTO 35 4991 PA$ = "calc6cp": GOTO 35 4992 PA$ = "calc5cp": GOTO 35 5000 END 8240 COLOR 5, 0: VIEW PRINT 1 TO 21: CLS : VIEW PRINT 8250 COLOR 1, 2: VIEW PRINT 3 TO 19: CLS : VIEW PRINT 8260 VIEW PRINT 22 TO 25: CLS : VIEW PRINT 8270 COLOR 5, 0: L = 23: C = 1: GOSUB 8350: C = 70: GOSUB 8350 8280 L = 24: C = 1: GOSUB 8350: C = 70: GOSUB 8350 8290 L = 25: C = 1: GOSUB 8350: C = 70: GOSUB 8350 8300 LOCATE 23, 32: COLOR 1, 2: PRINT "Instrument Status TC :" 8310 LOCATE 23, 64: PRINT USING 㐞"##.#"; VAL(TEMPER$) 8320 RETURN 8350 LOCATE L, C: PRINT SPACE$(11); : RETURN 30000 OPEN "r", #1, "NAMETH", 105 30010 FIELD #1, 6 AS A1$, 6 AS D$, 32 AS A2$, 32 AS A3$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$ 30020 FOR I = 1 TO 32 30030 GET #1, I 30040 B$(I) = A1$: MTT$(I) = A3$ 30050 NEXT I: CLOSE #1: RETURN TURN 2892 NEXT K%: RETURN 2893 IF K1(24) = 0 THEN CYCLE$ = "1": GOTO 2897 2895 IF K1(25) = 0 THEN CYCLE$ = "2" ELSE CYCLE$ = "3" 2897 QP$ = Q$ + CYCLE$ 289Z>㐞1 '************************************************************ 2 ' CALC1CP 3 ' avec entiers 4 ' nouvelle gestion call cla et absorb 5 ' anast+calculs substrats 6 ' version 06/12/1988 2.4 + 3.0 7 '************************************************************ 15 DEFINT A-D, F-J, L-V, X-Z 17 DIM L(5), C(5), WCC(6), WCOF(6) 19 DIM PAT$(48), K1(100), PL(50), PLM(50), PLP(50), PLPM(50), PZ(48) 20 DIM P2(48), S!(48㐞), P3!(48) 25 DIM P64(64), LE(48), PLACE(48), PAR(60), B$(32), MTT$(32) 30 COMMON STATUS, METH, P64(), LE(), PLACE(), O1!, C1!, O2, C2, AIG1, AIG3, PAR(), M, M1, RE, VER, BUT, PAS, PA$, LIGNE, METP, DEMET, LIMI, NONL$, TEMPER$, DATEF$, ATTEN, MEP 31 GOSUB 30000: F9% = 2 ^ 8: MA% = 1: SUP% = F9%: GOSUB 600 32 SCREEN 0: DEV% = 52: GOSUB 602: GOSUB 8240: GOSUB 1290: IF PAR(17) THEN LOCATE 3, 2, 0: RETOUR = 1: ABORT = 1: GOSUB 2205: GET #1, 1: ERE% = CVI(LEFT$(E$, 2)): CLOSE #1: GOSUB 1320: GOSUB 1350: RETO㐞UR = 2 ELSE GOSUB 45 33 KEY(8) ON: GOSUB 1800: GOTO 4980 34 LOCATE 24, 26: PRINT SPACE$(30): RETURN 35 GOSUB 592 37 IF PA$ <> "anast" THEN ATTEN = 0: MEP = 0 39 CLOSE #1: CLOSE #2: CLOSE #3: GOSUB 2207 40 WFREE = FRE(""): CHAIN PA$ 45 RESTORE 1535: GOSUB 120: FOR CVB = 0 TO 6: LOCATE 5 + CVB, 10: GOSUB 1700: NEXT CVB: RETURN 46 IF PAR(17) <> 0 OR (NOEUD = 1 AND LIGNE > 6) OR LIGNE > BUTEB THEN RETURN ELSE CVB = LIGNE: LOCATE 5 + LIGNE, 10: GOSUB 1700: LOCATE 5 + LIGNE, 9: PRINT " "; : LOCATE 5 + LIG㐞NE, LEN(Y$) + 10: PRINT " " 47 RETURN 50 MSE = PAR(19 + (3 * PAR(37))) AND 31: MME = (PAR(19 + (3 * PAR(37))) AND 992) / 32: DPL = (PAR(20 + (3 * PAR(37))) AND 496) / 16: DPL$ = RIGHT$(STR$(DPL), LEN(STR$(DPL)) - 1) 52 BV% = (PAR(19 + (3 * PAR(37))) AND 15360) / 1024: IF (PLM(49) AND 2 ^ (BV% - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0) THEN ST$ = " Std" ELSE ST$ = " " 53 IF MME THEN ECRI$ = "M" ELSE ECRI$ = "S" 54 IF (PAR(20 + (3 * PAR(37))) AND 2 ^ 12) <> 0 THEN ECRI$ = ECRI$ + "R" ELSE ECRI$ = ECR㐞I$ + " " 55 IF MME THEN ECRI$ = ECRI$ + "-" + LEFT$(MTT$(MME), 6) + " Tray:" + DPL$ + " " + LEFT$(B$(MSE), 6) + ST$ ELSE ECRI$ = ECRI$ + "-" + LEFT$(B$(MSE), 6) + " Tray : " + DPL$ + ST$ 60 COLOR 5, 0: LOCATE 2, 50: PRINT ECRI$ + SPACE$(30 - LEN(ECRI$)): RETURN 100 READ A$ 105 IF LON = 0 THEN 110 106 IF A$ = "" THEN A$ = SPACE$(10) 107 N = INT(LEN(A$) / 2): RETURN 110 PRINT A$; : LON = 0: RETURN 120 COLOR 5, 0: LOCATE 1, 20, 0: PRINT SPACE$(40): LOCATE 2, 30: PRINT SPACE$(20): COLOR 1, 2 121 GOSUB㐞 602: COLOR 5, 0: CB = 5 122 FOR I = 1 TO 7: READ A$: CUR = 11 * (I - 1) + INT(.4 * I) 160 IF I > 1 THEN LOCATE 20, 2 + CUR ELSE LOCATE 20, 1 + CUR 162 A3$ = SPACE$(5 - LEN(A$) / 2) + A$: A$ = A3$ + SPACE$(10 - LEN(A3$)): PRINT A$ 164 LOCATE 21, CB: IF A$ <> SPACE$(10) THEN PRINT "F" + RIGHT$(STR$(I), 1) ELSE PRINT " " 165 CB = CB + 11 + CINT(I / 2 - INT(I / 2)): NEXT I 166 L(1) = 24: C(1) = 7: L(2) = 24: C(2) = 75: L(3) = 1: C(3) = 39: L(4) = 1: C(4) = 6: L(5) = 2: C(5) = 40 170 FOR I = 8 TO 12: LO㐞 N = 1: GOSUB 100: LOCATE L(I - 7), C(I - 7) - N: GOSUB 110: NEXT I 205 IF STATUS <> 8 OR PASSAG = 0 THEN A1$ = SPACE$(11): A2$ = SPACE$(11) ELSE A1$ = " Start ": A2$ = " F8 " 210 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 1: GOSUB 110: A$ = A2$: LOCATE 25, 1: GOSUB 110 220 IF (STATUS <> 9 AND PAR(17) = 0) THEN A1$ = SPACE$(11): A2$ = SPACE$(11) ELSE A1$ = " Abort ": A2$ = " S F9 " 225 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 70: GOSUB 110: A$ = A2$: LOCATE 25, 70: GOSUB 110 250 LOCATE㐞 2, 2: PRINT DATEF$; : LOCATE 2, 50 280 GOSUB 50 290 SUP% = F9% 300 COLOR 1, 2: LOCATE 3, 1: RETURN 591 DOV% = &H32: CUM% = &HF: CALL IO(DOV%, CUM%, DAT%, RET%): RETURN 592 GOSUB 740: DAT% = &HFF40: GOSUB 591: RETURN'out 593 GOSUB 750: DAT% = &HBF00: GOSUB 591: RETURN'in 594 RET% = 0: WHILE (RET% < 2047): DOV% = &H35: CUM% = &H1: CALL IO(DOV%, CUM%, DAT%, RET%): WEND: RETURN 595 ' CALL HAR:RETURN 'hardcopy 600 CALL CLA(MA%, SUP%): RETURN 601 DEV% = &H32: CIM% = 5: RET% = 0: GOSUB 2095: RETURN 㐞602 VIEW PRINT 3 TO 19: CLS : VIEW PRINT: IF DEJAP THEN GOSUB 1530: IF MESS$ <> "0" AND MESS$ <> " " AND MESS$ <> CHR$(0) AND MESS$ <> "" THEN EFFAC% = 1: GOSUB 1400: EFFAC% = 0 603 DEJAP = 1: RETURN 610 PA$ = "maincp": GOTO 35 615 PA$ = "workcp": GOTO 35 620 IF O2 = 64 THEN PA$ = "mathcp": GOTO 35 ELSE BUT = 200: GOTO 610 625 IF CALFIN AND BUT <> 30 THEN AIG3 = 1 626 PA$ = "checkcp": GOTO 35 670 BUT = 100: GOTO 610 675 GOSUB 2450 678 IF PAS THEN PA$ = "rdcp": GOTO 35 ELSE PA$ = "ltcp": GOTO 35 68㐞0 PA$ = "parcp": GOTO 35 690 GOSUB 2540: PA$ = "anast": GOTO 35 696 PA$ = "diagcp": GOTO 35 740 GOSUB 2275: COLOR 5, 0: LOCATE 25, 70: PRINT SPACE$(11); : LOCATE 24, 70: PRINT SPACE$(11): COLOR 1, 2 745 RETURN 750 IF ENVPARAM% = 1 THEN GOSUB 740: RETURN ELSE IF PAR(17) = 0 OR ABORT = 1 THEN COLOR 5, 0: LOCATE 24, 70: PRINT " Abort ": LOCATE 25, 70: PRINT " S F9 "; : COLOR 1, 2 752 IF CHANGE = 1 AND ATTEN = 1 THEN GOSUB 2285 755 RETURN 820 IF NOSOUN% = 1 THEN RETURN ELSE GOSUB 885: FOR WTY =㐞 1 TO 4: SOUND 875, 12: FOR WBV = 1 TO 500: NEXT WBV: NEXT WTY: RETURN 850 IF MUSIC > 7 THEN RETURN ELSE IF ERE% < 19 THEN 853 ELSE 865 853 IF MESS = 0 THEN RETURN 855 IF NOSOUN% = 1 THEN RETURN ELSE GOSUB 885: SOUND 2000, 18: RETURN 865 IF NOSOUN% = 1 THEN RETURN ELSE GOSUB 885: FOR WTY = 1 TO 5: SOUND 2400, 5: FOR WBV = 1 TO 600 + (CINT(O2 / 16) - 1) * 75: NEXT WBV: NEXT WTY: RETURN 875 IF MENE <> 0 OR BUTEB < 9 OR PAR(17) <> 0 OR PAR(57) <> 0 OR FLECH <> 0 THEN RETURN ELSE IF ADTER <> 0 AND PAR(37) 㐞< 4 AND PAR(34) < 64 THEN LOCATE 14, 4, 0: PRINT "--->": GOTO 880 ELSE RETURN 880 IF MUSIPL = 1 THEN RETURN ELSE GOSUB 885: SOUND 3200, 300: FOR WTY = 1 TO 4000: NEXT WTY: MUSIPL = 1: RETURN 885 DAV% = 56: CIM% = 2: DAT% = 0: RET% = 0: CALL IO(DAV%, CIM%, DAT%, RET%): RETURN 887 IF PAR(17) = 0 THEN COLOR 1, 2: LOCATE 14, 4, 0: PRINT SPACE$(4) 888 RETURN 960 FLAGSORT% = 1: RETURN 970 IF NOSOUN% = 2 THEN NOSOUN% = 1: KEY(3) OFF: L = 20: C(2) = 27: A$ = SPACE$(7): C(1) = 28: A3$ = " ": GOSUB 1527: RETUR㐞N ELSE RETURN 1000 R$ = "": CIM% = &HC: DAT% = 0: GOSUB 2095: CIM% = 2: DAT% = 0 1005 GOSUB 2095 ': CHAR = RET% 1010 'IF CHAR = -1 THEN 1005 ELSE R$ = R$ + CHR$(CHAR) 1015 'IF CHAR <> 10 THEN 1005 ELSE CIM% = &HC: DAT% = 1: GOSUB 2095: RETURN 1080 'Q$ = "DST": GOSUB 1949 1081 'DOV% = &H35: CUM% = &H1: CALL IO(DOV%, CUM%, DAT%, RET%): IF RET% < 2048 THEN AJUMP = 1 ELSE AJUMP = 0 1082 'IF AJUMP THEN RETURN ELSE MESS$ = MID$(R$, 4, 1): IF MESS$ = "0" OR MESS$ = " " OR MESS$ = CHR$(0) THEN MESS = 0: GOTO㐞 1083 ELSE IF MESS$ <> MESB$ THEN MESB$ = MESS$: NOSOUN% = 0: GOSUB 1400: MUSIC = 0 'test dst 1083 RETURN 1100 V$ = RIGHT$(STR$(WV), LEN(STR$(WV)) - 1): RETURN 1110 FOR BV% = 1 TO 3: GET #1, BV% + 1: H$ = FF$: LSET FF$ = H$: PUT #1, BV%: NEXT BV%: CLOSE #1: RETURN 1140 GOSUB 1960: IF NOSOUN% = 0 THEN MESB$ = "0" 1141 IF NOSOUN% = 2 THEN RESTORE 1536 ELSE RESTORE 1535 1142 KEY(3) STOP: GOSUB 120: KEY(3) ON: LOCATE 7, 29: PRINT "Method Aborted": RETURN 1145 IF ABCAL THEN RETURN ELSE LOCATE 18, 40: PRIN㐞T "For a Complete Abort Press S F9"; : IF PAR(17) = 1 THEN PRINT " Again" ELSE PRINT " " 1147 RETURN 1150 'Q$ = "IND": GOSUB 1949: Q$ = LEFT$(V$, 3): QP$ = V$ + T1$ + CHR$(13) + CHR$(10): GOSUB 2055: Q$ = "@" + LEFT$(V$, 2): GOSUB 2100: Q$ = LEFT$(V$, 3): GOSUB 2100 1155 'Q$ = "OUD": GOSUB 1949: RETURN 1175 IF PAR(17) <= 1 OR Z$ = SPACE$(23) THEN RETURN ELSE LPRINT : GOSUB 1180: LPRINT : IF ERE% <> 29 THEN LPRINT "ERROR : "; 1176 LPRINT Z$: GOSUB 1180: GOSUB 7180 1177 RETURN 1180 FOR TY% = 1 TO 39: L㐞 PRINT "_"; : NEXT TY%: LPRINT : RETURN 1185 PAR(7 + METCO) = 0: IF PAR(16) = METCO THEN IF PAR(40 - METCO) THEN PAR(16) = 3 - METCO ELSE PAR(16) = 0 1186 RETURN 1190 COLOR 5, 0: ANAST = 1: GOSUB 2540: ANAST = 0: TE$ = MID$(R$, 15, 1): RETURN 1200 STATUS = 0: KEY(8) OFF: KEY(4) OFF: AIG1 = 0: GOSUB 1175: GOSUB 2207: CHANGE = 0: GOSUB 2280: ES% = 1: IF AIG2 > 0 OR ABCAL <> 0 THEN 1220 1201 IF PAR(37) = 0 AND PAR(57) <> 0 THEN PAR(54) = 1: GOTO 1240 1202 GOSUB 1205: GOSUB 1215: GOTO 1225 1205 FOR TY% = 㐞ES% TO 48: IF PLACE(TY%) <> 0 THEN PAR(54) = TY%: TY% = 48: GOTO 1210 1207 IF TY% = 48 THEN PAR(54) = 50 1210 NEXT TY%: RETURN 1215 BV% = (PAR(22) AND 15360) / 1024'BV%=(PAR(19+(3*PAR(37))) AND 15360)/1024:RETURN 1217 IF METP = 0 THEN BV% = 1 1218 RETURN 1220 GOSUB 1215: IF (((PLM(49) AND 2 ^ (BV% - 1)) <> 0 OR (PLM(49) <> 0 AND METP = 0)) AND LIMI = 1 AND ETP% <> 4) OR ABCAL <> 0 THEN PAR(54) = 1: GOTO 1225 1222 IF (((PLM(49) AND 2 ^ (BV% - 1)) <> 0 OR (PLM(49) <> 0 AND METP = 0)) AND LIMI = 1 AND E㐞TP% = 4) AND AIG2 < 17 THEN ES% = 17: GOSUB 1205 ELSE IF (AIG3 AND 255) = 49 THEN PAR(54) = 51 ELSE 1224 1223 GOTO 1225 1224 PAR(54) = AIG2: IF LIMI1 <> 49 AND AIG2 <> (AIG3 AND 255) AND AIG2 + 1 = LIMI1 THEN PAR(54) = LIMI1 1225 IF K1(6) = 3 OR K1(6) = 12 OR CALF <> 0 THEN 1240 1227 IF ((PLM(49) AND 2 ^ (BV% - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0)) AND LIMI = 1 AND ETP% = 4 AND ABAND = 0 THEN ATTEN = 0: GOSUB 740: LOCATE 18, 40: PRINT SPACE$(40) ELSE 1240 1228 GOSUB 4215: IF PAR(37) > 1 THEN 1240 EL㐞SE GOSUB 593: KEY(1) ON: KEY(2) ON: ON KEY(1) GOSUB 1255: ON KEY(2) GOSUB 1260 1230 IF ATTEN = 0 THEN FOR WTY = 1 TO 700: NEXT WTY: GOTO 1230 1235 IF PAR(37) > 1 THEN GOSUB 1145: GOSUB 750 1240 ENTET% = 0: GOSUB 2245 1242 GOSUB 2019: GOSUB 7180: NONL$ = "": GOSUB 1480: RETURN 1250 GOSUB 1270: AIGUILLAGE = 4: RETURN 1255 ATTEN = 1: RETURN 1260 ATTEN = 1: GOSUB 4010: GOSUB 6117: RETURN 1270 COLOR 1, 2: LOCATE 25, 24: PRINT SPACE$(10); "ABORT REQUESTED"; SPACE$(10); : LOCATE 19, 1: RETURN 1280 IF PAR(㐞17) = 2 THEN DEJARET = 0: GOSUB 1948 1285 RETURN 1290 PTREM = PAR(23) AND 15: UNE = 1: GOSUB 2415: GET #1, 49: PLM(49) = CVI(F4$): CLOSE #1: RETURN 1300 IF LIGNE = 10 THEN RETURN ELSE IF AIG2 < 17 AND PL(AIG2) = 254 AND AIG2 > 1 THEN GOSUB 4350 1305 RETURN 1310 IF PAR(17) = 0 THEN AAF = LIGNE: GOSUB 1595 1315 COLOR 1, 2: GOSUB 593: RETURN 1320 IF PAR(17) = 1 THEN GOSUB 2194: LSET P1$ = MKI$(1): PUT #1, 17: CLOSE #1 1325 RETURN 1330 REPET = REPET + 1: Q$ = "FIN": GOSUB 1946: IF (LEFT$(R$, 4) = "FIN1㐞" OR LEFT$(R$, 3) <> "FIN") AND REPET < 30 THEN FOR WTY = 1 TO 5000: NEXT: GOTO 1330 ELSE RETURN 1350 ECRANAB% = 1: GOSUB 1960: IF RETOUR = 2 THEN GOSUB 1370: RETURN ELSE ABORT = 1: GOSUB 1140 1351 IF PAR(17) <> 2 THEN V$ = "PIPE": T1$ = ":H,0": GOSUB 1150 1353 GOSUB 593: GOSUB 1145: IF PAR(17) <> 1 THEN PAR(34) = 64: X = 34: GOSUB 2158 1360 GOSUB 1370: GOSUB 1530 1365 KEY(8) ON: ON KEY(8) GOSUB 1250: RETURN 1370 IF ERE% = 26 THEN LOCATE 10, 25: PRINT "Verify reagent or sample level": LOCATE 12, 28: P㐞RINT "Complete if necessary" ELSE IF ERE% = 30 THEN LOCATE 11, 25: PRINT "Complete the Pre-Fill Container" 1375 GOSUB 601: DEV% = 52: RETURN 1400 COLOR 1, 2: IF LEN(MESS$) = 0 THEN MESS = VAL(MESS$): GOTO 1420 ELSE MESS = ASC(MESS$): IF MESS > 57 THEN MESS = MESS - 7 1405 ERE% = MESS - 33: IF ERE% > 30 THEN GOSUB 1430 ELSE IF ERE% > 18 THEN GOSUB 1460 1410 GOSUB 2206: IF Z$ = SPACE$(23) THEN 1420 ELSE IF ERE% = 29 THEN 1411 ELSE LOCATE 25, 38: PRINT Z$; SPACE$(2); : IF ERE% < 19 THEN LOCATE 25, 25: PRIN㐞T " WARNING : "; ELSE LOCATE 25, 25: PRINT " ERROR : "; 1411 IF EFFAC% THEN RETURN 1412 IF FRE(0) < 2500 THEN WFREE = FRE("") 1413 IF ERE% <> 0 AND NOSOUN% = 0 THEN ON KEY(3) GOSUB 970: KEY(3) ON: NOSOUN% = 2: A$ = "Acknow": L = 20: C(2) = 27: A3$ = "F3": C(1) = 28: GOSUB 1527 1414 IF ERE% < 19 THEN GOSUB 855 ELSE GOSUB 865 1420 RETURN 1430 PAR(17) = 4: ERREUR% = 1: DEJARET = 1: PAR(56) = ERE%: IF FLECH THEN RETURN ELSE GOSUB 887: FLECH = 1: RETURN 1460 PAR(17) = 2: ERREUR% = 1: DEJARET = 1: P㐞AR(55) = PAR(55) OR 2 ^ (ERE% - 19): IF PAR(54) = 0 THEN PAR(54) = VAL(MID$(R$, 17, 2)) 1465 IF FLECH THEN RETURN ELSE GOSUB 887: FLECH = 1: RETURN'derniere cuve correcte 1470 GOSUB 1556: GOSUB 592: BUTEB = 10: AFFICH = 2047: GOSUB 1565: MAJECR = 1: GOSUB 1780: GOSUB 593: RETURN 1475 CALIB = 0: CHCAL = 0: ALLE = 0: REVOI = 0: REFU = 0: REFA = 0: WSCH = 0: DAC = 0: ABAND = 0: BLACOR = 0: WBLACORI = 0: WBLACORF = 0: BLOBLG = 0: RBL = 0: FOR TY% = 1 TO 6: WCC(TY%) = 0: WCOF(TY%) = 0: NEXT TY% 1480 GOSUB 21㐞 93: FOR TY% = 22 TO 46: LSET T1$ = MKS$(0): PUT #1, TY%: NEXT TY%: CLOSE #1: RETURN 1482 GOSUB 2193: LSET T1$ = MKS$(RBL): PUT #1, 46: CLOSE #1: RETURN 1483 GOSUB 2193: LSET T1$ = MKS$(WBLACORI): PUT #1, 44: LSET T1$ = MKS$(WBLACORF): PUT #1, 45: CLOSE #1: RETURN 1485 GOSUB 592: CHANGE = 1 1490 NOMB = 1: NOMBST = 1: GOSUB 2761: FOR IND = 2 TO 48: IF (PLM(IND) AND 2 ^ (PAR(40) - 1)) = 0 THEN 1500 1495 IF PL(IND) <> 0 AND PL(IND) < 255 THEN NOMB = NOMB + 1: IF PL(IND) = 254 THEN NOMBST = NOMBST + 1 1500㐞 NEXT IND: GOSUB 1985: IF (64 - PAR(34) >= NOMB AND PAR(34) <> 64) THEN CHANGE = 3 ELSE IF PAR(37) <> 0 AND ((64 - PAR(34)) < NOMBST OR PAR(34) > 62) THEN ATTEN = 1: CHANGE = 2 ELSE GOSUB 2250 1505 GOSUB 2280: PTREM = PAR(23) AND 15: GOSUB 2415: GOSUB 2430: IF K1(6) > 2 OR BLACOR = 1 OR K1(33) <> 0 THEN PL(1) = 254 1507 GOSUB 593: RETURN 1510 GOSUB 2193: GET #1, 21: CHANGE = CVS(T1$): CLOSE #1: RETURN 1515 IF CHANGE = 0 THEN GOSUB 1510 1520 RETURN 1525 LOCATE 24, 32: PRINT "Change Requested": LOCATE 1㐞9, 1: RETURN 1527 COLOR 5, 0: LOCATE L + 1, C(1): PRINT A3$: LOCATE L, C(2): PRINT A$: COLOR 1, 2: RETURN 1530 LOCATE 25, 16: PRINT (64 - PAR(34)); SPACE$(2); : LOCATE 24, 13: PRINT "Free cuvet.": RETURN 1535 DATA ,,,,,,,,,< CPA >,, 1536 DATA ,,Acknow,,,,,,,< CPA >,, 1541 Y$ = " SET UP AND START ": RETURN 1542 Y$ = " SAMPLE PROGRAMMING AND REPORTING ": RETURN 1543 Y$ = " INSTRUMENT PROTOCOL AND QC ": RETURN 1544 Y$ = " CREATION AND METHOD REVISION ": RETURN 1545 Y$ = " PATIENT FILE REVIEW ": R㐞ETURN 1546 Y$ = " MATH FUNCTIONS ": RETURN 1547 Y$ = " MAINTENANCE ": RETURN 1548 Y$ = " CHECK ABSORBANCES ": RETURN 1549 Y$ = " CHANGE CALIBRATION ": RETURN 1550 Y$ = " CONTINUE ": RETURN 1551 Y$ = " INTERRUPTED METHOD ": RETURN 1556 IF ECRANAB% THEN RETURN ELSE GOSUB 592: COLOR 1, 2: LOCATE 15, 10: GOSUB 1551: PRINT Y$: LOCATE 14, 10: GOSUB 1550: PRINT Y$: LOCATE 12, 10: GOSUB 1548: PRINT Y$: IF SAUTCC THEN GOSUB 593: RETURN ELSE LOCATE 13, 10: GOSUB 1549: PRINT Y$: GOSUB _ 593: RETURN 155㐞9 GOSUB 592: COLOR 1, 2: LOCATE 24, 26: PRINT SPACE$(30); : C = 41 - INT(LEN(SELEC$) / 2): LOCATE 24, C: PRINT SELEC$; : LOCATE LIGNE + 5, 1: GOSUB 593: RETURN 1565 IF ECRANAB% THEN RETURN ELSE AAF = LIGNEB: GOSUB 1595: AAF = LIGNE: GOSUB 1595'curseur 1566 LIGNEB = LIGNE: LOCATE , , 0: COLOR 1, 2: RETURN 1595 ON AAF + 1 GOSUB 1541, 1542, 1543, 1544, 1545, 1546, 1547, 1548, 1549, 1550, 1551 1596 IF AAF = LIGNE THEN COLOR 5, 0: LOCATE 5 + LIGNE, 9: PRINT "[": LOCATE 5 + LIGNE, LEN(Y$) + 10: PRINT "]" ELSE㐞 COLOR 1, 2: LOCATE 5 + LIGNEB, 9: PRINT " ": LOCATE 5 + LIGNEB, LEN(Y$) + 10: PRINT " " 1597 LOCATE 5 + AAF, 10: PRINT Y$; : RETURN 1605 GOSUB 592: IF AIGUILLAGE THEN 1620 '^ 1606 IF LIGNE = BUTEH THEN LIGNEB = BUTEH: LIGNE = BUTEB: GOSUB 1565: GOTO 1620 1607 IF (LIGNE = 9 AND SAUTCC) OR (LIGNE = 10 AND PAR(57) <> 0) THEN LIGNE = LIGNE - 1 1610 LIGNE = LIGNE - 1: GOSUB 1565 1620 GOSUB 593: RETURN 1630 GOSUB 592: IF AIGUILLAGE THEN 1645 'v 1631 IF LIGNE = BUTEB THEN LIGNEB = BUTEB: LIGNE = BUTEH: GO㐞SUB 1565: GOTO 1645 1632 IF (LIGNE = 7 AND SAUTCC) OR (LIGNE = 8 AND PAR(57) <> 0) THEN LIGNE = LIGNE + 1 1635 LIGNE = LIGNE + 1: GOSUB 1565 1645 GOSUB 593: RETURN 1655 GOSUB 592: IF LIGNE = 6 OR PAR(17) <> 0 OR AIGUILLAGE <> 0 THEN 1670'< 1656 AIGUILLAGE = 1 1658 COLOR 1, 2: ON LIGNE + 1 GOSUB 1541, 1542, 1543, 1544, 1545, 1546, 1547, 1548, 1549, 1550, 1551 1660 SELEC$ = Y$: GOSUB 1559 1670 GOSUB 593: RETURN 1700 ON CVB + 1 GOSUB 1541, 1542, 1543, 1544, 1545, 1546, 1547, 1548, 1549, 1550, 1551 17㐞01 PRINT Y$: RETURN 1715 IF ECRANAB% THEN RETURN ELSE BUTEH = 1 1725 IF (AFFICH AND 2 ^ BUTEB) THEN 1740 ELSE BUTEB = BUTEB - 1: GOTO 1725 1740 FOR CVB = 0 TO 10: LOCATE 5 + CVB, 10 1741 IF CVB = 8 AND SAUTCC THEN 1760 1742 IF (AFFICH AND 2 ^ (CVB)) = 0 THEN 1760 1745 GOSUB 1700 1760 NEXT CVB 1770 AIGUILLAGE = 0 1775 GOSUB 1565 1777 GOSUB 1530 1780 KEY(8) OFF: KEY(9) ON: KEY(10) ON: KEY(12) ON: IF STATUS = 9 THEN KEY(8) ON 1785 ON KEY(9) GOSUB 1605 1790 ON KEY(10) GOSUB 1655 1795 ON KEY(12) GO㐞SUB 1630 1800 IF STATUS = 9 THEN ON KEY(8) GOSUB 1935 1805 RETURN 1855 BUT = 30: GOTO 625 1865 GOSUB 4205: IF VA THEN BUT = 40: GOTO 625 ELSE AIGUILLAGE = 0: GOSUB 593: GOTO 4290 1870 GOSUB 1515: IF (AIGUILLAGE = 8 OR CHANGE = 2 OR CHANGE = 4) AND PAR(37) <> 0 THEN ATTEN = 1: GOTO 4260 ELSE IF AIGUILLAGE = 1 AND LIGNE = 10 THEN 4260 ELSE IF CHANGE = 1 OR CHANGE = 3 THEN GOSUB 2275: GOSUB 1300: GOTO 1874 1873 KEY(4) OFF: CHANGE = 0: GOSUB 2280: METH = PAR(7 + METCO): IF PAR(17) THEN GOSUB 1200: PAS = 3㐞 2: NONL$ = "": GOTO 675 ELSE VER = 16: GOSUB 1242: GOTO 675 1874 GOSUB 592: KEY(4) OFF: CHANGE = 0: GOSUB 2280: VER = 16: BUT = 15: GOTO 690 1875 IF PAR(37) = 1 AND PAR(17) <> 0 THEN 1873 ELSE BUTEB = 7: IF LIMI1 <> 49 THEN VER = 32: GOTO 675 1876 GOSUB 887: IF MEP = PAR(8) THEN METCO = 1 ELSE METCO = 2 1877 FIFL = 0: IF ((PAR(22) AND 16384) / 16384) THEN FIFL = 1 1880 PAR(37) = PAR(37) - 1 1881 ENC% = PAR(23) AND 15 1882 FOR SOURCE = 0 TO 6 STEP 3: PAR(22 + SOURCE) = PAR(25 + SOURCE) 1883 PAR(23 + 㐞SOURCE) = PAR(26 + SOURCE): PAR(24 + SOURCE) = PAR(27 + SOURCE): NEXT SOURCE 1884 PAR(31) = 0: PAR(32) = 0: PAR(33) = 0 1885 IF METCO = 2 THEN ENC% = ENC% - 4 1886 IF FIFL = 0 THEN 1897 1888 PAR(35) = PAR(35) XOR 2 ^ (ENC% - 1 + (8 * (METCO - 1))): PAR(41 + ENC% + (4 * (METCO - 1))) = 0 1889 PAR(36) = PAR(36) XOR 2 ^ (ENC% - 1 + (8 * (METCO - 1))) 1890 ENC% = ENC% + 1: IF ENC% = 5 THEN ENC% = 1 1891 IF (PAR(36) AND 2 ^ (ENC% - 1 + (8 * (METCO - 1)))) THEN PAR(11 + METCO) = ENC% ELSE PAR(11 + METCO) =㐞 0 1894 INK = 0: FOR INC = 0 TO 3: GOSUB 1975 1895 NEXT INC: IF INK THEN 1897 1896 IF PAR(9 + METCO) = 0 THEN GOSUB 1185 1897 GOSUB 2450: GOSUB 2199 1900 GOSUB 1110 1902 IF FIFL THEN GOSUB 2300 1905 GOSUB 2200 1908 GOSUB 1110: AIG3 = 0: IF (PAR(34) = 64) AND (PAR(37) = 0) AND (PAR(40) <> 0) THEN ENTET% = 0: GOSUB 2245: GOTO 1873 1909 GOSUB 1969: GOSUB 1475: GOTO 7175 1910 IF AR$=SPACE$(LEN(AR$)) THEN RETURN ELSE LONG=0:FOR TY%=32 TO 1 STEP-1:IF MID$(AR$,TY%,1)=CHR$(0) OR MID$(AR$,TY%,1)=CHR$(32) T㐞HEN LONG=TY%-1 ELSE TY%=1 1915 NEXT TY%:LPRINT TAB(20-INT(LONG/2)) LEFT$(AR$,LONG+1):RETURN 1935 TB = 1: IF PAR(37) <> 0 AND PAR(17) = 0 THEN AIGUILLAGE = 3: PAR(17) = 1 ELSE 1945 1940 GOSUB 887: GOSUB 1270: IF FLECH = 0 THEN GOSUB 887: FLECH = 1 1945 RETURN 1946 QP$ = Q$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 1000: RETURN 1948 IF DEJARET THEN RETURN ELSE Q$ = "STO": PAR(34) = 64 1949 'QP$ = Q$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 2100: RETURN 1950 RETURN 'Q$ = "ABU": GOSUB 1949: AIGUILLAGE = 㐞0: GOSUB 2525: RETURN 1955 'KEY(1) OFF:KEY(2) OFF:KEY(3) OFF:KEY(4) OFF:KEY(5) OFF:KEY(6) OFF 1960 KEY(9) OFF: KEY(10) OFF: KEY(12) OFF 1965 RETURN 1969 IF FIFL = 0 THEN RETURN 1970 IF (PAR(35) AND 2 ^ (PAR(37 + METCO) - 1 + (8 * (METCO - 1)))) = 0 THEN PAR(37 + METCO) = PAR(37 + METCO) + 1 1971 IF PAR(37 + METCO) = 5 THEN PAR(37 + METCO) = 1 1972 IF (PAR(35) AND 2 ^ (PAR(37 + METCO) - 1 + (8 * (METCO - 1)))) = 0 THEN PAR(37 + METCO) = 0 1973 GOSUB 2450: RETURN 1975 BV% = (PAR(22 + (3 * INC)) AND 9㐞92) / 32: IF BV% = 0 THEN BV% = (PAR(22 + (3 * INC)) AND 31) 1979 IF BV% = PAR(7 + METCO) THEN INK = 1 1980 RETURN 1981 CALCONT = K1(63 + K1(1) + BLACOR): IF K1(76) <> 0 THEN CALCONT = K1(76) 1982 IF K1(77) <> 0 THEN CALCONT = K1(77) 1983 RETURN 1985 METSUI = VAL(MID$(NMLI$, (PAR(40) * 3) - 1, 2)): GOSUB 2198: GET #1, (METSUI - 1) * 100 + 6: KSUI = CVS(A2$) 1990 CLOSE #1 1992 IF KSUI = 4 THEN NOMB = NOMB + 1: NOMBST = NOMBST + 1 1995 RETURN 1998 ABCAL = 1: GOSUB 7180 1999 SOUND 2500, 200: PAR(17)㐞 = 1: GOSUB 1948: GOSUB 1350: RETURN 2000 GOSUB 594: LOCATE 24, 24: PRINT SPC(12); "RESULTS"; SPC(12); 2002 I = 0: ITPE = PAR(23) AND 15: IF (PAR(41 + ITPE) AND 512) <> 0 THEN LPRINT "RUN 2 :"; 2004 I = I + 1: ON I GOTO 2006, 2008, 2010 2006 IF METP THEN AR$ = NT$ + " / " + LEFT$(MTT$(METP), 6) + SPACE$(17) ELSE AR$ = NT$ + SPACE$(26) 2007 GOSUB 1910: GOTO 2004 2008 AR$ = NTI$: GOTO 2007 2010 AR$ = NST$: GOSUB 1910 2012 LPRINT DATEF$; TAB(15); "TIME :"; LEFT$(TIME$, 5); TAB(32); "TRAY :"; (PAR(23) A㐞ND 2032) / 16 2014 LPRINT "TEMP.C : "; : GOSUB 2193: GET #1, METI: LPRINT T1$; : CLOSE #1 2016 IF K1(6) <> 3 THEN LPRINT TAB(23); "LIN. RANGE:"; K1(39) ELSE LPRINT 2018 LPRINT "EXP. VAL:"; VAL(NE1$); "-"; VAL(NE2$); TAB(28); "UNIT 1:"; NU1$: RETURN 2019 DERBAK = DERLEC 2020 IF LEN(NONL$) = 0 THEN RETURN 2021 FOR WE = 1 TO LEN(NONL$): IF MID$(NONL$, WE, 1) = "." THEN RETI = WE: WE = LEN(NONL$) 2022 NEXT WE: IJ = VAL(LEFT$(NONL$, RETI - 1)): NONL$ = RIGHT$(NONL$, LEN(NONL$) - RETI): IF IJ = III THEN 20㐞20 ELSE DERLEC = DERBAK: IF K1(6) = 3 AND (P2(IJ) AND 2 ^ 5) = 0 THEN LPRINT "NO LINEAR :"; ELSE LPRINT "OUT OF LIMIT :"; 2023 IF IJ < 17 THEN LPRINT "C"; IJ ELSE LPRINT "SAMPLE "; IJ - 16 2024 A = 0: DCUVE = PLACE(IJ): GOSUB 3550: III = IJ: GOTO 2020 2040 FOR BV% = TOP TO LEN(R$) 'traitem. chaine ABC DOC 2045 IF MID$(R$, BV%, 1) = ARRIV$ THEN ARRIV = BV% - 1: BV% = LEN(R$): ARR = ARRIV - TOP + 1 2050 NEXT BV%: ARR$ = MID$(R$, TOP, ARR): RETURN 2055 I = 1 2056 IF Q$ = "SECU" THEN Q$ = "@SE" 2065㐞  CIM% = &H10: GOSUB 2095 ': IF RET% = 0 THEN 2065 ELSE CHAR = ASC(MID$(QP$, I, 1)): CIM% = 1: DAT% = CHAR 2075 GOSUB 2095:RETURN ': I = I + 1: IF CHAR <> 10 THEN 2065 ELSE RETURN 2095 RETURN 'CALL IO(DEV%, CIM%, DAT%, RET%): RETURN 2100 R$ = "": INU = 0: BUFFER = 0: CIM% = &HC: DAT% = 0: GOSUB 2095 2110 CIM% = 2: DAT% = 0 2115 GOSUB 2095 ': CHAR = RET% 2120 'IF CHAR <> -1 THEN cim% = &H1E: GOSUB 2095: IF RET% <> 0 THEN R$ = "ERR": LPRINT "ERREUR STATUS "; RET%: GOTO 2150 'demande le status du caracter㐞e recu (*2 le temp de transfert) 2125 'IF CHAR = -1 THEN INU = INU + 1 ELSE R$ = R$ + CHR$(CHAR): GOTO 2135 2130 'IF INU = 6000 AND REPET THEN ARRET = 1: RETURN ELSE IF INU = 6000 THEN REPET = 1: GOTO 2152 ELSE 2110 2135 'IF CHAR <> 10 THEN 2110 2140 GOSUB 2095 ': IF RET% = -1 AND BUFFER <> 0 THEN R$ = "ERR" ELSE IF RET% <> -1 AND (Q$ <> "@PI") THEN BUFFER = 1: INU = 5900: GOTO 2110 2150 'IF Q$ <> LEFT$(R$, 3) AND REPET THEN ARRET = 1: AJUMP = 1: GOTO 2155 ELSE IF Q$ <> LEFT$(R$, 3) THEN REPET = 1 ELSE㐞 2155 2152 'IF Q$ <> "PIP" AND Q$ <> "@PI" THEN GOSUB 2055: GOTO 2100 2155 RETURN 'CIM% = &HC: DAT% = 1: GOSUB 2095: RETURN 2158 GOSUB 2194: LSET P1$ = MKI$(PAR(X)): PUT #1, X: CLOSE #1: RETURN 2162 OPEN "r", #1, "nameth", 105: FIELD #1, 6 AS T$, 6 AS DA$, 32 AS ST$, 32 AS TI$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$: RETURN 2170 GOSUB 2162 2185 GET #1, METI: NT$ = T$: NST$ = ST$: NTI$ = TI$: NU1$ = U1$: NU2$ = U2$: NE1$ = E1$: NE2$ = E2$: NCOF$ = COF$: DECI$ = D1$: DECI 㐞= VAL(DECI$) 2186 CLOSE #1: GOSUB 2196: GET #1, 34: ENTET% = CVI(MID$(DH$, 57, 2)) 2187 IF K1(6) = 3 THEN CLOSE #1: RETURN 2190 GET #1, 33: IF DH$ = SPACE$(105) THEN DATHI$ = "00-00-00": CLOSE #1: RETURN ELSE DAH$ = MID$(DH$, 1 + ((METI - 1) * 4), 4): MJ = CVI(LEFT$(DAH$, 2)): IF MJ = 0 THEN DATHI$ = "00-00-00": CLOSE #1: RETURN 2191 MOI = INT(MJ / 100): JOU = MJ - (100 * MOI): ANN$ = RIGHT$(DAH$, 2): DATHI$ = STR$(MOI) + "-" + STR$(JOU) + "-" + ANN$: CLOSE #1: RETURN 2193 OPEN "r", #1, "temper", 4: FI㐞ELD #1, 4 AS T1$: RETURN 2194 OPEN "R", #1, "pargen", 2: FIELD #1, 2 AS P1$: RETURN 2195 OPEN "r", #1, "ABSORB", 106: FIELD #1, 106 AS A1$: RETURN 2196 OPEN "r", #1, "nameth", 105: FIELD #1, 105 AS DH$: RETURN 2198 OPEN "r", #1, "method", 4: FIELD #1, 4 AS A2$: RETURN 2199 OPEN "r", #1, "cyclec", 96: FIELD #1, 96 AS FF$: RETURN 2200 OPEN "r", #1, "plac", 96: FIELD #1, 96 AS FF$: RETURN 2201 OPEN "r", #1, "qualite", 408: FIELD #1, 4 AS QL1$, 4 AS QL2$, 6 AS LL$, 4 AS QH1$, 4 AS QH2$, 6 AS LH$, 186 AS 㐞RL$, 186 AS RH$, 4 AS CL$, 4 AS CUH$: RETURN 2202 OPEN "r", #1, "paille", 206 2203 FIELD #1, 12 AS NM$, 2 AS M1$, 2 AS M2$, 2 AS MR1$, 2 AS MR2$, 120 AS P$, 6 AS M2P$, 18 AS P2P$, 42 AS RP$: RETURN 2205 OPEN "r", #1, "erreur", 23: FIELD #1, 23 AS E$: RETURN 2206 GOSUB 2205: GET #1, ERE%: Z$ = E$: CLOSE #1: RETURN 2207 IF ERE% > 18 THEN GOSUB 2205: LSET E$ = MKI$(ERE%) + SPACE$(21): PUT #1, 1: CLOSE #1: RETURN ELSE RETURN 2210 GOSUB 2198 2225 FOR K% = 1 TO 100: GET #1, (METI - 1) * 100 + K%: K1(K%) = 㐞CVS(A2$): NEXT K% 2240 CLOSE #1: RETURN 2245 GOSUB 2196: GET #1, 34: ENT$ = DH$: MID$(ENT$, 57, 2) = MKI$(ENTET%): LSET DH$ = ENT$: PUT #1, 34: CLOSE #1: RETURN 2250 GOSUB 593: GOSUB 2285: KEY(4) ON: ON KEY(4) GOSUB 2270 2255 FOR WTY = 1 TO 9: SOUND 2000, 20: FOR WBV = 1 TO 4000 2257 IF AIGUILLAGE = 8 THEN WTY = 9: WBV = 4000: GOSUB 1525 2258 NEXT WBV: NEXT WTY 2265 RETURN 2270 IF AIGUILLAGE <> 0 THEN RETURN ELSE AIGUILLAGE = 8: RETURN 2275 L = 20: C(2) = 38: A$ = SPACE$(6): C(1) = 40: A3$ = " ": 㐞GOSUB 1527: RETURN 2280 GOSUB 2193: LSET T1$ = MKS$(CHANGE): PUT #1, 21: CLOSE #1: RETURN 2285 L = 20: C(2) = 38: A$ = "Change": C(1) = 40: A3$ = "F4": GOSUB 1527: RETURN 2290 OPEN "r", #1, FIL$, 14: FIELD #1, 2 AS F1$, 2 AS F2$, 2 AS F3$, 2 AS F4$, 2 AS F5$, 2 AS F6$, 2 AS F7$: RETURN 2300 GOSUB 2290 2305 V$ = MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) 2310 FOR TY% = 1 TO 50: LSET F1$ = V$: PUT #1, TY%: NEXT TY%: CLOSE #1: RETURN 2320 IF AIG2 < 17 THEN LPRINT "C" + STR$(AIG2㐞); ELSE LPRINT " " + STR$(AIG2 - 16); 2325 TES = PL(AIG2)':IF PRED<>0 AND AIG2<17 THEN TES=PL(PLP(AIG2)) ':IF TES=251 AND AIG2<17 THEN LPRINT TAB(6) "Stat";:KI%=1:GOTO 2367 2330 IF TES = 251 THEN LPRINT TAB(6); "Sample X"; : KI% = 1: GOTO 2367 2335 IF TES = 253 THEN LPRINT TAB(6); "QC 1"; : KI% = 1: GOTO 2367 ELSE IF TES = 252 THEN LPRINT TAB(6); "QC 2"; : KI% = 1: GOTO 2367 2340 IF TES < 251 THEN LPRINT TAB(6); PAT$(AIG2); : KI% = 1: GOSUB 15000: GOTO 2367 2345 IF TES <> 254 THEN 2367 2350 IF AIG2㐞  = K1(76) THEN LPRINT TAB(6); "CAL. CONT 1"; : KI% = 1: GOTO 2367 2355 IF AIG2 = K1(77) THEN LPRINT TAB(6); "CAL. CONT 2"; : KI% = 1: GOTO 2367 2360 IF (K1(6 + NB) = 0) AND (K1(63 + NB) = 1) THEN LPRINT TAB(6); "Blank"; : GOTO 2367 2365 LPRINT TAB(6); "STD"; : GOSUB 2375: GOSUB 2385 2367 IF P2(AIG2) AND 2 ^ 3 THEN LPRINT TAB(19); "ANALYS. ERROR": GOSUB 2372: IF AIG2 = 1 THEN RBL = 1: GOSUB 1482 2368 IF P2(AIG2) AND 2 ^ 14 THEN LPRINT TAB(19); "OVERFLOW": IF AIG2 = 1 THEN RBL = 1: GOSUB 1482 2370 RETUR㐞N 2372 IF WPERTE = 1 THEN LPRINT TAB(19); "CHARACTER LOST" ELSE IF WPERTE = 2 THEN LPRINT TAB(19); "DIFFERENT ANSWERS" 2373 RETURN 2375 IF K1(1) = 0 THEN NB = 1: RETURN 2377 FOR BV% = 1 TO K1(1) + BLACOR: IF K1(63 + BV%) = AIG2 THEN NB = BV%: BV% = K1(1) + BLACOR 2380 NEXT BV%: RETURN 2385 LPRINT STR$(K1(6 + NB)); : RETURN 2400 IF RBL <> 0 AND AIG2 > 16 THEN LPRINT " RBL"; : P2(AIG2) = P2(AIG2) OR (2 ^ 5 + 2 ^ 13) 2402 RETURN 2410 GOSUB 2415: GOSUB 2430: GOTO 2435 2415 RESTORE 2440: FOR TY% = 1 TO㐞 PTREM: READ FIL$: NEXT TY% 2420 GOSUB 2290 2425 RETURN 2430 FOR IND = 1 TO 50: GET #1, IND: PL(IND) = CVI(F1$): PLP(IND) = CVI(F2$): PLM(IND) = CVI(F4$): PLPM(IND) = CVI(F5$) 2432 NEXT IND: CLOSE #1: RETURN 2435 GOSUB 2200 2436 GET #1, UNE: FOR IND = 1 TO 48: PLACE(IND) = CVI(MID$(FF$, (IND * 2) - 1, 2)): NEXT IND 2437 CLOSE #1: RETURN 2440 DATA tray11,tray12,tray13,tray14,tray21,tray22,tray23,tray24 2450 GOSUB 2194 2460 FOR IND = 1 TO 60: LSET P1$ = MKI$(PAR(IND)): PUT #1, IND 2475 NEXT IND: CL㐞OSE #1: RETURN 2480 IF (K1(30) = 0 OR (K1(30) < K1(28)) OR (K1(29) <> 0 AND K1(30) < K1(29))) AND K1(6) = 1 THEN BLACOR = 1 2482 RETURN 2500 RB$ = "": TROUVE = 0: PASSE = 0: IF K1(6) = 1 AND K1(30) = 0 AND J = 0 THEN S!(J) = 0: RETURN 2501 GOSUB 20000:GET#4,CUVE 'PASSE = PASSE + 1: WV = CUVE: GOSUB 1100: Q$ = "DOC": QP$ = Q$ + V$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 2100 2502 'MINI = 6: IF LEFT$(R$, 3) <> "DOC" THEN 2503 ELSE TOP = 4: ARRIV$ = ",": GOSUB 2040: IF VAL(ARR$) <> CUVE THEN 2503 ELSE TO㐞P = ARRIV + 2: ARRIV$ = CHR$(13): GOSUB 2040: IF (VAL(ARR$) < J AND INVEST = 0) OR ARR$ = "X" THEN 2503 ELSE 2505 2503 'IF PASSE < MINI THEN FOR WTY = 1 TO 1500: NEXT WTY: GOTO 2501 ELSE IF INVEST = 0 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 3 2504 'S!(J) = 0: TROUVE = 1: RETURN 2505 'IF VAL(ARR$) >= J THEN TROUVE = 1 ELSE RETURN 2506 AB=CVS(MID$(LECUV$,(J*4)-3,4)):AB$=STR$(AB) 'WV = J: GOSUB 1100: Q$ = "ABC": QP$ = Q$ + V$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 2100 2507 'MINI = 11: IF LEFT$(R$, 3) <> "ABC" 㐞THEN 2503 ELSE TOP = 4: ARRIV$ = ",": GOSUB 2040: IF VAL(ARR$) <> CUVE THEN 2503 ELSE TOP = ARRIV + 2: ARRIV$ = ",": GOSUB 2040: IF VAL(ARR$) <> J THEN 2503 2508 'TOP = ARRIV + 2: AB$ = MID$(R$, TOP, (LEN(R$) - 1 - TOP)): IF (AB$ = "::::::" OR AB$ = ";;;;;;" OR AB$ = "======") THEN WABSO = 3.3: GOTO 2517'PASSE=MINI:GOTO 2503 2509 'ZE = 0: PT = 0: FOR G = 1 TO LEN(AB$): IF MID$(AB$, G, 1) = CHR$(46) OR (MID$(AB$, G, 1) > CHR$(47) AND MID$(AB$, G, 1) < CHR$(58)) THEN 2510 ELSE ZE = 1 2510 'IF MID$(AB$, G, 㐞1) = CHR$(46) THEN PT = PT + 1 2512 'NEXT G: IF (PT <> 1 AND VAL(AB$) = 0) OR PT > 1 THEN ZE = 1 2513 'IF ZE THEN S!(J) = 0: GOTO 2503 2514 'IF LEN(AB$) <> 6 THEN WABSO = 0: LPRINT "PERTE DE CARACTERES :"; R$; AB$: IF INVEST = 0 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 3: WPERTE = 1: GOTO 2522 2515 'WABSI = VAL(AB$): IF WABSI = 0 THEN WABSO = 0: GOTO 2517 ELSE IF WABSI > 1584.9 THEN WABSO = 3.3: GOTO 2517 2516 'WABSO = (LOG(WABSI) / 2.302585) 2517 'IF RB$ = "" THEN RB$ = R$: FOR IYU = 1 TO 500: NEXT IYU: GOTO 㐞2506 ELSE IF R$ <> RB$ THEN WABSO = 0: LPRINT "REPONSES DIFFERENTES :"; RB$; R$: IF INVEST = 0 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 3: WPERTE = 2: WABSO = 0 2520 'IF WABSO > 3.2 THEN WABSO = 3.2: IF INVEST = 0 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 14 2522 TROUVE=1:S!(J) = AB:CLOSE#4: RETURN 2525 IF RAJ THEN RETURN 2540 GOSUB 1080: IF AJUMP THEN AJUMP = 0: GOTO 2560 2541 GOSUB 875: IF MESS = 0 AND ANAST <> 0 THEN 2550 ELSE IF MESS$ <> MESB$ AND PAR(17) = 0 THEN COLOR 5, 0: LOCATE 20, 27: PRINT SPACE$(7): LOCATE 21㐞, 28: PRINT SPACE$(2): KEY(3) OFF: COLOR 1, 2: LOCATE 25, 25: PRINT SPACE$(30); : LOCATE 19, 1: _ MESB$ = MESS$ 2542 IF PAR(37) = 4 THEN 2550 2543 IF VAR <> 0 OR ATTEN = 1 THEN 2545 2544 IF PASUI OR ANAST THEN 2550 2545 IF MID$(R$, 6, 1) = "1" THEN ADTER = 1 2550 WTEMPER = VAL(MID$(R$, 8, 4)): IF WTEMPER < 1 THEN 2557 2556 TEMPER$ = MID$(STR$(WTEMPER), 2, 4) 2557 IF ANAST THEN 2559 2558 AFTEM = AFTEM + 1: GOSUB 592: IF AFTEM = 1 AND ADTER = 0 AND METI THEN GOSUB 2193: LSET T1$ = TEMPER$:㐞  PUT #1, (PAR(19 + (3 * PAR(37))) AND 31): CLOSE #1 2559 COLOR 1, 2: IF WTEMPER > 1 THEN LOCATE 23, 64: PRINT USING "##.#"; WTEMPER 2560 GOSUB 593: RETURN 2635 STATUS = 0: GOSUB 820: DEMET = 0: PAR(50) = 0: PAR(51) = 0: GOSUB 4000: FOR BV% = 54 TO 56: PAR(BV%) = 0: X = BV%: GOSUB 2158: NEXT BV%: IF PAR(17) THEN GOSUB 1948 2637 PAR(17) = 0: X = 17: GOSUB 2158: ERE% = 0: GOSUB 2205: LSET E$ = MKI$(0) + SPACE$(21): PUT #1, 1: CLOSE #1 2640 AIG1 = 0: GOTO 610 2761 IF PAR(37) <> 0 THEN PTREM = PAR(20 + (3 㐞* PAR(37))) AND 15: GOTO 2763 ELSE IF MEP = PAR(8) THEN POINTE = 1 ELSE POINTE = 2 2762 PTREM = PAR(11 + POINTE) + (4 * (POINTE - 1)) 2763 GOSUB 2415: GOSUB 2430: RETURN 3300 IF K1(58) THEN PRED = 1 ELSE PRED = 0 3305 RETURN 3320 IF K1(6) = 3 OR K1(6) = 12 THEN DERN = 23 ELSE DERN = 3 3325 FOR TY% = 1 TO DERN 3330 IF LE(TY%) <> 0 THEN DERLEC = LE(TY%) ELSE TY% = DERN 3335 NEXT TY%: RETURN 3340 P3! = P3!(AIG2): DECIB = DECI: GOSUB 3350: IF P3! < 0 AND DECIB > 0 THEN DECIB = DECIB - 1 3341 IF DECIB 㐞= 0 AND P3! >= 0 THEN LPRINT TAB(19); USING "#######"; P3!; ELSE IF DECIB = 1 THEN LPRINT TAB(19); USING "#####.#"; P3!; ELSE IF DECIB = 2 THEN LPRINT TAB(19); USING "####.##"; P3!; ELSE IF DECIB = 3 THEN LPRINT TAB(19); USING _ "###.###"; P3!; ELSE 3343 3342 RETURN 3343 IF DECIB = 0 AND P3! < 0 THEN LPRINT TAB(19); USING "#######"; P3!; ELSE IF DECIB = 4 THEN LPRINT TAB(19); USING "##.####"; P3!; ELSE IF DECIB = 5 THEN LPRINT TAB(19); USING "#.#####"; P3!; ELSE LPRINT TAB(19); USING ".######"; P㐞3!; 3344 RETURN 3350 IF ABS(P3!) / 10 ^ (6 - DECIB) < 1 THEN RETURN ELSE DECIB = DECIB - 1: GOTO 3350 3355 GOSUB 592: COLOR 1, 2: LOCATE 24, 24: PRINT "IMPOSSIBLE": LOCATE 14, 1: GOSUB 593: AIGUILLAGE = 0: RETURN 3400 GOSUB 592: IF AIGUILLAGE <> 1 THEN LOCATE 24, 27: PRINT " Absorbance file update "; : LOCATE 19, 1 3405 RAJ = 1: GOSUB 593: REMET = 0: RETURN 3422 CUVE = PLACE(AIG2) 3424 GET #1, EN%: BU$ = A1$ 3425 INVEST = 1: FOR LI = 1 TO DERLEC: IF AIGUILLAGE = 3 AND DEJARET = 0 THEN GOSUB 1948㐞: DEJARET = 1 3430 J = LI: GOSUB 2500: IF TROUVE = 0 OR ZE = 1 THEN S!(J) = 0 3431 MID$(BU$, 3 + (LI - 1) * 2, 2) = MKI$(S!(J) * 10000) 3432 NEXT LI: INVEST = 0 3433 MID$(BU$, 97, 2) = MKI$(0) 3435 LSET A1$ = BU$: PUT #1, EN% 3466 CLOSE #1: GOSUB 592: IF AIGUILLAGE <> 1 THEN GOSUB 34: LOCATE 19, 1 3468 RAJ = 0: GOSUB 593: RETURN 3470 GOSUB 594: GOSUB 3400: GOSUB 2195: IF RELU = 0 THEN GOSUB 3320: RELU = 1 3475 MEC = METI: IF METP THEN MEC = MEC + (METP - 20) * 32 3480 MEC = MEC + (((PAR(23) AND 49㐞6) / 16) * 512): ITPE = PAR(23) AND 15 3481 IF (PAR(41 + ITPE) AND 256) THEN MEC = MEC + 16384 3482 IF (PAR(41 + ITPE) AND 512) THEN MEC = -MEC 3485 FOR ET% = 1 TO (O2 / 16): GET #1, ET% 3487 FOR NUM = 0 TO 15: ME = CVI(MID$(A1$, 1 + (NUM * 6), 2)) 3489 IF ME THEN 3499 3492 BU$ = A1$: MID$(BU$, 1 + (NUM * 6), 2) = MKI$(MEC) 3493 MID$(BU$, 3 + (NUM * 6), 2) = MKI$(LE(1) + (DERLEC * 256)) 3496 LSET A1$ = BU$: PUT #1, ET%: CLOSE #1: PAR(52) = PAR(52) + 1: X = 52: GOSUB 2158: GOSUB 2195: GOTO 3525 3499㐞 IF ME <> MEC THEN 3520 3500 EN% = (((ET% - 1) * 16 + NUM) * 48) + 4 + AIG2 3511 GET #1, EN%: BU$ = A1$: IF ASC(LEFT$(BU$, 1)) <> AIG2 THEN 3517 ELSE IF PL(AIG2) = 254 THEN GOSUB 3540: LSET A1$ = BU$: PUT #1, EN%: CUVE = PLACE(AIG2): GOTO 3424 3517 GOTO 3525 3520 NEXT NUM 3522 NEXT ET% 3525 GOSUB 3540 3527 EN% = (((ET% - 1) * 16 + NUM) * 48) + 4 + AIG2 3530 LSET A1$ = BU$: PUT #1, EN% 3535 GOSUB 3422 3537 RETURN 3540 BU$ = CHR$(AIG2) + CHR$(PL(AIG2)) + SPACE$(96) + MKI$(P2(AIG2)) + MKS$(P3!(AIG2)㐞) + MKI$(0): RETURN 3550 DERL = DERLEC: CUVE = DCUVE: RAJ = 1 3552 FOR LEC = 1 TO DERL: IF LE(LEC) = 0 THEN LEC = DERL: GOTO 3590 ELSE IF (LEC = 1 AND K1(6) = 1 AND K1(30) = 0) THEN 3590 3555 J = LE(LEC): GOSUB 2500 3562 GOSUB 3565: GOTO 3590 3565 IF LE(LEC) < 10 THEN 3575 3570 A = A + 1: LPRINT "ABS("; LE(LEC); ") ="; USING "##.####"; S!(LE(LEC)); : IF A = 1 THEN LPRINT "": GOTO 3580 ELSE 3577'LPRINT TAB(25) "diff = ";:LPRINT USING "##.####";(S!(LE(LEC))-S!(PREC)):GOTO 3580 3575 A = A + 1: LPRINT "A㐞BS( "; LE(LEC); ") ="; USING "##.####"; S!(LE(LEC)); : IF A = 1 THEN LPRINT "": GOTO 3580 3577 LPRINT TAB(25); "diff = "; : LPRINT USING "##.####"; (S!(LE(LEC)) - S!(PREC)) 3580 PREC = LE(LEC) 3582 RETURN 3590 NEXT LEC 3625 RAJ = 0: RETURN 3980 GOSUB 2198: GET #1, (MENE - 1) * 100 + 20: FTEMP = CVS(A2$): GET #1, (MENE - 1) * 100 + 21: FLOON = CVS(A2$): CLOSE #1: RETURN 3982 GOSUB 592: TB = 1:RETURN ' Q$ = "TOK": GOSUB 1949: GOSUB 593: RETURN 3985 TOK = 1: RETURN 3990 IF PAR(17) THEN TB = 1: RETURN 㐞  3991 IF VOY > 1 THEN VOY = 1 ELSE SOUND 2500, 200: L = 20: C(2) = 3: A$ = "Temp.": C(1) = 5: A3$ = "F1": GOSUB 1527: GOSUB 593: GOSUB 3985 3992 RETURN 3995 PAR(50) = K1(20): PAR(51) = K1(21): GOSUB 4000: RETURN 4000 X = 50: GOSUB 2158: X = 51: GOSUB 2158: RETURN 4005 'valid calib 4010 K1(19) = REFU: K1(78) = C1!: K1(79) = O1!: K1(80) = WSCH'slope+offset 4025 FOR NB = 1 TO K1(1) + BLACOR 4027 IF BLACOR <> 0 AND K1(6) = 1 THEN CUVE = PLACE(K1(63 + NB)) ELSE 4030 4028 J = PR: GOSUB 2500: J = DE: GOSUB㐞 2500: WCC(NB) = S!(DE) - S!(PR) 4030 K1(42 + NB) = WCC(NB) 4035 NEXT NB 4040 IF BLACOR THEN K1(91) = WBLACORI: K1(92) = WBLACORF 4075 GOSUB 2198 4085 FOR IND = 1 TO 100 4090 LSET A2$ = MKS$(K1(IND)) 4095 PUT 1, (METI - 1) * 100 + IND 4100 NEXT IND: CLOSE #1: RETURN 4110 GOSUB 1215: FOR TY% = 1 TO 48: IF PL(TY%) <> 254 AND PL(TY%) <> 0 AND (METP = 0 OR ((PLM(TY%) AND 2 ^ (BV% - 1)) <> 0 AND METP <> 0)) THEN AUTRE = 1: TY% = 48 4120 NEXT TY%: RETURN 4135 'mise ds temper 4140 GOSUB 2193: LSET T1$ 㐞= MKS$(REFU): PUT #1, 26: LSET T1$ = MKS$(BLACOR): PUT #1, 43: LSET T1$ = MKS$(ABAND): PUT #1, 41 4141 'LSET T1$=MKS$(WBLACORI):PUT#1,44:LSET T1$=MKS$(WBLACORF):PUT#1,45 4142 LSET T1$ = MKS$(C1!): PUT #1, 23: LSET T1$ = MKS$(O1!): PUT #1, 24 4145 ON K1(6) GOTO 4150, 4165 4150 FOR NB = 1 TO K1(1) + BLACOR 4155 CUVE = PLACE(K1(63 + NB)) 4157 J = PR: GOSUB 2500: J = DE: GOSUB 2500 4160 WCC(NB) = S!(DE) - S!(PR): IF BLACOR = 0 THEN 4162 4161 WCC(NB) = S!(DE) - WBLACORF - (S!(PR) - WBLACORI) * K1(40) 41㐞62 NEXT NB: GOTO 4170 4165 FOR NB = 1 TO K1(1) 4167 WCC(NB) = WCOF(NB) 4168 NEXT NB 4170 IF SSBLK = 0 THEN LSET T1$ = MKS$(WCC(1 + BLACOR)) ELSE LSET T1$ = MKS$(0) 4171 PUT #1, 22: FOR GH = 1 TO K1(1) + BLACOR: LSET T1$ = MKS$(WCC(GH)): PUT #1, (26 + GH): NEXT GH: CLOSE #1: RETURN 4173 'lis temper 4175 GOSUB 2193: GET #1, 23: C1! = CVS(T1$): GET #1, 24: O1! = CVS(T1$): GET #1, 26: REFU = CVS(T1$) 4178 GET #1, 39: ALLE = CVS(T1$): GET #1, 40: CHCAL = CVS(T1$): GET #1, 41: ABAND = CVS(T1$): GET #1, 42㐞: REVOI = CVS(T1$): GET #1, 43: BLACOR = CVS(T1$) 4180 FOR NB = 1 TO K1(1) + BLACOR 4185 GET #1, (NB + 26): WCC(NB) = CVS(T1$) 4190 NEXT NB: CLOSE #1: RETURN 4205 IF DAC = 0 THEN GOSUB 34: VA = 0 ELSE VA = 1 4210 RETURN 4212 GOSUB 2193: LSET T1$ = MKS$(REVOI): PUT #1, 42: CLOSE #1: RETURN 4215 CALFIN = 1: CHOIX = 0: COLOR 5, 0: LOCATE 19, 10: PRINT " "; NT$: SOUND 2500, 200: L = 20: C(2) = 2: A$ = "Cal Rej.": C(1) = 4: A3$ = "S F1": GOSUB 1527: C(2) = 13: A$ = "Cal Valid": C(1) = 17: A3$ = "F2": GOSU㐞B 1527: LOCATE 19, 1: SUP% = F9% + _ 2 ^ 0: GOSUB 600 4216 IF PAR(17) <> 0 AND PAR(37) = 1 THEN RETURN 4217 KEY(1) ON: ON KEY(1) GOSUB 4227 4218 KEY(2) ON: ON KEY(2) GOSUB 4228 4220 CHOIX = 1: IF AIGUILLAGE = 1 AND LIGNE = 9 THEN GOSUB 3355: GOTO 4220 ELSE IF AIGUILLAGE = 1 AND LIGNE = 10 THEN GOSUB 1950: GOTO 4220 ELSE IF CHOIX <> 0 OR AIGUILLAGE = 1 THEN GOSUB 4225: LOCATE 19, 10: PRINT SPACE$(8): RETURN ELSE 4220 4225 L = 20: C(2) = 2: A$ = SPACE$(9): C(1) = 4: A3$ = " ": GOSUB 1527: C(2) = 13:㐞 C(1) = 17: GOSUB 1527: LOCATE 19, 10: PRINT SPACE$(7): KEY(1) OFF: KEY(2) OFF: RETURN 4226 L = 20: C(2) = 72: A$ = SPACE$(8): C(1) = 74: A3$ = " ": GOSUB 1527: RETURN 4227 CHOIX = 1: RETURN 4228 CHOIX = 2: RETURN 4230 MAJECR = 0: IF (AIG3 AND 255) > 48 THEN GOSUB 1470 4233 GOTO 4500 4240 REMET = 0 4241 REMET = REMET + 1: IF REMET MOD (4) = 1 THEN GOSUB 2525: REMET = 1 4242 GOSUB 850: MUSIC = MUSIC + 1: IF ERREUR% <> 0 AND ECRANAB% = 0 THEN GOSUB 1350 ELSE IF PAR(17) = 0 OR AIGUILLAGE = 3 THEN 4244㐞 4243 IF AIGUILLAGE = 4 THEN GOSUB 1280: GOSUB 1200: PAS = 16: GOTO 675 ELSE 4292 4244 IF ADTER = 1 AND PAR(40) <> 0 AND ((PAR(21 + (3 * PAR(37))) AND 16128) / 256 = 49) AND CHANGE = 0 THEN GOSUB 1485 4245 IF PAR(34) = 64 OR PAR(37) = 4 OR PAR(17) <> 0 OR PASUI <> 0 OR ATTEN <> 0 THEN 4260 4246 IF ETP% = 4 AND AIG3 = K1(64) THEN 4260 4250 IF ADTER = 1 AND MENE <> 0 THEN GOSUB 592: GOTO 1870 4260 IF AIGUILLAGE = 3 THEN GOSUB 1948: AIGUILLAGE = 0: GOSUB 1350: GOTO 4292 4265 IF AIGUILLAGE = 8 THEN KEY(4㐞) OFF: CHANGE = 4: GOSUB 1525: GOSUB 2275: GOSUB 2280: AIGUILLAGE = 0 4270 IF ETP% = 4 AND AIG3 = K1(64) THEN 4290 ELSE IF AIGUILLAGE = 1 AND RAJ = 0 THEN 4275 ELSE 4290 4275 GOSUB 1300 4280 GOSUB 592: ON LIGNE GOTO 615, 680, 670, 615, 620, 696, 1855, 1865, 675, 4285 4285 GOSUB 1950 4290 IF MAJECR = 0 THEN INVEST = 1: J = 1: GOSUB 594: GOSUB 2500: IF TROUVE <> 0 AND PAR(17) = 0 THEN LIGNE = 9: GOSUB 1470 4291 IF MAJECR = 0 THEN FOR WYU = 1 TO 1500: NEXT WYU 4292 IF (CUVE > PAR(54) AND PAR(17) = 2) TH㐞 EN 4297 ELSE IF K1(6) = 3 THEN ADE = LE(DE) ELSE ADE = DE 4293 INVEST = 1: J = ADE: GOSUB 2500: INVEST = 0: IF TROUVE <> 0 THEN GOSUB 8000: IF ABCAL <> 0 THEN 4297 ELSE 4800 4295 IF PAR(17) = 0 OR (PAR(17) = 2 AND CUVE <= PAR(54)) THEN FOR WYU = 1 TO 2000: NEXT WYU: GOTO 4241 4296 IF REVOI <> 0 AND ALLE = 0 THEN BUT = 45: GOTO 625 4297 IF AIGUILLAGE = 3 THEN GOSUB 1948 4298 GOSUB 1200: PAS = 32: GOTO 675 4300 GOTO 4800 4350 FOR NE = 1 TO K1(1) + BLACOR 4355 IF K1(63 + NE) = 0 THEN 4370 4360 IF AIG3㐞 <> K1(63 + NE) THEN 4370 4365 IF NE = 1 THEN AIG3 = 0 ELSE AIG3 = K1(63 + NE - 1) 4367 GOTO 4380 4370 NEXT NE: IF AIG3 = K1(76) OR (AIG3 = K1(77) AND K1(76) = 0) THEN AIG3 = K1(63 + K1(1) + BLACOR): GOTO 4380 4375 IF AIG3 = K1(77) THEN AIG3 = K1(76) 4380 RETURN 4500 IF (AIG3 = 0) AND (LIMI = 1) THEN 4550 4502 IF (AIG3 AND 255) < LIMI THEN 4806 4504 IF (AIG3 AND 255) >= LIMI1 THEN 4830 4506 IF AIG3 < 256 THEN 4656 ELSE 4808 4550 IF CALIB THEN STANDA = K1(1): CUVE = PLACE(K1(63 + BLACOR + STANDA)):㐞 ETP% = 1: GOTO 4240 4554 IF COEF THEN CUVE = PLACE(1): K1(64) = 1: ETP% = 3: GOTO 4240 4556 IF BLACOR = 1 OR BLOBLG = 1 THEN CUVE = PLACE(1): ETP% = 2: GOTO 4240 ELSE 4800 4580 IF AIG3 < 256 THEN AIG2 = AIG3 4590 CUVE = PLACE(AIG3): ETP% = 4: GOTO 4240 4600 IF AIG3 THEN 4656 4604 IF CALIB <> 0 OR COEF <> 0 THEN AIG3 = K1(64): GOTO 4580 ELSE 4666 4610 AIG3 = 1: GOTO 4580 4615 IF CALIB THEN AIG3 = 1: GOTO 4580 4656 IF CALIB = 0 THEN 4666 4658 NE = 1: IF AIG3 = 0 THEN AIG3 = K1(64): GOTO 4580 4660 㐞IF AIG3 = K1(63 + NE) THEN 4670 4662 NE = NE + 1: IF NE <= K1(1) + BLACOR THEN 4660 4664 IF AIG3 <> K1(76) THEN 4668 4665 IF PL(K1(77)) = 254 OR (PL(K1(77)) = 255 AND PL(PLP(K1(77))) = 254) THEN AIG3 = K1(77): GOTO 4580 4666 AIG3 = 256 + 16: GOTO 4806 4668 IF AIG3 = K1(77) THEN 4666 4670 IF NE < K1(1) + BLACOR THEN AIG3 = K1(64 + NE): GOTO 4580 4672 IF PL(K1(76)) = 254 OR (PL(K1(76)) = 255 AND PL(PLP(K1(76))) = 254) THEN AIG3 = K1(76): GOTO 4580 4675 IF PL(K1(76)) = 0 AND PL(K1(77)) = 0 THEN 4666 EL㐞SE IF PL(K1(76)) = 0 THEN 4665 4800 AUTRE = 0: IF CALF = 0 OR ALLE = 1 THEN 4801 ELSE GOSUB 4110: IF AUTRE <> 0 AND AIGUILLAGE <> 4 THEN GOSUB 2193: LSET T1$ = MKS$(1): PUT #1, 41: CLOSE #1: AIG3 = 1: BUT = 45: GOTO 625 ELSE 4830 4801 IF REVOI <> 0 AND ALLE = 0 AND (AIG3 AND 255) = CALCONT THEN BUT = 45: GOTO 625 4802 IF AIG3 < 256 THEN 4600 4804 IF (AIG3 AND 255) <> AIG2 THEN 4812 4805 IF (AIG3 AND 255) = 48 THEN 4830 4806 IF (AIG3 AND 255) <> 48 THEN AIG3 = AIG3 + 1 4808 IF (AIG3 AND 255) < LIMI TH㐞EN 4806 4810 IF (AIG3 AND 255) >= LIMI1 THEN 4830 4812 AIG2 = AIG3 AND 255: IF PL(AIG2) = 0 OR PLACE(AIG2) = 0 OR PL(AIG2) = 254 THEN 4804 ELSE CUVE = PLACE(AIG2): ETP% = 4: GOTO 4240 4830 IF PAR(37) = 1 THEN COLOR 5, 0: LOCATE 25, 70: PRINT SPACE$(11); : LOCATE 24, 70: PRINT SPACE$(11); : COLOR 1, 2 4832 IF PAR(37) = 1 AND CALF <> 0 AND ETP% = 1 AND AUTRE = 0 THEN AJUMP = 0: RAJ = 0: GOSUB 2525: REPET = 0: GOSUB 1330: IF REPET > 1 THEN FOR WTY = 1 TO 3000: NEXT 4835 IF LIMI1 = 49 THEN AIG3 = AIG3 + 1 㐞 4838 KEY(4) OFF: GOSUB 2275: GOTO 7155 4845 NOEUD = 1: ENTET% = 0: GOSUB 2245: BLACOR = 0: SSBLK = 0: FOR TY% = 1 TO 48: P2(TY%) = 0: NEXT TY%: AIG2 = 0: AIG3 = 0: IF PAR(17) = 0 THEN FOR TY% = 12 TO 15: LOCATE TY%, 8: PRINT SPACE$(35): NEXT TY% 4846 IF PAR(37) > 1 OR (PAR(37) = 1 AND PAR(57) = 0) THEN GOSUB 4970: IF FINI THEN 675 ELSE 4980 4847 IF ATTEN THEN GOSUB 3980: PAR(50) = FTEMP: PAR(51) = FLOON: X = 50: GOSUB 2158: X = 51: GOSUB 2158: TEMPOK = 30 + (7 * (PAR(50) - 1)): GOTO 1870 ELSE IF PAR(40)㐞 <> 0 AND PAR(57) = 0 THEN 1870 ELSE IF PAR(57) THEN 4849 ELSE 2635 4849 IF PAR(17) THEN GOSUB 1200: PAS = 32: GOTO 675 ELSE BUT = 0: VER = 0: GOTO 690 4850 UNE = 1: GOSUB 4851: GOTO 4853 4851 GOSUB 2199: GET #1, UNE 4852 FOR IND = 1 TO 48: LE(IND) = CVI(MID$(FF$, (IND * 2) - 1, 2)): NEXT IND: CLOSE #1: RETURN 4853 DEMET = (PAR(22) AND 15360) / 1024: CALIB = 0 4854 METI = PAR(22) AND 31: METP = (PAR(22) AND 992) / 32 4855 LIMI = PAR(24) AND 255: LIMI1 = (PAR(24) AND 16128) / 256 4856 ADTER = 0: PASU㐞I = 1':IF METP=0 THEN 4861 4857 MENE = 0: IF PAR(40) THEN GOSUB 2162: GET #1, (PAR(19 + (3 * (PAR(37)))) AND 992) / 32: NMLI$ = ST$ ELSE 4859 4858 MENE = VAL(MID$(NMLI$, (PAR(40) * 3) - 1, 2)): CLOSE #1 4859 IF MENE AND PAR(37) < 4 THEN PASUI = 0 ELSE VAR = 1 4860 IF PAR(34) = 64 THEN PASUI = 1: VAR = 1: GOTO 4865 4861 LIMI2 = (PAR(21 + (3 * PAR(37))) AND 16128) / 256':IF (PAR(20)+(3*PAR(37))) AND 2^13 THEN ADTER=1:GOTO 4865 4862 IF LIMI2 <> 49 OR (PAR(52) + PAR(37)) = O2 THEN PASUI = 1: VAR = 0: GOTO㐞  4865 4863 IF METP = 0 THEN VAR = 1 4865 PTREM = PAR(23) AND 15: UNE = 1: GOSUB 2410 4870 GOSUB 2170: GOSUB 2210: GOSUB 2480 4871 GOSUB 2201: GET #1, METI: QCB! = CVS(QL1$): TOLB! = CVS(QL2$): QCH! = CVS(QH1$): TOLH! = CVS(QH2$): CLOSE #1 4872 IF DEMET = 1 OR METP = 0 THEN GOSUB 3995: TEMPOK = 30 + (7 * (PAR(50) - 1)) 4873 IF MENE <> 0 AND PAR(57) = 0 THEN GOSUB 3980: IF FTEMP <> PAR(50) OR FLOON <> PAR(51) THEN ATTEN = 1 4874 GOSUB 1510: IF CHANGE = 1 OR CHANGE = 3 THEN CHANGE = 0 4875 OPEN "r", #3㐞 , "descpai", 128: FIELD #3, 128 AS CHAMP$ 4880 GET #3, 1: PARPAT$ = CHAMP$ 4895 GOSUB 2202 4905 FOR IND = 1 TO 48: IF PLACE(IND) = 0 THEN 4925 4906 IF IND = 1 AND (K1(6) > 2 OR BLACOR = 1 OR K1(33) <> 0) THEN PL(1) = 254 4910 TES = PL(IND) 4915 IF TES > 250 OR TES = 0 THEN 4925 4917 BV% = ASC(MID$(PARPAT$, TES, 1)): GET #1, BV%: PAT$(IND) = NM$ 4925 NEXT IND: CLOSE #1: CLOSE #3: BUT = 10: DEV% = 52 4926 IF METP THEN MEP = METP ELSE MEP = METI 4927 IF PAR(17) THEN ADTER = 1 4928 IF METP THEN BUT =㐞 15 4929 GOSUB 2193: GET #1, 46: RBL = CVS(T1$): CLOSE #1 4930 SAUTCC = 1: IF AIG3 = 0 AND LIMI = 1 AND ((PLM(49) AND 2 ^ (DEMET - 1)) <> 0 OR (PLM(49) <> 0 AND METP = 0)) THEN GOSUB 2193: GET #1, 39: ALLE = CVS(T1$): CLOSE #1 4931 CALIB = 0: COEF = 0: REVOI = 0: DAC = 0: REFU = 0: GOSUB 1981: IF ((AIG3 > 0 AND LIMI = 1) AND ((PLM(49) AND 2 ^ (DEMET - 1)) <> 0) OR (PLM(49) <> 0 AND METP = 0)) OR ALLE <> 0 THEN GOSUB 4175: DAC = 1: DERSTD = K1(63 + K1(1) + BLACOR) 4933 VOY = 0: TOK = 0: IF ((AIG3 AND 255㐞 ) >= LIMI1 OR (AIG3 AND 255) = 49) AND K1(6) < 3 AND LIMI = 1 THEN AFFICH = (2 ^ 11) - 1: BUTEB = 10: SAUTCC = 0: GOSUB 1715: GOSUB 593: GOTO 7167 4934 TB = 0: GOSUB 1190: IF TE$ = "0" OR TE$ = "" OR TE$ = CHR$(0) THEN 4935 ELSE IF TE$ = "2" OR MID$(R$, 8, 2) = "00" THEN GOSUB 4950: GOTO 4934 ELSE VOY = VOY + 1: GOSUB 3990: IF TOK THEN GOSUB 3982 ELSE IF TB = 0 THEN GOSUB 4950: GOTO 4934 4935 KEY(1) OFF: BUTEH = 1: GOSUB 4225: GOSUB 592: ON K1(6) GOTO 5000, 9020 4950 FOR WYU = 1 TO 4000: NEXT WYU: RETURN㐞 4970 FINI = 0: IF PAR(17) = 0 THEN 4975 4973 IF PAR(17) = 4 OR (PAR(17) = 2 AND PAR(54) <= DERRES) THEN PAR(54) = 1: FINI = 1: PAS = 32: CHANGE = 0: GOSUB 2280: GOSUB 1175 4975 RETURN 4980 GOSUB 592: IF BUT = 20 THEN GOSUB 34: KEY(8) ON: GOSUB 1800: GOTO 4850 4982 METI = PAR(22) AND 31: MEMOR$ = PA$: IF METI = 0 THEN K1(6) = 0: GOTO 4985 4983 GOSUB 2198 4984 GET #1, (METI - 1) * 100 + 6: K1(6) = CVS(A2$): CLOSE #1 4985 IF K1(6) = 0 THEN GOSUB 34: MA% = 1: GOSUB 600: GOTO 2635 4986 IF K1(6) = 12 TH㐞 EN 4989 ELSE ON K1(6) GOTO 4987, 4987, 4989 4987 PA$ = "calc1cp": GOTO 4995 4989 PA$ = "calc2cp" 4995 IF PA$ = MEMOR$ THEN AFTEM = 0: GOTO 4850 ELSE BUT = 20 4996 COLOR 1, 2: LOCATE 24, 30: PRINT SPACE$(25): WFREE = FRE(""): CHAIN PA$ 5000 GOTO 5780 5125 PR = LE(1): DE = LE(2) 5130 IF K1(30) = 0 THEN PR = 0 5140 RETURN 5150 CUVE = PLACE(AIG2): IF PL(AIG2) = 0 THEN 5195 5160 GOSUB 5570 5165 J = PR: GOSUB 5490 5170 J = DE: GOSUB 5490 5175 GOSUB 5325 5180 IF P3!(AIG2) * SGN(K1(39)) < K1(39) OR (P㐞 2(AIG2) AND (2 ^ 3 + 2 ^ 6 + 2 ^ 8 + 2 ^ 14)) <> 0 THEN 5190 5185 P2(AIG2) = P2(AIG2) OR 2 ^ 10 5190 IF DILU THEN P3!(AIG2) = P3!(AIG2) * ((K1(58) + K1(4)) / K1(58)) 5195 RETURN 5200 IF K1(6) = 1 THEN J = PR: CUVE = PLACE(1): GOSUB 2500: GOSUB 5485: J = DE: GOSUB 2500: GOSUB 5485: GOTO 5210 5205 FOR BV% = PR TO DE: J = BV%: CUVE = PLACE(1): GOSUB 2500: GOSUB 5485: NEXT BV% 5210 GOSUB 1482: RETURN 5325 WB1 = C1!: WB2 = O1! 5326 IF K1(33) <> 0 AND BLACOR = 1 THEN WB2 = 0 5330 IF WB1 = 0 THEN P3!(AIG2㐞 ) = 0 ELSE P3!(AIG2) = (S!(DE) - WBLACORF - (S!(PR) - WBLACORI) * K1(40) - WB2) / WB1 5332 IF AIG2 < 17 OR DILU <> 0 OR PL(AIG2) > 251 OR PL(AIG2) = (PAR(58) AND 255) OR PL(AIG2) = (PAR(58) AND 32512) / 256 OR (P2(AIG2) AND (2 ^ 3 + 2 ^ 6 + 2 ^ 8 + 2 ^ 10 + 2 ^ 14)) <> 0 THEN 5335 5333 IF (P3!(AIG2) < K1(34) OR P3!(AIG2) > K1(100)) AND (K1(34) <> 0 OR K1(100) <> 0) THEN P2(AIG2) = P2(AIG2) OR 2 ^ 5 5335 P2(AIG2) = P2(AIG2) OR 2 5340 RETURN 5350 RAJ = 1: KI% = 0: IF AIG2 = 1 AND K1(33) <> 0 THEN RETURN 㐞 5355 GOSUB 2320: IF P2(AIG2) AND (2 ^ 3 + 2 ^ 14) THEN RETURN ELSE IF KI% THEN 5362 5360 IF AIG3 < 17 AND (REFU AND (REFU AND 2 ^ (NB - 1)) = 0) THEN 5390 ELSE KI% = 1 5361 IF (P2(1) AND 2 ^ 5) <> 0 AND AIG2 = 1 THEN LPRINT TAB(23); " RBL"; : GOTO 5366 5362 IF (P2(AIG2) AND (2 ^ 6 + 2 ^ 8 + 2 ^ 10)) <> 0 THEN LPRINT TAB(23); " "; : GOTO 5366 5363 GOSUB 3340: IF P3!(AIG2) < VAL(NE1$) AND KI% THEN LPRINT TAB(27); "<"; ELSE IF P3!(AIG2) > VAL(NE2$) AND KI% THEN LPRINT TAB(27); ">"; ELSE LPRINT TAB(27); 㐞 " "; 5364 GOSUB 2400: IF RBL THEN 5365 ELSE IF (P2(AIG2) AND 2 ^ 5) <> 0 AND AIG2 > 16 THEN LPRINT " r"; 5365 IF ((PL(AIG2) = (PAR(58) AND 255) OR PL(AIG2) = 253) AND (P3!(AIG2) < QCB! - TOLB! OR P3!(AIG2) > QCB! + TOLB!)) OR ((PL(AIG2) = (PAR(58) AND 32512) / 256 OR PL(AIG2) = 252) AND (P3!(AIG2) < QCH! - TOLH! OR P3!(AIG2) > QCH! + TOLH!)) THEN _ LPRINT " *"; 5366 RESTORE 5400 5367 FOR TY% = 10 TO 6 STEP -1 5370 READ MA$ 5375 IF (P2(AIG2) AND 2 ^ TY%) = 0 THEN 5385 5380 IF TY% <> 7 OR (TY% = 7 AN㐞 D RBL = 0) THEN LPRINT MA$; 5385 NEXT TY%: IF DILU <> 0 AND RBL = 0 THEN LPRINT " DIL"; 5390 LPRINT 5395 IF (P2(AIG2) AND (2 ^ 6 + 2 ^ 7 + 2 ^ 8 + 2 ^ 10)) <> 0 OR ((P2(1) AND 2 ^ 5) <> 0 AND AIG2 = 1) THEN NONL$ = NONL$ + STR$(AIG2) + "." 5397 RETURN 5400 DATA " OR",," FAL"," SIC"," IAL" 5485 IF S!(J) * SGN(K1(35)) > K1(35) THEN P2(P64(CUVE)) = P2(P64(CUVE)) OR 2 ^ 5: RBL = 1 5487 RETURN 5490 GOSUB 2500: IF J = PR THEN WAB = S!(J) ELSE IF J = DE THEN WDIFFER = WAB - S!(J) 5500 GOSUB 2375: IF K1(6 㐞 + NB) <> 0 OR K1(63 + NB) <> 1 OR J = 0 OR ABS(K1(35)) = 4 OR PL(P64(CUVE)) <> 254 OR P64(CUVE) = K1(76) OR P64(CUVE) = K1(77) THEN 5515 5505 GOSUB 5485 5515 IF J <> PR OR ABS(K1(36)) = 4 OR NB = 1 THEN 5530 5520 IF S!(J) * SGN(K1(36)) > K1(36) THEN P2(P64(CUVE)) = P2(P64(CUVE)) OR 2 ^ 6 5530 IF J <> DE OR ABS(K1(37)) = 4 OR NB = 1 THEN 5540 5535 IF S!(J) * SGN(K1(37)) > K1(37) THEN P2(P64(CUVE)) = P2(P64(CUVE)) OR 2 ^ 8 5540 RETURN 5550 IF LIMI > 1 THEN RETURN ELSE IF ABS(K1(38)) = 4 THEN WSCH = 0: 㐞 RETURN ELSE J = 1: CUVE = PLACE(K1(64)): GOSUB 2500 5555 WSCH = S!(J) 5560 RETURN 5570 IF ABS(K1(38)) = 4 THEN 5580 ELSE J = 1: GOSUB 2500 5575 IF (S!(J) - WSCH) * SGN(K1(38)) > K1(38) THEN P2(P64(CUVE)) = P2(P64(CUVE)) OR 2 ^ 7 5580 RETURN 5590 CUVE = PLACE(K1(63 + NB)) 5595 J = PR: GOSUB 5490: WAB = S!(J): GOSUB 5570 5600 J = DE: GOSUB 5490: WCD = S!(J): WDIFFER = WCD - WAB 5605 RETURN 5615 WG9 = 0: WG8 = 0: WG7 = 0: WG6 = 0: WG5 = 0 5620 FOR NB = 1 + BLACOR TO K1(1) + BLACOR 5625 GOSUB 5745 㐞 5630 NEXT NB 5635 WG8 = WG8 / WG9: WG7 = WG7 / WG9: WG9 = 0 5640 FOR NB = 1 + BLACOR TO K1(1) + BLACOR 5645 CUVE = PLACE(K1(63 + NB)) 5650 IF (REFU AND 2 ^ (NB - 1)) = 0 THEN 5680 5655 J = PR: GOSUB 2500 5660 J = DE: GOSUB 2500 5665 IF BLACOR THEN WG6 = WG6 + ((S!(DE) - WBLACORF - (S!(PR) - WBLACORI) * K1(40)) - WG8) * (K1(6 + NB) - WG7) ELSE WG6 = WG6 + (S!(DE) - S!(PR) - WG8) * (K1(6 + NB) - WG7) 5670 WG5 = WG5 + (K1(6 + NB) - WG7) ^ 2 5675 WG9 = WG9 + (K1(6 + NB) - WG7) ^ 2 5680 NEXT NB 5685 W㐞 B1 = WG6 / WG5 5690 WB2 = WG8 - WB1 * WG7 5695 RETURN 5700 GOSUB 5570: J = PR 5715 WHILE (J <= DE) 5720 GOSUB 5490: J = J + 1 5730 WEND 5735 RETURN 5745 CUVE = PLACE(K1(63 + NB)) 5750 IF (REFU AND 2 ^ (NB - 1)) = 0 THEN 5770 5755 J = PR: GOSUB 2500 5760 J = DE: GOSUB 2500 5765 WG9 = WG9 + 1: WG7 = WG7 + K1(6 + NB) 5766 IF BLACOR THEN WG8 = WG8 + (S!(DE) - WBLACORF - (S!(PR) - WBLACORI) * K1(40)) ELSE WG8 = WG8 + S!(DE) - S!(PR) 5770 RETURN 5771 GOSUB 5550: IF ABS(K1(35)) <> 4 THEN GOSUB 5200 㐞 5772 IF BLACOR = 0 THEN 5775 ELSE IF RBL = 1 AND CALIB = 0 AND COEF = 0 THEN WBLACORI = K1(91): WBLACORF = K1(92): GOTO 5774 5773 CUVE = PLACE(K1(64)): J = PR: GOSUB 2500: J = DE: GOSUB 2500: WBLACORI = S!(PR): WBLACORF = S!(DE) 5774 GOSUB 1483 5775 GOSUB 2193: LSET T1$ = MKS$(WSCH): PUT #1, 25: CLOSE #1 5776 IF CALIB THEN 5778 ELSE GOSUB 6130: ENTET% = 1: GOSUB 2245: LPRINT : AIG2B = AIG2: AIG2 = 1: PL(1) = 254: CUVE = PLACE(1): GOSUB 3470: IF COEF THEN GOSUB 6120 ELSE GOSUB 6027: LPRINT : IF RBL THEN㐞 NONL$ = STR$(1) + ".": IF BLACOR THEN GOSUB _ 6070 5777 AIG2 = AIG2B: CUVE = PLACE(AIG2) 5778 RETURN 5780 GOSUB 8100 5786 IF LIMI = 1 AND ((PLM(49) AND 2 ^ (DEMET - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0)) THEN CALIB = 1 5787 IF PL(1) = 0 THEN CALIB = 0 5790 GOSUB 2480 5795 IF ABS(K1(38)) <> 4 OR ABS(K1(35)) <> 4 THEN BLOBLG = 1 5800 IF (BLACOR = 1 OR BLOBLG = 1) AND ((AIG3 <> 0) OR (LIMI > 1)) THEN GOSUB 2193: GET #1, 25: WSCH = CVS(T1$): GET #1, 44: WBLACORI = CVS(T1$): GET #1, 45: WBLACORF = C㐞 VS(T1$): CLOSE #1 5825 IF LIMI = 1 AND K1(33) <> 0 THEN COEF = 1: CALIB = 0 5830 IF K1(64) <> 1 AND ((PLM(49) AND 2 ^ (DEMET - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0)) THEN SSBLK = 1: CALIB = 1 ELSE SSBLK = 0 5831 IF LIMI > 1 THEN CALIB = 0 5832 IF (LIMI > 1 OR AIG3 <> 0) AND K1(33) <> 0 THEN 5833 ELSE 5834 5833 C1! = 1 / K1(33): O1! = K1(79): GOTO 5841 5834 IF AIG3 <> 0 OR ABAND <> 0 THEN 5836 5835 IF CALIB <> 0 OR COEF <> 0 THEN 5841 5836 IF CALIB <> 0 THEN 5838 5837 C1! = K1(78): O1! = K1(79) 5㐞 838 FOR IND = 1 TO K1(1) + BLACOR 5839 IF ((PLM(49) AND 2 ^ (DEMET - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0)) AND LIMI = 1 THEN WCOF(IND) = WCC(IND) ELSE WCOF(IND) = K1(IND + 42) 5840 NEXT IND 5841 GOSUB 5125: GOTO 7000 5887 GOSUB 5888: GOTO 5900 'coef 5888 SAUTCC = 1: REFU = 1: IF BLACOR = 1 OR BLOBLG = 1 THEN K1(64) = 1: GOSUB 5771 5890 C1! = 1 / K1(33) 5895 NB = 1: RETURN 5900 IF COEF THEN K1(63 + NB) = 1 ELSE K1(63 + NB) = 1 + BLACOR 5905 GOSUB 5745: GOSUB 5550: O1! = S!(DE) - S!(PR): GOSUB 21㐞 98 5910 K1(79) = O1!: LSET A2$ = MKS$(O1!): PUT #1, (METI - 1) * 100 + 79: K1(80) = WSCH: LSET A2$ = MKS$(WSCH): PUT #1, (METI - 1) * 100 + 80 5915 CLOSE #1: RETURN 5920 CALF = 0: LOCATE 24, 23: PRINT SPACE$(11); "CALIBRATION"; SPACE$(12) 5940 GOSUB 592: GOSUB 46: O1! = 0: C1! = 0: K1(19) = 0 5945 IF BLACOR = 1 OR BLOBLG = 1 THEN GOSUB 5771 5960 VALAB = 0: REFA = 0: IDEM = 0: WTY = 0: BOV% = 0: FOR NB = 1 TO K1(1) + BLACOR 5965 IF K1(6) = 2 THEN CUVE = PLACE(K1(63 + NB)): GOSUB 5700 ELSE GOSUB 5590 㐞 5967 IF NB = 1 AND BLACOR <> 0 THEN 5975 5970 IF ((P2(P64(CUVE)) AND (2 ^ 3 + 2 ^ 5 + 2 ^ 6 + 2 ^ 8 + 2 ^ 10 + 2 ^ 14)) <> 0) OR (ABS(WDIFFER) < .001 AND K1(6 + NB) <> 0) THEN VALAB = VALAB + 1: GOTO 5975 ELSE REFA = REFA OR 2 ^ (NB - 1) 5972 BOV% = BOV% + 1: IF BOV% = 1 THEN 5973 ELSE IF K1(6 + NB) <> WTY THEN IDEM = IDEM + 1 5973 WTY = K1(6 + NB) 5975 NEXT NB: IF ALLE = 0 THEN REFU = REFU OR REFA 5977 IF RBL = 1 OR (P2(1) AND (2 ^ 3 + 2 ^ 14)) <> 0 OR (K1(1) - VALAB) < 3 OR IDEM < 1 THEN COLOR 1, 2: 㐞 GOSUB 2000: LPRINT : LPRINT "IMPOSSIBLE CALIBRATION": LPRINT : CALF = 1: GOSUB 6034: GOSUB 12000: LPRINT : GOSUB 3320: GOSUB 2019: NONL$ = "" _ ELSE 5980 5978 AJUMP = 0: RAJ = 0: GOSUB 2525: IF RIGHT$(DATHI$, 2) = "00" THEN LPRINT "NO CALIBRATION IN MEMORY": GOSUB 1998 5979 GOSUB 34: GOSUB 7180: GOSUB 1310: RETURN 5980 ON K1(6) GOSUB 5615, 9030 5985 C1! = WB1: O1! = WB2 5987 GOSUB 6030: GOSUB 4140 5990 GOSUB 594: FOR NB = 1 + BLACOR TO K1(1) + BLACOR: GOSUB 6000 5992 NEXT NB: IF REVOI THEN GOSUB 42㐞 12 5995 GOSUB 1310: RETURN 6000 AIG2 = K1(63 + NB): DERSTD = AIG2: CUVE = PLACE(AIG2): WCONC = K1(6 + NB): ON K1(6) GOSUB 5150, 9240 6005 IF WCONC = 0 AND K1(56) <> 0 AND P3!(AIG2) > K1(56) THEN P2(AIG2) = P2(AIG2) AND 2 ^ 13: REVOI = 1: RETURN 6010 IF K1(56) = 0 AND K1(57) = 0 THEN REVOI = 1: RETURN 6016 IF WCONC = 0 THEN 6017 ELSE IF ((P3!(AIG2) < WCONC * (1 - (K1(57) / 100))) OR (P3!(AIG2) > WCONC * (1 + (K1(57) / 100)))) AND K1(57) <> 0 THEN P2(AIG2) = P2(AIG2) AND 2 ^ 13: REVOI = 1: RETURN 6017 I㐞 F (P2(AIG2) AND (2 ^ 5 + 2 ^ 7 + 2 ^ 8 + 2 ^ 9 + 2 ^ 10)) <> 0 THEN REVOI = 1 6018 RETURN 6024 LPRINT : IF K1(33) <> 0 THEN LPRINT "Calibration Coefficient : "; K1(33) ELSE 6029 6025 IF COEF THEN CUVE = PLACE(K1(64)): GOTO 6027 6026 CUVE = PLACE(K1(64 + BLACOR)): IF K1(7 + BLACOR) THEN RETURN 6027 J = PR: GOSUB 594: GOSUB 2500: J = DE: GOSUB 2500: WDIFFER = S!(DE) - S!(PR): IF P2(1) AND 32 THEN GOSUB 6125: RETURN 6028 LPRINT "Blank": GOSUB 6060: LPRINT : RETURN 6029 LPRINT "CALIBRATION DATE : "; DE㐞 RDA$: LPRINT "Calibration Factor : "; USING "#####.###"; (1 / C1!): LPRINT "Calculated Blank : "; USING "#####.###"; (O1! / C1!): RETURN 6030 ENTET% = 0: GOSUB 2245: LPRINT TAB(10); NT$; " CALIBRATION" 6032 LPRINT "DATE : "; DERDA$: LPRINT : IF ABAND THEN 6045 6034 AIG2B = AIG2: FOR QW = 1 TO K1(1) + BLACOR: IF BLACOR AND QW = 1 THEN 6036 ELSE IF ALLE <> 0 AND (REFU AND 2 ^ (QW - 1)) = 0 THEN 6043 6036 STAN = K1(63 + QW): IF STAN = 0 THEN 6043 6037 AIG2 = STAN: CUVE = PLACE(STAN): J = PR: GOSUB 594:㐞 GOSUB 2500: J = DE: GOSUB 2500: WDIFFER = S!(DE) - S!(PR): IF (QW = 1) AND (K1(6 + QW) = 0) AND (K1(63 + QW) = 1) THEN LPRINT "C"; STAN; " Blank"; ELSE LPRINT "C"; STAN; " Std"; STR$(K1(6 + _ QW)): GOTO 6039 6038 GOSUB 6055: IF (P2(STAN) AND (2 ^ 5 + 2 ^ 3 + 2 ^ 14)) = 0 THEN 6040 ELSE GOSUB 6125: IF BLACOR = 1 OR BLOBLG = 1 THEN NONL$ = STR$(1) + ".": GOTO 6042 ELSE 6042 6039 IF (K1(6 + QW) <> 0 AND ABS(WDIFFER) < .001) OR (P2(STAN) AND (2 ^ 3 + 2 ^ 6 + 2 ^ 8 + 2 ^ 14)) <> 0 THEN LPRINT "Unusable Sta㐞 ndard": GOTO 6042 6040 GOSUB 6060 6041 IF K1(6) = 2 THEN GOSUB 10790 ELSE IF (P2(STAN) AND 2 ^ 13) <> 0 THEN LPRINT "OUT OF TOLERANCE" 6042 FOR BV% = 1 TO 19: LPRINT " -"; : NEXT BV%: LPRINT 6043 NEXT QW: AIG2 = AIG2B: IF CALF THEN RETURN 6045 LPRINT : LPRINT "CALIBRATION CURVE :": LPRINT "Slope : "; 6047 LPRINT USING "###.#####"; C1!: LPRINT "Intercept : "; 6049 LPRINT USING "###.#####"; O1!: LPRINT : RETURN 6055 IF (P2(STAN) AND (2 ^ 3 + 2 ^ 14)) = 0 THEN LPRINT ELSE LPRINT TAB(23); "OVERFLOW㐞 " 6057 RETURN 6060 IF K1(6) = 1 AND K1(30) = 0 THEN LPRINT "Abs : "; USING "#####.####"; S!(DE): RETURN 6065 LPRINT "I.Abs : "; USING "#####.####"; S!(PR): LPRINT "F.Abs : "; USING "#####.####"; S!(DE); : LPRINT TAB(23); "diff : "; USING "#####.####"; WDIFFER: RETURN 6070 LPRINT : LPRINT "Last Validated Blank :": S!(PR) = WBLACORI: S!(DE) = WBLACORF: WDIFFER = S!(DE) - S!(PR): GOSUB 6060: RETURN 6117 MOI = VAL(LEFT$(DATEF$, 2)) * 100: JOU = VAL(MID$(DATEF$, 4, 2)): ANN$ = RIGHT$(DATEF$, 2): NOUDA$ = M㐞 KI$(MOI + JOU) 6118 GOSUB 2196: GET #1, 33: DOIT$ = DH$: MID$(DOIT$, 1 + (METI - 1) * 4, 4) = NOUDA$ + ANN$: LSET DH$ = DOIT$: PUT #1, 33: CLOSE #1: RETURN 6120 IF RBL THEN NONL$ = STR$(1) + "." 6122 RETURN 6125 LPRINT "Unusable Blank": RETURN 6130 GOSUB 2000: GOSUB 6024 6145 RETURN 6150 IF ENTET% = 0 THEN GOSUB 6130: ENTET% = 1: GOSUB 2245 6155 IF AIG2 > DERSTD AND CALIB = 1 AND ABCAL = 0 AND SAUTCC = 1 THEN DAC = 1: IF PAR(17) = 0 THEN GOSUB 1549: LOCATE 13, 10: PRINT Y$: SAUTCC = 0 6157 IF (METP㐞 AND (PLPM(AIG2) AND 2 ^ (DEMET - 1)) <> 0) OR (METP = 0 AND PLP(AIG2) = 255) THEN DILU = 1: P2(AIG2) = P2(AIG2) OR 2 ^ 12 ELSE DILU = 0 6160 GOSUB 594: ON K1(6) GOSUB 5150, 9240 6170 GOSUB 5350: GOSUB 3470: RETURN 7000 IF REVOI = 1 AND ALLE = 0 AND AIG3 > 0 AND AIG3 < DERSTD THEN 7006 ELSE REVOI = 0 7006 IF ((PLM(49) AND 2 ^ (DEMET - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0)) AND ABAND = 0 THEN DERDA$ = DATEF$ ELSE DERDA$ = DATHI$ 7007 GOSUB 2540 7008 IF ABAND THEN CALIB = 0 7009 IF CHCAL THEN CHCAL =㐞 0: GOSUB 7015: AIG3 = 0: AIG2 = 0 7010 GOTO 4230 7015 GOSUB 2193: LSET T1$ = MKS$(0): PUT #1, 40: CLOSE #1: RETURN 7155 IF CALF <> 0 THEN 7172 ELSE IF ((PLM(49) AND 2 ^ (DEMET - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0)) AND LIMI = 1 AND PAR(17) AND REFU = 0 THEN 7166 7160 GOSUB 2019 7165 IF ((PLM(49) AND 2 ^ (DEMET - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0)) AND ALLE = 0 AND LIMI = 1 THEN GOSUB 4010: GOSUB 6117 7166 IF LIMI1 = 49 AND ENTET% = 1 THEN GOSUB 7180 7167 RELU = 0: IF ALLE <> 0 AND ABAND = 0㐞 THEN GOSUB 4215 ELSE 7172 7168 IF AIGUILLAGE = 1 THEN 4280 ELSE IF CHOIX = 2 THEN GOSUB 4010: GOSUB 6117 7172 IF BUTEB > 8 THEN GOSUB 46 7173 GOSUB 592: CHCAL = 0: GOTO 1875 7175 GOTO 4845 7180 FOR TY% = 1 TO 7: LPRINT : NEXT TY%: RETURN 8000 WPERTE = 0: DERRES = CUVE: ON K1(6) GOTO 8010, 11090 8010 ON ETP% GOTO 5920, 5771, 5887, 6150 8100 MA% = 1: SUP% = F9%: GOSUB 600 8110 AIG1 = K1(6): DEV% = 52: RET% = 0: RETURN 8240 COLOR 5, 0: VIEW PRINT 1 TO 21: CLS : VIEW PRINT 8250 COLOR 1, 2: VIEW PRIN㐞 T 3 TO 19: CLS : VIEW PRINT 8260 VIEW PRINT 22 TO 25: CLS : VIEW PRINT 8270 COLOR 5, 0: L = 23: C = 1: GOSUB 8350: C = 70: GOSUB 8350 8280 L = 24: C = 1: GOSUB 8350: C = 70: GOSUB 8350 8290 L = 25: C = 1: GOSUB 8350: C = 70: GOSUB 8350: COLOR 1, 2 8310 LOCATE 23, 32: PRINT "Instrument Status TC :" 8320 LOCATE 23, 64: PRINT USING "##.#"; VAL(TEMPER$) 8330 RETURN 8350 LOCATE L, C: PRINT SPACE$(11); : RETURN 8410 SCREEN 2: RETURN 9000 'substrat initial rate 9020 GOTO 5780 9030 FOR NB = 1 T㐞 O K1(1) 9040 GOSUB 9620 9050 NEXT NB 9060 WM9 = 0: WM8 = 0: WM7 = 0: WM6 = 0: WM5 = 0 9070 FOR IND = 1 TO K1(1): IF (REFU AND 2 ^ (IND - 1)) = 0 THEN 9090 9080 WM9 = WM9 + 1: WM8 = WM8 + WCOF(IND): WM7 = WM7 + K1(6 + IND) 9090 NEXT IND 9100 WM8 = WM8 / WM9: WM7 = WM7 / WM9: WM9 = 0 9110 FOR IND = 1 TO K1(1): IF (REFU AND 2 ^ (IND - 1)) = 0 THEN 9140 9120 WM6 = WM6 + (WCOF(IND) - WM8) * (K1(6 + IND) - WM7) 9130 WM5 = WM5 + (K1(6 + IND) - WM7) ^ 2 9140 NEXT IND 9150 WB1 = WM6 / WM5 9160 WB2 = WM8㐞 - (WB1 * WM7) 9170 RETURN 9240 IF PL(AIG2) = 0 THEN RETURN 9260 GOSUB 5570 9270 APPEL = 1: GOSUB 9500 9380 WJOINT = WM6 / WM5 9400 WB1 = C1!: WB2 = O1! 9420 IF WB1 = 0 THEN P3!(AIG2) = 0 ELSE P3!(AIG2) = (WJOINT - WB2) / WB1 9430 GOSUB 5332: GOTO 5180 9500 WM9 = 0: WM8 = 0: WM7 = 0: WM6 = 0: WM5 = 0 9510 FOR J = PR TO DE 9520 ON APPEL GOSUB 9780, 2500 9530 WM9 = WM9 + 1: WM8 = WM8 + S!(J): WM7 = WM7 + J 9540 NEXT J 9550 WM8 = WM8 / WM9: WM7 = WM7 / WM9: WM9 = 0 9560 FOR J = PR TO DE 9570 GO㐞 SUB 2500 9580 WM6 = WM6 + (S!(J) - WM8) * (J - WM7) 9590 WM5 = WM5 + (J - WM7) ^ 2 9600 NEXT J: RETURN 9620 CUVE = PLACE(K1(63 + NB)) 9630 IF (REFU AND 2 ^ (NB - 1)) = 0 THEN 9760 9640 APPEL = 2: GOSUB 9500 9750 WCOF(NB) = WM6 / WM5 9760 RETURN 9780 GOSUB 2500: IF J = PR THEN WAB = S!(J) ELSE IF J = DE THEN WCD = S!(J): WDIFFER = WCD - WAB 9800 GOTO 5500 9980 CUVE = PLACE(K1(63 + NB)) 9990 J = PR: GOSUB 9780: GOSUB 5570 10000 J = DE: GOSUB 9780 10010 RETURN 10080 CUVE = PLACE(K1(63 + NB)) 10㐞 090 IF P2(K1(63 + NB)) <> 0 THEN 10130 10100 J = PR: GOSUB 2500 10110 J = DE: GOSUB 2500 10120 WG9 = WG9 + 1: WG8 = WG8 + S!(DE) - S!(PR): WG7 = WG7 + K1(6 + NB) 10130 RETURN 10360 GOSUB 5888 10390 K1(63 + NB) = 1 10400 GOSUB 9620: GOSUB 5771: GOSUB 2198 10410 O1! = WCOF(1): K1(79) = O1!: LSET A2$ = MKS$(O1!): PUT #1, (METI - 1) * 100 + 79: K1(80) = WSCH: LSET A2$ = MKS$(WSCH): PUT #1, (METI - 1) * 100 + 80 10420 CLOSE #1: RETURN 10790 IF CALF THEN 10800 ELSE INC = INT((K1(31) - K1(30)) / 690) + 1㐞 : LPRINT "Delta Abs/15 s : "; USING "###.####"; WCOF(QW) / INC: IF (P2(STAN) AND 2 ^ 13) <> 0 THEN LPRINT "OUT OF TOLERANCE" 10800 RETURN 11090 ON ETP% GOTO 5920, 5771, 10360, 6150 12000 FOR BOUC = 1 TO K1(1) + BLACOR 12005 IF BOUC = 1 AND (BLACOR <> 0 OR BLOBLG <> 0) THEN 12020 12010 IF (REFU AND 2 ^ (BOUC - 1)) = 0 THEN NONL$ = NONL$ + STR$(K1(63 + BOUC)) + "." 12020 NEXT BOUC: RETURN 15000 IMPRESULT = IMPRESULT + 1: IF IMPRESULT = 1 THEN AIGUILLAGE = 1: LIGNE = 7 15010 RETURN 20000 OPEN "r",#4,"㐞 SIMABS",192:FIELD#4,192 AS LECUV$:RETURN 30000 OPEN "r", #1, "NAMETH", 105 30010 FIELD #1, 6 AS A1$, 6 AS D$, 32 AS A2$, 32 AS A3$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$ 30020 FOR I = 1 TO 32 30030 GET #1, I 30040 B$(I) = A1$: MTT$(I) = A3$ 30050 NEXT I: CLOSE #1: RETURN 510 FOR J = PR TO DE 9520 ON APPEL GOSUB 9780, 2500 9530 WM9 = WM9 + 1: WM8 = WM8 + S!(J): WM7 = WM7 + J 9540 NEXT J 9550 WM8 = WM8 / WM9: WM7 = WM7 / WM9: WM9 = 0 9560 FOR J = PR TO DE 9570 GO㐞 1 '************************************************************ 2 ' CALC2CP 3 ' avec entiers 4 ' nouvelle gestion call cla et absorb 5 ' anast+calculs enzyme & regression 6 ' version 05/12/1988 7 '************************************************************ 15 DEFINT A-D, F-J, L-V, X-Z 17 DIM L(5), C(5) 19 DIM PAT$(48), K1(100), PL(50), PLM(50), PLP(50), PLPM(50), PZ(48)',CC(12) 20 DIM P2(48), S!(48), P3!(48), FLAG(48), J㐞 J(48), LG(48), PENTE!(48) 21 'DIM COF(48),X(48),Y(48) 25 DIM P64(64), LE(48), PLACE(48), PAR(60), B$(32), MTT$(32) 30 COMMON STATUS, METH, P64(), LE(), PLACE(), O1!, C1!, O2, C2, AIG1, AIG3, PAR(), M, M1, RE, VER, BUT, PAS, PA$, LIGNE, METP, DEMET, LIMI, NONL$, TEMPER$, DATEF$, ATTEN, MEP 31 GOSUB 30000: F9% = 2 ^ 8: MA% = 1: SUP% = F9%: GOSUB 600 32 SCREEN 0: DEV% = 52: GOSUB 602: GOSUB 8240: GOSUB 1290: IF PAR(17) THEN LOCATE 3, 2, 0: RETOUR = 1: ABORT = 1: GOSUB 2205: GET #1, 1: ERE% = CVI(LEFT$(E$,㐞 2)): CLOSE #1: GOSUB 1320: GOSUB 1350: RETOUR = 2 ELSE GOSUB 45 33 KEY(8) ON: GOSUB 1800: GOTO 4980 34 LOCATE 24, 26: PRINT SPACE$(30): RETURN 35 GOSUB 592 37 IF PA$ <> "anast" THEN ATTEN = 0: MEP = 0 38 'IF PAR(17)=0 THEN GOSUB 46 39 CLOSE #1: CLOSE #2: CLOSE #3: GOSUB 2207 40 WFREE = FRE(""): CHAIN PA$ 45 RESTORE 1535: GOSUB 120: FOR CVB = 0 TO 6: LOCATE 5 + CVB, 10: GOSUB 1700: NEXT CVB: RETURN 46 IF PAR(17) <> 0 OR (NOEUD = 1 AND LIGNE > 6) OR LIGNE > BUTEB THEN RETURN ELSE CVB = LIGNE: LOCATE㐞 5 + LIGNE, 10: GOSUB 1700: LOCATE 5 + LIGNE, 9: PRINT " "; : LOCATE 5 + LIGNE, LEN(Y$) + 10: PRINT " " 47 RETURN 50 MSE = PAR(19 + (3 * PAR(37))) AND 31: MME = (PAR(19 + (3 * PAR(37))) AND 992) / 32: DPL = (PAR(20 + (3 * PAR(37))) AND 496) / 16: DPL$ = RIGHT$(STR$(DPL), LEN(STR$(DPL)) - 1) 52 BV% = (PAR(19 + (3 * PAR(37))) AND 15360) / 1024: IF (PLM(49) AND 2 ^ (BV% - 1)) <> 0 OR (METP = 0 AND PLM(49) <> 0) THEN ST$ = " Std" ELSE ST$ = " " 53 IF MME THEN ECRI$ = "M" ELSE ECRI$ = "S" 54 IF (PAR(20㐞 + (3 * PAR(37))) AND 2 ^ 12) <> 0 THEN ECRI$ = ECRI$ + "R" ELSE ECRI$ = ECRI$ + " " 55 IF MME THEN ECRI$ = ECRI$ + "-" + LEFT$(MTT$(MME), 6) + " Tray:" + DPL$ + " " + LEFT$(B$(MSE), 6) + ST$ ELSE ECRI$ = ECRI$ + "-" + LEFT$(B$(MSE), 6) + " Tray : " + DPL$ + ST$ 60 COLOR 5, 0: LOCATE 2, 50: PRINT ECRI$ + SPACE$(30 - LEN(ECRI$)): RETURN 100 READ A$ 105 IF LON = 0 THEN 110 106 IF A$ = "" THEN A$ = " " 107 N = INT(LEN(A$) / 2): RETURN 110 PRINT A$; : LON = 0: RETURN 120 COLOR 5, 0: LOCATE 1, 㐞 20, 0: PRINT SPACE$(40): LOCATE 2, 30: PRINT SPACE$(20): COLOR 1, 2 121 GOSUB 602: COLOR 5, 0: CB = 5 122 FOR I = 1 TO 7: READ A$: CUR = 11 * (I - 1) + INT(.4 * I) 160 IF I > 1 THEN LOCATE 20, 2 + CUR ELSE LOCATE 20, 1 + CUR 162 A3$ = SPACE$(5 - LEN(A$) / 2) + A$: A$ = A3$ + SPACE$(10 - LEN(A3$)): PRINT A$ 164 LOCATE 21, CB: IF A$ <> SPACE$(10) THEN PRINT "F" + RIGHT$(STR$(I), 1) ELSE PRINT " " 165 CB = CB + 11 + CINT(I / 2 - INT(I / 2)): NEXT I 166 L(1) = 24: C(1) = 7: L(2) = 24: C(2) = 75: L(3) = 㐞 1: C(3) = 39: L(4) = 1: C(4) = 6: L(5) = 2: C(5) = 40 170 FOR I = 8 TO 12: LON = 1: GOSUB 100: LOCATE L(I - 7), C(I - 7) - N: GOSUB 110: NEXT I 205 IF STATUS <> 8 OR PASSAG = 0 THEN A1$ = SPACE$(11): A2$ = SPACE$(11) ELSE A1$ = " Start ": A2$ = " F8 " 210 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 1: GOSUB 110: A$ = A2$: LOCATE 25, 1: GOSUB 110 220 IF (STATUS <> 9 AND PAR(17) = 0) THEN A1$ = SPACE$(11): A2$ = SPACE$(11) ELSE A1$ = " Abort ": A2$ = " S F9 " 225 LON = 1: A$ = A1$: GOSUB㐞 105: LOCATE 24, 70: GOSUB 110: A$ = A2$: LOCATE 25, 70: GOSUB 110 250 LOCATE 2, 2: PRINT DATEF$; : LOCATE 2, 50 255 ' 280 GOSUB 50 290 SUP% = F9% 300 COLOR 1, 2: LOCATE 3, 1: RETURN 592 GOSUB 740: DOV% = &H32: CUM% = &HF: dat% = &HFF40: CALL IO(DOV%, CUM%, dat%, RET%): RETURN 593 GOSUB 750: DOV% = &H32: CUM% = &HF: dat% = &HBF00: CALL IO(DOV%, CUM%, dat%, RET%): RETURN 594 RET% = 0: WHILE (RET% < 2047): DOV% = &H35: CUM% = &H1: CALL IO(DOV%, CUM%, dat%, RET%): WEND: RETURN 595 ' CALL HAR:RETURN㐞 'hardcopy 600 CALL CLA(MA%, SUP%): RETURN 601 DEV% = &H32: cim% = 5: RET% = 0: CALL IO(DEV%, cim%, dat%, RET%): RETURN 602 VIEW PRINT 3 TO 19: CLS : VIEW PRINT: IF DEJAP THEN GOSUB 1530: IF MESS$ <> "0" AND MESS$ <> " " AND MESS$ <> CHR$(0) AND MESS$ <> "" THEN EFFAC% = 1: GOSUB 1400: EFFAC% = 0 603 DEJAP = 1: RETURN 610 PA$ = "maincp": GOTO 35 615 PA$ = "workcp": GOTO 35 620 IF O2 = 64 THEN PA$ = "mathcp": GOTO 35 ELSE BUT = 200: GOTO 610 625 IF CALFIN AND BUT <> 30 THEN AIG3 = 1 626 PA$ = "check㐞 cp": GOTO 35 670 BUT = 100: GOTO 610 675 GOSUB 2450 678 IF PAS THEN PA$ = "rdcp": GOTO 35 ELSE PA$ = "ltcp": GOTO 35 680 PA$ = "parcp": GOTO 35 690 GOSUB 2540: PA$ = "anast": GOTO 35 696 PA$ = "diagcp": GOTO 35 740 GOSUB 2275: COLOR 5, 0: LOCATE 25, 70: PRINT SPACE$(11); : LOCATE 24, 70: PRINT SPACE$(11): COLOR 1, 2 745 RETURN 750 IF ENVPARAM% = 1 THEN GOSUB 740: RETURN ELSE IF PAR(17) = 0 OR ABORT = 1 THEN COLOR 5, 0: LOCATE 24, 70: PRINT " Abort ": LOCATE 25, 70: PRINT " S F9 "; : COLOR 㐞 1, 2 752 IF CHANGE = 1 AND ATTEN = 1 THEN GOSUB 2285 755 RETURN 800 ' 810 ' 820 IF NOSOUN% = 1 THEN RETURN ELSE GOSUB 885: FOR WTY = 1 TO 4: SOUND 875, 12: FOR WBV = 1 TO 500: NEXT WBV: NEXT WTY: RETURN 850 IF MUSIC > 7 THEN RETURN ELSE IF ERE% < 19 THEN 853 ELSE 865 853 IF MESS = 0 THEN RETURN 855 IF NOSOUN% = 1 THEN RETURN ELSE GOSUB 885: SOUND 2000, 18: RETURN 865 IF NOSOUN% = 1 THEN RETURN ELSE GOSUB 885: FOR WTY = 1 TO 5: SOUND 2400, 5: FOR WBV = 1 TO 600 + (CINT(O2 / 16) - 1) * 75: NEXT WBV: 㐞 NEXT WTY: RETURN 875 IF MENE <> 0 OR BUTEB < 9 OR PAR(17) <> 0 OR PAR(57) <> 0 OR FLECH <> 0 THEN RETURN ELSE IF ADTER <> 0 AND PAR(37) < 4 AND PAR(34) < 64 THEN LOCATE 14, 4, 0: PRINT "--->": GOTO 880 ELSE RETURN 880 IF MUSIPL = 1 THEN RETURN ELSE GOSUB 885: SOUND 3200, 300: FOR WTY = 1 TO 4000: NEXT WTY: MUSIPL = 1: RETURN 885 DAV% = 56: cim% = 2: dat% = 0: RET% = 0: CALL IO(DAV%, cim%, dat%, RET%): RETURN 887 IF PAR(17) = 0 THEN COLOR 1, 2: LOCATE 14, 4, 0: PRINT SPACE$(4) 888 RETURN 960 FLAGSORT% 㐞 = 1: RETURN 970 IF NOSOUN% = 2 THEN NOSOUN% = 1: KEY(3) OFF: L = 20: C(2) = 27: A$ = SPACE$(7): C(1) = 28: A3$ = " ": GOSUB 1527: RETURN ELSE RETURN 1000 'R$ = "": cim% = &HC: dat% = 0: GOSUB 2095: cim% = 2: dat% = 0 1005 'CALL IO(DEV%, cim%, dat%, RET%): CHAR = RET% 1010 'IF CHAR = -1 THEN 1005 ELSE R$ = R$ + CHR$(CHAR) 1015 'IF CHAR <> 10 THEN 1005 ELSE cim% = &HC: dat% = 1: GOSUB 2095: RETURN 1080 'Q$ = "DST": GOSUB 1949 1081 'DOV% = &H35: CUM% = &H1: CALL IO(DOV%, CUM%, DAT%, RET%): IF RET% < 20㐞 00 THEN AJUMP = 1 ELSE AJUMP = 0 1082 'IF AJUMP THEN RETURN ELSE MESS$ = MID$(R$, 4, 1): IF MESS$ = "0" OR MESS$ = " " OR MESS$ = CHR$(0) THEN MESS = 0: GOTO 1083 ELSE IF MESS$ <> MESB$ THEN MESB$ = MESS$: NOSOUN% = 0: GOSUB 1400: MUSIC = 0 'test dst 1083 RETURN 1100 V$ = RIGHT$(STR$(WV), LEN(STR$(WV)) - 1): RETURN 1110 GET #1, 2: H$ = FF$: LSET FF$ = H$: PUT #1, 1 1115 GET #1, 3: H$ = FF$: LSET FF$ = H$: PUT #1, 2 1120 GET #1, 4: H$ = FF$: LSET FF$ = H$: PUT #1, 3: CLOSE #1: RETURN 1140 GOSUB 1960: 㐞 IF NOSOUN% = 0 THEN MESB$ = "0" 1141 IF NOSOUN% = 2 THEN RESTORE 1536 ELSE RESTORE 1535 1142 KEY(3) STOP: GOSUB 120: KEY(3) ON: LOCATE 7, 29: PRINT "Method Aborted": RETURN 1145 LOCATE 18, 40: PRINT "For a Complete Abort Press S F9"; : IF PAR(17) = 1 THEN PRINT " Again" ELSE PRINT " " 1147 RETURN 1150 Q$ = "IND": GOSUB 1949: Q$ = LEFT$(V$, 3): QP$ = V$ + T1$ + CHR$(13) + CHR$(10): GOSUB 2055: Q$ = "@" + LEFT$(V$, 2): GOSUB 2100: Q$ = LEFT$(V$, 3): GOSUB 2100 1155 Q$ = "OUD": GOSUB 1949: RETURN 1175 I㐞 F PAR(17) <= 1 OR Z$ = SPACE$(23) THEN RETURN ELSE LPRINT : GOSUB 1180: LPRINT : IF ERE% <> 29 THEN LPRINT "ERROR : "; 1176 LPRINT Z$: GOSUB 1180: GOSUB 7180 1177 RETURN 1180 FOR TY% = 1 TO 39: LPRINT "_"; : NEXT TY%: LPRINT : RETURN 1185 PAR(7 + METCO) = 0: IF PAR(16) = METCO THEN IF PAR(40 - METCO) THEN PAR(16) = 3 - METCO ELSE PAR(16) = 0 1186 RETURN 1190 COLOR 5, 0: ANAST = 1: GOSUB 2540: ANAST = 0: TE$ = MID$(R$, 15, 1): RETURN 1200 STATUS = 0: KEY(8) OFF: KEY(4) OFF: AIG1 = 0: GOSUB 1175: GOSUB㐞 2207: CHANGE = 0: GOSUB 2280: ES% = 1: IF AIG2 > 0 OR ABCAL <> 0 THEN 1220 1201 IF PAR(37) = 0 AND PAR(57) <> 0 THEN PAR(54) = 1: GOTO 1240 1202 GOSUB 1205: GOSUB 1215: GOTO 1225 1205 FOR TY% = ES% TO 48: IF PLACE(TY%) <> 0 THEN PAR(54) = TY%: TY% = 48: GOTO 1210 1207 IF TY% = 48 THEN PAR(54) = 50 1210 NEXT TY%: RETURN 1215 BV% = (PAR(22) AND 15360) / 1024'BV%=(PAR(19+(3*PAR(37))) AND 15360)/1024:RETURN 1217 IF METP = 0 THEN BV% = 1 1218 RETURN 1220 GOSUB 1215: IF (((PLM(49) AND 2 ^ (BV% - 1)) <> 㐞 0 OR (PLM(49) <> 0 AND METP = 0)) AND LIMI = 1 AND ETP% <> 4) OR ABCAL <> 0 THEN PAR(54) = 1: GOTO 1225 1222 IF (((PLM(49) AND 2 ^ (BV% - 1)) <> 0 OR (PLM(49) <> 0 AND METP = 0)) AND LIMI = 1 AND ETP% = 4) AND AIG2 < 17 THEN ES% = 17: GOSUB 1205 ELSE IF (AIG3 AND 255) = 49 THEN PAR(54) = 51 ELSE 1224 1223 GOTO 1225 1224 PAR(54) = AIG2: IF LIMI1 <> 49 AND AIG2 <> (AIG3 AND 255) AND AIG2 + 1 = LIMI1 THEN PAR(54) = LIMI1 1225 IF K1(6) = 3 OR K1(6) = 12 OR CALF <> 0 THEN 1240 1227 'IF ((PLM(49) AND 2^(BV%-㐞 1))<>0 OR (METP=0 AND PLM(49)<>0)) AND LIMI=1 AND ETP%=4 AND ABAND=0 THEN ATTEN=0:GOSUB 740:LOCATE 18,40:PRINT SPACE$(38):GOSUB 4215:KEY(1) ON:KEY(2) ON:ON KEY(1) GOSUB 1255:ON KEY(2) GOSUB 1260 ELSE 1240 1240 ENTET% = 0: GOSUB 2245 1242 GOSUB 2019: GOSUB 7180: NONL$ = "": RETURN 1250 GOSUB 1270: AIGUILLAGE = 4: RETURN 1270 COLOR 1, 2: LOCATE 25, 24: PRINT SPACE$(10); "ABORT REQUESTED"; SPACE$(10); : LOCATE 19, 1: RETURN 1280 IF PAR(17) = 2 THEN DEJARET = 0: GOSUB 1948 1285 RETURN 1290 PTREM = PAR(23㐞 ) AND 15: UNE = 1: GOSUB 2415: GET #1, 49: PLM(49) = CVI(F4$): CLOSE #1: RETURN 1300 IF AIG2 < 17 AND PL(AIG2) = 254 AND AIG2 > 1 THEN AIG3 = AIG3 - 1 1305 RETURN 1320 IF PAR(17) = 1 THEN GOSUB 2194: LSET P1$ = MKI$(1): PUT #1, 17: CLOSE #1 1325 RETURN 1350 ECRANAB% = 1: GOSUB 1960: IF RETOUR = 2 THEN GOSUB 1370: RETURN ELSE ABORT = 1: GOSUB 1140 1351 IF PAR(17) <> 2 THEN V$ = "PIPE": T1$ = ":H,0": GOSUB 1150 1353 GOSUB 593: GOSUB 1145: IF PAR(17) <> 1 THEN PAR(34) = 64: X = 34: GOSUB 2158 1360 GOSU㐞 B 1370: GOSUB 1530 1365 KEY(8) ON: ON KEY(8) GOSUB 1250: RETURN 1370 IF ERE% = 26 THEN LOCATE 10, 25: PRINT "Verify reagent or sample level": LOCATE 12, 28: PRINT "Complete if necessary" ELSE IF ERE% = 30 THEN LOCATE 11, 25: PRINT "Complete the Pre-Fill Container" 1375 GOSUB 601: DEV% = 52: RETURN 1400 COLOR 1, 2: IF LEN(MESS$) = 0 THEN MESS = VAL(MESS$): GOTO 1420 ELSE MESS = ASC(MESS$): IF MESS > 57 THEN MESS = MESS - 7 1405 ERE% = MESS - 33: IF ERE% > 30 THEN GOSUB 1430 ELSE IF ERE% > 18 THEN GOSUB 㐞 1460 1410 GOSUB 2206: IF Z$ = SPACE$(23) THEN 1420 ELSE IF ERE% = 29 THEN 1411 ELSE LOCATE 25, 38: PRINT Z$; SPACE$(2); : IF ERE% < 19 THEN LOCATE 25, 25: PRINT " WARNING : "; ELSE LOCATE 25, 25: PRINT " ERROR : "; 1411 IF EFFAC% THEN RETURN 1412 IF FRE(0) < 2500 THEN WFRE = FRE("") 1413 IF ERE% <> 0 AND NOSOUN% = 0 THEN ON KEY(3) GOSUB 970: KEY(3) ON: NOSOUN% = 2: A$ = "Acknow": L = 20: C(2) = 27: A3$ = "F3": C(1) = 28: GOSUB 1527 1414 IF ERE% < 19 THEN GOSUB 855 ELSE GOSUB 865 1420 RETURN 14㐞 30 PAR(17) = 4: ERREUR% = 1: DEJARET = 1: PAR(56) = ERE%: IF FLECH THEN RETURN ELSE GOSUB 887: FLECH = 1: RETURN 1460 PAR(17) = 2: ERREUR% = 1: DEJARET = 1: PAR(55) = PAR(55) OR 2 ^ (ERE% - 19): IF PAR(54) = 0 THEN PAR(54) = VAL(MID$(R$, 17, 2)) 1465 IF FLECH THEN RETURN ELSE GOSUB 887: FLECH = 1: RETURN'derniere cuve correcte 1470 GOSUB 1556: GOSUB 592: BUTEB = 10: AFFICH = 2047: GOSUB 1565: MAJECR = 1: GOSUB 1780: GOSUB 593: RETURN 1475 RBL = 0 1480 GOSUB 2193: LSET T1$ = MKS$(0): PUT #1, 46: CLOSE #㐞 1: RETURN 1482 GOSUB 2193: LSET T1$ = MKS$(RBL): PUT #1, 46: CLOSE #1: RETURN 1485 GOSUB 592: CHANGE = 1 1490 NOMB = 1: NOMBST = 1: GOSUB 2761: FOR IND = 2 TO 48: IF (PLM(IND) AND 2 ^ (PAR(40) - 1)) = 0 THEN 1500 1495 IF PL(IND) <> 0 AND PL(IND) < 255 THEN NOMB = NOMB + 1: IF PL(IND) = 254 THEN NOMBST = NOMBST + 1 1500 NEXT IND: GOSUB 1985: IF (64 - PAR(34) >= NOMB AND PAR(34) <> 64) THEN CHANGE = 3 ELSE IF PAR(37) <> 0 AND ((64 - PAR(34)) < NOMBST OR PAR(34) > 62) THEN ATTEN = 1: CHANGE = 2 ELSE GOSUB㐞 2250 1505 GOSUB 2280: PTREM = PAR(23) AND 15: GOSUB 2415: GOSUB 2430: IF K1(6) > 2 OR BLACOR = 1 OR K1(33) <> 0 THEN PL(1) = 254 1507 GOSUB 593: RETURN 1510 GOSUB 2193: GET #1, 21: CHANGE = CVS(T1$): CLOSE #1: RETURN 1515 IF CHANGE = 0 THEN GOSUB 1510 1520 RETURN 1525 LOCATE 24, 32: PRINT "Change Requested": LOCATE 19, 1: RETURN 1527 COLOR 5, 0: LOCATE L + 1, C(1): PRINT A3$: LOCATE L, C(2): PRINT A$: COLOR 1, 2: RETURN 1530 LOCATE 25, 16: PRINT (64 - PAR(34)); SPACE$(2); : LOCATE 24, 13: PRINT "Fr㐞 ee cuvet.": RETURN 1535 DATA ,,,,,,,,,< CPA >,, 1536 DATA ,,Acknow,,,,,,,< CPA >,, 1540 'DATA "Tot.Rej.",Next,"Sel.Val.",Dilution,,Duplicate,,,,< CPA >,, 1541 Y$ = " SET UP AND START ": RETURN 1542 Y$ = " SAMPLE PROGRAMMING AND REPORTING ": RETURN 1543 Y$ = " INSTRUMENT PROTOCOL AND QC ": RETURN 1544 Y$ = " CREATION AND METHOD REVISION ": RETURN 1545 Y$ = " PATIENT FILE REVIEW ": RETURN 1546 Y$ = " MATH FUNCTIONS ": RETURN 1547 Y$ = " MAINTENANCE ": RETURN 1548 Y$ = " CHECK ABSORBANCES ":㐞 RETURN 1549 Y$ = " CHANGE CALIBRATION ": RETURN 1550 Y$ = " CONTINUE ": RETURN 1551 Y$ = " INTERRUPTED METHOD ": RETURN 1556 IF ECRANAB% THEN RETURN ELSE GOSUB 592: COLOR 1, 2: LOCATE 15, 10: GOSUB 1551: PRINT Y$: LOCATE 14, 10: GOSUB 1550: PRINT Y$: LOCATE 12, 10: GOSUB 1548: PRINT Y$: IF SAUTCC THEN GOSUB 593: RETURN ELSE LOCATE 13, 10: GOSUB 1549: PRINT Y$: GOSUB _ 593: RETURN 1559 GOSUB 592: COLOR 1, 2: LOCATE 24, 26: PRINT SPACE$(30); : C = 41 - INT(LEN(SELEC$) / 2): LOCATE 24, C: PRINT SELE㐞 C$; : LOCATE LIGNE + 5, 1: GOSUB 593: RETURN 1565 IF ECRANAB% THEN RETURN ELSE AAF = LIGNEB: GOSUB 1595: AAF = LIGNE: GOSUB 1595 1566 LIGNEB = LIGNE: LOCATE , , 0: COLOR 1, 2: RETURN 1595 ON AAF + 1 GOSUB 1541, 1542, 1543, 1544, 1545, 1546, 1547, 1548, 1549, 1550, 1551 1596 IF AAF = LIGNE THEN COLOR 5, 0: LOCATE 5 + LIGNE, 9: PRINT "[": LOCATE 5 + LIGNE, LEN(Y$) + 10: PRINT "]" ELSE COLOR 1, 2: LOCATE 5 + LIGNEB, 9: PRINT " ": LOCATE 5 + LIGNEB, LEN(Y$) + 10: PRINT " " 1597 LOCATE 5 + AAF, 10: PRINT Y$㐞 ; : RETURN 1605 GOSUB 592: IF AIGUILLAGE THEN 1620 1606 IF LIGNE = BUTEH THEN LIGNEB = BUTEH: LIGNE = BUTEB: GOSUB 1565: GOTO 1620 1607 IF (LIGNE = 9 AND SAUTCC) OR (LIGNE = 10 AND PAR(57) <> 0) THEN LIGNE = LIGNE - 1 1610 LIGNE = LIGNE - 1: GOSUB 1565 1620 GOSUB 593: RETURN 1630 GOSUB 592: IF AIGUILLAGE THEN 1645 1631 IF LIGNE = BUTEB THEN LIGNEB = BUTEB: LIGNE = BUTEH: GOSUB 1565: GOTO 1645 1632 IF (LIGNE = 7 AND SAUTCC) OR (LIGNE = 8 AND PAR(57) <> 0) THEN LIGNE = LIGNE + 1 1635 LIGNE = LIGNE + 㐞 1: GOSUB 1565 1645 GOSUB 593: RETURN 1655 GOSUB 592: IF LIGNE = 6 OR PAR(17) <> 0 OR AIGUILLAGE <> 0 THEN 1670 1656 AIGUILLAGE = 1 1658 COLOR 1, 2: ON LIGNE + 1 GOSUB 1541, 1542, 1543, 1544, 1545, 1546, 1547, 1548, 1549, 1550, 1551 1660 SELEC$ = Y$: GOSUB 1559 1670 GOSUB 593: RETURN 1700 ON CVB + 1 GOSUB 1541, 1542, 1543, 1544, 1545, 1546, 1547, 1548, 1549, 1550, 1551 1701 PRINT Y$: RETURN 1715 IF ECRANAB% THEN RETURN ELSE BUTEH = 1 1725 IF (AFFICH AND 2 ^ BUTEB) THEN 1740 ELSE BUTEB = BUTEB - 1: 㐞 GOTO 1725 1740 FOR CVB = 0 TO 10: LOCATE 5 + CVB, 10 1741 IF CVB = 8 AND SAUTCC THEN 1760 1742 IF (AFFICH AND 2 ^ (CVB)) = 0 THEN 1760 1745 GOSUB 1700 1760 NEXT CVB 1770 AIGUILLAGE = 0 1775 GOSUB 1565 1777 GOSUB 1530 1780 KEY(8) OFF: KEY(9) ON: KEY(10) ON: KEY(12) ON: IF STATUS = 9 THEN KEY(8) ON 1785 ON KEY(9) GOSUB 1605 1790 ON KEY(10) GOSUB 1655 1795 ON KEY(12) GOSUB 1630 1800 IF STATUS = 9 THEN ON KEY(8) GOSUB 1935 1805 RETURN 1855 BUT = 30: GOTO 625 1865 GOSUB 4205: IF VA THEN BUT = 40:㐞 GOTO 625 ELSE AIGUILLAGE = 0: GOSUB 593: GOTO 4290 1870 GOSUB 1515: IF (AIGUILLAGE = 8 OR CHANGE = 2 OR CHANGE = 4) AND PAR(37) <> 0 THEN ATTEN = 1: GOTO 4260 ELSE IF AIGUILLAGE = 1 AND LIGNE = 10 THEN 4260 ELSE IF CHANGE = 1 OR CHANGE = 3 THEN GOSUB 2275: GOSUB 1300: GOTO 1874 1873 KEY(4) OFF: CHANGE = 0: GOSUB 2280: METH = PAR(7 + METCO): IF PAR(17) THEN GOSUB 1200: PAS = 32: NONL$ = "": GOTO 675 ELSE VER = 16: GOSUB 1242: GOTO 675 1874 GOSUB 592: KEY(4) OFF: CHANGE = 0: GOSUB 2280: VER = 16: BUT = 15㐞 : GOTO 690 1875 IF PAR(37) = 1 AND PAR(17) <> 0 THEN 1873 ELSE BUTEB = 7: IF LIMI1 <> 49 THEN VER = 32: GOTO 675 1876 GOSUB 887: IF MEP = PAR(8) THEN METCO = 1 ELSE METCO = 2 1877 FIFL = 0: IF ((PAR(22) AND 16384) / 16384) THEN FIFL = 1 1880 PAR(37) = PAR(37) - 1 1881 ENC% = PAR(23) AND 15 1882 FOR SOURCE = 0 TO 6 STEP 3: PAR(22 + SOURCE) = PAR(25 + SOURCE) 1883 PAR(23 + SOURCE) = PAR(26 + SOURCE): PAR(24 + SOURCE) = PAR(27 + SOURCE): NEXT SOURCE 1884 PAR(31) = 0: PAR(32) = 0: PAR(33) = 0 1885 IF M㐞 ETCO = 2 THEN ENC% = ENC% - 4 1886 IF FIFL = 0 THEN 1897 1888 PAR(35) = PAR(35) XOR 2 ^ (ENC% - 1 + (8 * (METCO - 1))): PAR(41 + ENC% + (4 * (METCO - 1))) = 0 1889 PAR(36) = PAR(36) XOR 2 ^ (ENC% - 1 + (8 * (METCO - 1))) 1890 ENC% = ENC% + 1: IF ENC% = 5 THEN ENC% = 1 1891 IF (PAR(36) AND 2 ^ (ENC% - 1 + (8 * (METCO - 1)))) THEN PAR(11 + METCO) = ENC% ELSE PAR(11 + METCO) = 0 1894 INK = 0: FOR INC = 0 TO 3: GOSUB 1975 1895 NEXT INC: IF INK THEN 1897 1896 IF PAR(9 + METCO) = 0 THEN GOSUB 1185 1897 G㐞 OSUB 2450: GOSUB 2199 1900 GOSUB 1110 1901 'IF PAR(37) THEN 1905 1902 IF FIFL THEN GOSUB 2300 1905 GOSUB 2200 1908 GOSUB 1110: AIG3 = 0: IF (PAR(34) = 64) AND (PAR(37) = 0) AND (PAR(40) <> 0) THEN ENTET% = 0: GOSUB 2245: GOTO 1873 1909 GOSUB 1969: GOSUB 1475: GOTO 6080 1910 IF AR$=SPACE$(LEN(AR$)) THEN RETURN ELSE LONG=0:FOR TY%=32 TO 1 STEP-1:IF MID$(AR$,TY%,1)=CHR$(0) OR MID$(AR$,TY%,1)=CHR$(32) THEN LONG=TY%-1 ELSE TY%=1 1915 NEXT TY%:LPRINT TAB(20-INT(LONG/2)) LEFT$(AR$,LONG+1):RETURN 1935 TB =㐞 1: IF PAR(37) <> 0 AND PAR(17) = 0 THEN AIGUILLAGE = 3: PAR(17) = 1 ELSE 1945 1940 GOSUB 887: GOSUB 1270: IF FLECH = 0 THEN GOSUB 887: FLECH = 1 1945 RETURN 1946 QP$ = Q$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 1000: RETURN 1947 ' 1948 IF DEJARET THEN RETURN ELSE Q$ = "STO": PAR(34) = 64 1949 QP$ = Q$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 2100: RETURN 1950 Q$ = "ABU": GOSUB 1949: AIGUILLAGE = 0: GOSUB 2525: RETURN 1955 'KEY(1) OFF:KEY(2) OFF:KEY(3) OFF:KEY(4) OFF:KEY(5) OFF:KEY(6) OFF 1960 KEY㐞 (9) OFF: KEY(10) OFF: KEY(12) OFF 1965 RETURN 1969 IF FIFL = 0 THEN RETURN 1970 IF (PAR(35) AND 2 ^ (PAR(37 + METCO) - 1 + (8 * (METCO - 1)))) = 0 THEN PAR(37 + METCO) = PAR(37 + METCO) + 1 1971 IF PAR(37 + METCO) = 5 THEN PAR(37 + METCO) = 1 1972 IF (PAR(35) AND 2 ^ (PAR(37 + METCO) - 1 + (8 * (METCO - 1)))) = 0 THEN PAR(37 + METCO) = 0 1973 GOSUB 2450: RETURN 1975 BV% = (PAR(22 + (3 * INC)) AND 992) / 32: IF BV% = 0 THEN BV% = (PAR(22 + (3 * INC)) AND 31) 1979 IF BV% = PAR(7 + METCO) THEN INK = 1 㐞 1980 RETURN 1981 CALCONT = K1(63 + K1(1) + BLACOR): IF K1(76) <> 0 THEN CALCONT = K1(76) 1982 IF K1(77) <> 0 THEN CALCONT = K1(77) 1983 RETURN 1985 METSUI = VAL(MID$(NMLI$, (PAR(40) * 3) - 1, 2)): GOSUB 2198: GET #1, (METSUI - 1) * 100 + 6: KSUI = CVS(A2$) 1990 CLOSE #1 1992 IF KSUI = 4 THEN NOMB = NOMB + 1: NOMBST = NOMBST + 1 1995 RETURN 1999 SOUND 2500, 200: PAR(17) = 1: GOSUB 1948: GOSUB 1350: RETURN 2000 GOSUB 594: LOCATE 24, 24: PRINT SPC(12); "RESULTS"; SPC(12); 2002 I = 0: ITPE = PAR(23) 㐞 AND 15: IF (PAR(41 + ITPE) AND 512) <> 0 THEN LPRINT "RUN 2 :"; 2004 I = I + 1: ON I GOTO 2006, 2008, 2010 2006 IF METP THEN AR$ = NT$ + " / " + LEFT$(MTT$(METP), 6) + SPACE$(17) ELSE AR$ = NT$ + SPACE$(26) 2007 GOSUB 1910: GOTO 2004 2008 AR$ = NTI$: GOTO 2007 2010 AR$ = NST$: GOSUB 1910 2012 LPRINT DATEF$; TAB(15); "TIME :"; LEFT$(TIME$, 5); TAB(32); "TRAY :"; (PAR(23) AND 2032) / 16 2014 LPRINT "TEMP.C : "; : GOSUB 2193: GET #1, METI: LPRINT T1$; : CLOSE #1 2015 'IF K1(6)=4 THEN RETURN 2016 LPRIN㐞 T 'IF K1(6)<>3 THEN LPRINT TAB(23) "LIN. RANGE:";K1(39) ELSE LPRINT 2018 LPRINT "EXP. VAL:"; VAL(NE1$); "-"; VAL(NE2$); TAB(28); "UNIT 1:"; NU1$: RETURN 2019 DERBAK = DERLEC 2020 IF LEN(NONL$) = 0 THEN RETURN 2021 FOR WE = 1 TO LEN(NONL$): IF MID$(NONL$, WE, 1) = "." THEN RETI = WE: WE = LEN(NONL$) 2022 NEXT WE: IJ = VAL(LEFT$(NONL$, RETI - 1)): NONL$ = RIGHT$(NONL$, LEN(NONL$) - RETI): IF IJ = III THEN 2020 ELSE DERLEC = DERBAK: IF (P2(IJ) AND 2 ^ 9) <> 0 THEN LPRINT "NO LINEAR :"; ELSE LPRINT "OUT O㐞 F LIMIT :"; 2023 IF IJ < 17 THEN LPRINT "C"; IJ ELSE LPRINT "SAMPLE "; IJ - 16 2024 A = 0: DCUVE = PLACE(IJ): GOSUB 3550: III = IJ: GOTO 2020 2040 FOR BV% = TOP TO LEN(R$) 'traitem. chaine ABC DOC 2045 IF MID$(R$, BV%, 1) = ARRIV$ THEN ARRIV = BV% - 1: BV% = LEN(R$): ARR = ARRIV - TOP + 1 2050 NEXT BV%: ARR$ = MID$(R$, TOP, ARR): RETURN 2055 I = 1 2056 IF Q$ = "SECU" THEN Q$ = "@SE" 2065 cim% = &H10: GOSUB 2095 ' : IF RET% = 0 THEN 2065 ELSE CHAR = ASC(MID$(QP$, I, 1)): cim% = 1: dat% = CHAR 207㐞 5 GOSUB 2095:RETURN ': I = I + 1: IF CHAR <> 10 THEN 2065 ELSE RETURN 2095 RETURN 'CALL IO(DEV%, cim%, dat%, RET%): RETURN 2100 R$ = "": INU = 0: BUFFER = 0: cim% = &HC: dat% = 0: GOSUB 2095 2110 cim% = 2: dat% = 0 2115 GOSUB 2095 ': CHAR = RET% 2120 'IF CHAR <> -1 THEN cim% = &H1E: GOSUB 2095: IF RET% <> 0 THEN R$ = "ERR": LPRINT "ERREUR STATUS "; RET%: GOTO 2150 'demande le status du caractere recu (*2 le temp de transfert) 2125 GOTO 2135 'IF CHAR = -1 THEN INU = INU + 1 ELSE R$ = R$ + CHR$(CHAR): G㐞 OTO 2135 2130 'IF INU = 6000 AND REPET THEN ARRET = 1: RETURN ELSE IF INU = 6000 THEN REPET = 1: GOTO 2152 ELSE 2110 2135 'IF CHAR <> 10 THEN 2110 2140 GOSUB 2095 ': IF RET% = -1 AND BUFFER <> 0 THEN R$ = "ERR" ELSE IF RET% <> -1 AND (Q$ <> "@PI") THEN BUFFER = 1: INU = 5900: GOTO 2110 2150 'IF Q$ <> LEFT$(R$, 3) AND REPET THEN ARRET = 1: AJUMP = 1: GOTO 2155 ELSE IF Q$ <> LEFT$(R$, 3) THEN REPET = 1 ELSE 2155 2152 'IF Q$ <> "PIP" AND Q$ <> "@PI" THEN GOSUB 2055: GOTO 2100 2155 RETURN 'cim% = &HC: dat㐞 % = 1: GOSUB 2095: RETURN 2158 GOSUB 2194: LSET P1$ = MKI$(PAR(X)): PUT #1, X: CLOSE #1: RETURN 2160 'GOSUB 2194:LSET P1$=MKI$(0):PUT#1,17:CLOSE#1:COLOR 1,2:LOCATE 25,25:PRINT SPACE$(34);:LOCATE 19,1:RETURN 2162 OPEN "r", #1, "nameth", 105: FIELD #1, 6 AS T$, 6 AS DA$, 32 AS ST$, 32 AS TI$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$: RETURN 2165 ' 2170 GOSUB 2162 2185 GET #1, METI: NT$ = T$: NST$ = ST$: NTI$ = TI$: NU1$ = U1$: NU2$ = U2$: NE1$ = E1$: NE2$ = E2$: NCOF$ = COF$㐞 : DECI$ = D1$: DECI = VAL(DECI$) 2186 CLOSE #1: OPEN "r", #1, "nameth", 105: FIELD #1, 105 AS DH$: GET #1, 34: ENTET% = CVI(MID$(DH$, 57, 2)) 2187 IF K1(6) = 3 OR K1(6) = 12 THEN CLOSE #1: RETURN 2190 GET #1, 33: IF DH$ = SPACE$(105) THEN DATHI$ = "00-00-00": CLOSE #1: RETURN ELSE DAH$ = MID$(DH$, 1 + ((METI - 1) * 4), 4): MJ = CVI(LEFT$(DAH$, 2)): IF MJ = 0 THEN DATHI$ = "00-00-00": CLOSE #1: RETURN 2191 MOI = INT(MJ / 100): JOU = MJ - (100 * MOI): ANN$ = RIGHT$(DAH$, 2): DATHI$ = STR$(MOI) + "-" + STR㐞 $(JOU) + "-" + ANN$: CLOSE #1: RETURN 2193 OPEN "r", #1, "temper", 4: FIELD #1, 4 AS T1$: RETURN 2194 OPEN "R", #1, "pargen", 2: FIELD #1, 2 AS P1$: RETURN 2195 OPEN "r", #1, "ABSORB", 106: FIELD #1, 106 AS A1$: RETURN 2198 OPEN "r", #1, "method", 4: FIELD #1, 4 AS A2$: RETURN 2199 OPEN "r", #1, "cyclec", 96: FIELD #1, 96 AS FF$: RETURN 2200 OPEN "r", #1, "plac", 96: FIELD #1, 96 AS FF$: RETURN 2201 OPEN "r", #1, "qualite", 408: FIELD #1, 4 AS QL1$, 4 AS QL2$, 6 AS LL$, 4 AS QH1$, 4 AS QH2$, 6 AS LH$㐞 , 186 AS RL$, 186 AS RH$, 4 AS CL$, 4 AS CUH$: RETURN 2202 OPEN "r", #1, "paille", 206 2203 FIELD #1, 12 AS NM$, 2 AS M1$, 2 AS M2$, 2 AS MR1$, 2 AS MR2$, 120 AS P$, 6 AS M2P$, 18 AS P2P$, 42 AS RP$: RETURN 2205 OPEN "r", #1, "erreur", 23: FIELD #1, 23 AS E$: RETURN 2206 GOSUB 2205: GET #1, ERE%: Z$ = E$: CLOSE #1: RETURN 2207 IF ERE% > 18 THEN GOSUB 2205: LSET E$ = MKI$(ERE%) + SPACE$(21): PUT #1, 1: CLOSE #1: RETURN ELSE RETURN 2210 GOSUB 2198 2225 FOR K% = 1 TO 100: GET #1, (METI - 1) * 100 + K%: 㐞 K1(K%) = CVS(A2$): NEXT K% 2240 CLOSE #1: RETURN 2245 OPEN "r", #1, "nameth", 105: FIELD #1, 105 AS DH$: GET #1, 34: ENT$ = DH$: MID$(ENT$, 57, 2) = MKI$(ENTET%): LSET DH$ = ENT$: PUT #1, 34: CLOSE #1: RETURN 2250 GOSUB 593: GOSUB 2285: KEY(4) ON: ON KEY(4) GOSUB 2270 2255 FOR WTY = 1 TO 9: SOUND 2000, 20: FOR WBV = 1 TO 4000 2257 IF AIGUILLAGE = 8 THEN WTY = 9: WBV = 4000: GOSUB 1525 2258 NEXT WBV: NEXT WTY 2265 RETURN 2270 IF AIGUILLAGE <> 0 THEN RETURN ELSE AIGUILLAGE = 8: RETURN 2275 L = 20: C(㐞 2) = 38: A$ = SPACE$(6): C(1) = 40: A3$ = " ": GOSUB 1527: RETURN 2280 GOSUB 2193: LSET T1$ = MKS$(CHANGE): PUT #1, 21: CLOSE #1: RETURN 2285 L = 20: C(2) = 38: A$ = "Change": C(1) = 40: A3$ = "F4": GOSUB 1527: RETURN 2290 OPEN "r", #1, FIL$, 14: FIELD #1, 2 AS F1$, 2 AS F2$, 2 AS F3$, 2 AS F4$, 2 AS F5$, 2 AS F6$, 2 AS F7$: RETURN 2300 GOSUB 2290 2305 V$ = MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) 2310 FOR TY% = 1 TO 50: LSET F1$ = V$: PUT #1, TY%: NEXT TY%: CLOSE #1: RETUR㐞 N 2320 BLANC = 0: IF AIG2 < 17 THEN LPRINT "C" + RIGHT$(STR$(AIG2), 1); ELSE LPRINT STR$(AIG2 - 16); 2325 TES = PL(AIG2)':IF PRED<>0 AND AIG2<17 THEN TES=PL(PLP(AIG2)) ':IF TES=251 AND AIG2<17 THEN LPRINT TAB(6) "Stat";:KI%=1:GOTO 2367 2330 IF TES = 251 THEN LPRINT TAB(5); "Sample X"; : KI% = 1: GOTO 2367 2335 IF TES = 253 THEN LPRINT TAB(5); "QC 1"; : KI% = 1: GOTO 2367 ELSE IF TES = 252 THEN LPRINT TAB(5); "QC 2"; : KI% = 1: GOTO 2367 2340 IF TES < 251 THEN LPRINT TAB(5); PAT$(AIG2); : KI% = 1: GO㐞 SUB 15000: GOTO 2367 2345 IF TES <> 254 THEN 2367 2350 IF AIG2 = K1(76) THEN LPRINT TAB(5); "CAL. CONT 1"; : KI% = 1: GOTO 2367 2355 IF AIG2 = K1(77) THEN LPRINT TAB(5); "CAL. CONT 2"; : KI% = 1: GOTO 2367 2360 IF AIG2 = 1 THEN LPRINT TAB(5); "Blank"; : BLANC = 1: GOTO 2367 2365 LPRINT TAB(5); "STD"; : GOSUB 2375: GOSUB 2385 2367 IF P2(AIG2) AND 2 ^ 3 THEN LPRINT TAB(18); "ANALYS. ERROR": GOSUB 2372: IF AIG2 = 1 THEN RBL = 1: GOSUB 1482 2368 IF P2(AIG2) AND 2 ^ 14 THEN LPRINT TAB(18); "OVERFLOW": IF 㐞 AIG2 = 1 THEN RBL = 1: GOSUB 1482 2369 IF BLANC <> 0 AND ABS(K1(81)) <> 4 AND (ABS(S!(LE(DE)) - S!(LE(PE))) > ABS(K1(81))) THEN LPRINT TAB(18); "BLANK ABS VARIATION"; : BLANC = 2: RBL = 1: GOSUB 1482 2370 RETURN 2372 IF WPERTE = 1 THEN LPRINT TAB(19); "CHARACTER LOST" ELSE IF WPERTE = 2 THEN LPRINT TAB(19); "DIFFERENT ANSWERS" 2373 RETURN 2375 IF K1(1) = 0 THEN NB = 1: RETURN 2377 FOR BV% = 1 TO K1(1) + BLACOR: IF K1(63 + BV%) = AIG2 THEN NB = BV%: BV% = K1(1) + BLACOR 2380 NEXT BV%: RETURN 2385 LPR㐞INT STR$(K1(6 + NB)); : RETURN 2400 IF RBL <> 0 AND AIG2 > 16 THEN LPRINT " RBL"; : P2(AIG2) = P2(AIG2) OR (2 ^ 5 + 2 ^ 13) 2402 RETURN 2410 GOSUB 2415: GOSUB 2430: GOTO 2435 2415 RESTORE 2440: FOR TY% = 1 TO PTREM: READ FIL$: NEXT TY% 2420 GOSUB 2290 2425 RETURN 2430 FOR IND = 1 TO 50: GET #1, IND: PL(IND) = CVI(F1$): PLP(IND) = CVI(F2$): PLM(IND) = CVI(F4$): PLPM(IND) = CVI(F5$) 2432 NEXT IND: CLOSE #1: RETURN 2435 GOSUB 2200 2436 GET #1, UNE: FOR IND = 1 TO 48: PLACE(IND) = CVI(MID$(FF$, (IND *㐞 2) - 1, 2)): NEXT IND 2437 CLOSE #1: RETURN 2440 DATA tray11,tray12,tray13,tray14,tray21,tray22,tray23,tray24 2450 GOSUB 2194 2460 FOR IND = 1 TO 60: LSET P1$ = MKI$(PAR(IND)): PUT #1, IND 2475 NEXT IND: CLOSE #1: RETURN 2480 'GOSUB 592:LOCATE 24,35:PRINT "PLEASE WAIT ";:LOCATE 19,1:GOSUB 593:RETURN 2500 RB$ = "": TROUVE = 0: PASSE = 0: IF K1(6) = 1 AND K1(30) = 0 AND J = 0 THEN S!(J) = 0: RETURN 2501 GOSUB 20000:GET#4,CUVE 'PASSE = PASSE + 1: WV = CUVE: GOSUB 1100: Q$ = "DOC": QP$ = Q$ + V$ + CHR㐞$(13) + CHR$(10): GOSUB 2055: GOSUB 2100 2502 'MINI = 6: IF LEFT$(R$, 3) <> "DOC" THEN 2503 ELSE TOP = 4: ARRIV$ = ",": GOSUB 2040: IF VAL(ARR$) <> CUVE THEN 2503 ELSE TOP = ARRIV + 2: ARRIV$ = CHR$(13): GOSUB 2040: IF (VAL(ARR$) < J AND INVEST = 0) OR ARR$ = "X" THEN 2503 ELSE 2505 2503 'IF PASSE < MINI THEN FOR WTY = 1 TO 1500: NEXT WTY: GOTO 2501 ELSE IF INVEST = 0 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 3 2504 'S!(J) = 0: TROUVE = 1: RETURN 2505 'IF VAL(ARR$) >= J THEN TROUVE = 1 ELSE RETURN 2506 AB=CVS(MI㐞D$(LECUV$,(J*4)-3,4)):AB$=STR$(AB) 'WV = J: GOSUB 1100: Q$ = "ABC": QP$ = Q$ + V$ + CHR$(13) + CHR$(10): GOSUB 2055: GOSUB 2100 2507 'MINI = 11: IF LEFT$(R$, 3) <> "ABC" THEN 2503 ELSE TOP = 4: ARRIV$ = ",": GOSUB 2040: IF VAL(ARR$) <> CUVE THEN 2503 ELSE TOP = ARRIV + 2: ARRIV$ = ",": GOSUB 2040: IF VAL(ARR$) <> J THEN 2503 2508 'TOP = ARRIV + 2: AB$ = MID$(R$, TOP, (LEN(R$) - 1 - TOP)): IF (AB$ = "::::::" OR AB$ = ";;;;;;" OR AB$ = "======") THEN WABSO = 3.3: GOTO 2517'PASSE=MINI:GOTO 2503 2509 'ZE = 0㐞: PT = 0: FOR G = 1 TO LEN(AB$): IF MID$(AB$, G, 1) = CHR$(46) OR (MID$(AB$, G, 1) > CHR$(47) AND MID$(AB$, G, 1) < CHR$(58)) THEN 2510 ELSE ZE = 1 2510 'IF MID$(AB$, G, 1) = CHR$(46) THEN PT = PT + 1 2512 'NEXT G: IF (PT <> 1 AND VAL(AB$) = 0) OR PT > 1 THEN ZE = 1 2513 'IF ZE THEN S!(J) = 0: GOTO 2503 2514 'IF LEN(AB$) <> 6 THEN WABSO = 0: LPRINT "PERTE DE CARACTERES :"; R$; AB$: IF INVEST = 0 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 3: WPERTE = 1: GOTO 2522 2515 'WABSI = VAL(AB$): IF WABSI = 0 THEN WABSO = 0㐞: GOTO 2517 ELSE IF WABSI > 1584.9 THEN WABSO = 3.3: GOTO 2517 2516 'WABSO = (LOG(WABSI) / 2.302585) 2517 'IF RB$ = "" THEN RB$ = R$: FOR IYU = 1 TO 500: NEXT IYU: GOTO 2506 ELSE IF R$ <> RB$ THEN WABSO = 0: LPRINT "REPONSES DIFFERENTES :"; RB$; R$: IF INVEST = 0 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 3: WPERTE = 2: WABSO = 0 2520 'IF WABSO > 3.2 THEN WABSO = 3.2: IF INVEST = 0 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 14 2522 TROUVE=1:S!(J) = AB:CLOSE#4: RETURN 2525 IF RAJ THEN RETURN 2540 GOSUB 1080: IF AJUMP THEN A㐞JUMP = 0: GOTO 2560 2541 GOSUB 875: IF MESS = 0 AND ANAST <> 0 THEN 2550 ELSE IF MESS$ <> MESB$ AND PAR(17) = 0 THEN COLOR 5, 0: LOCATE 20, 27: PRINT SPACE$(7): LOCATE 21, 28: PRINT SPACE$(2): KEY(3) OFF: COLOR 1, 2: LOCATE 25, 25: PRINT SPACE$(30); : LOCATE 19, 1: _ MESB$ = MESS$ 2542 IF PAR(37) = 4 THEN 2550 2543 IF VAR <> 0 OR ATTEN = 1 THEN 2545 2544 IF PASUI OR ANAST THEN 2550 2545 IF MID$(R$, 6, 1) = "1" THEN ADTER = 1 2550 'IF VAL(MID$(R$,12,2))>50 THEN PLUS=.1 ELSE PLUS=0 2555 WTEMPER = 㐞VAL(MID$(R$, 8, 4)): IF WTEMPER < 1 THEN 2557 2556 TEMPER$ = MID$(STR$(WTEMPER), 2, 4) 2557 IF ANAST THEN 2559 2558 AFTEM = AFTEM + 1: GOSUB 592: IF AFTEM = 1 AND ADTER = 0 AND METI THEN GOSUB 2193: LSET T1$ = TEMPER$: PUT #1, (PAR(19 + (3 * PAR(37))) AND 31): CLOSE #1 2559 COLOR 1, 2: IF WTEMPER > 1 THEN LOCATE 23, 64: PRINT USING "##.#"; WTEMPER 2560 GOSUB 593: RETURN 2635 STATUS = 0: GOSUB 820: DEMET = 0: PAR(50) = 0: PAR(51) = 0: GOSUB 4000: FOR BV% = 54 TO 56: PAR(BV%) = 0: X = BV%: GOSUB 2158: N㐞 EXT BV%: IF PAR(17) THEN GOSUB 1948 2637 PAR(17) = 0: X = 17: GOSUB 2158: ERE% = 0: GOSUB 2205: LSET E$ = MKI$(0) + SPACE$(21): PUT #1, 1: CLOSE #1 2640 AIG1 = 0: GOTO 610 2761 IF PAR(37) <> 0 THEN PTREM = PAR(20 + (3 * PAR(37))) AND 15: GOTO 2763 ELSE IF MEP = PAR(8) THEN POINTE = 1 ELSE POINTE = 2 2762 PTREM = PAR(11 + POINTE) + (4 * (POINTE - 1)) 2763 GOSUB 2415: GOSUB 2430: RETURN 3300 IF K1(58) THEN PRED = 1 ELSE PRED = 0 3305 RETURN 3320 IF K1(6) = 3 OR K1(6) = 12 THEN DERN = 23 ELSE DERN = 3 㐞 3325 FOR TY% = 1 TO DERN 3330 IF LE(TY%) <> 0 THEN DERLEC = LE(TY%): ENZ% = DERLEC ELSE TY% = DERN 3335 NEXT TY%: RETURN 3340 P3! = P3!(AIG2): DECIB = DECI: GOSUB 3350: IF P3! < 0 AND DECIB > 0 THEN DECIB = DECIB - 1 3341 IF DECIB = 0 AND P3! >= 0 THEN LPRINT TAB(18); USING "#######"; P3!; ELSE IF DECIB = 1 THEN LPRINT TAB(18); USING "#####.#"; P3!; ELSE IF DECIB = 2 THEN LPRINT TAB(18); USING "####.##"; P3!; ELSE IF DECIB = 3 THEN LPRINT TAB(18); USING _ "###.###"; P3!; ELSE 3343 3342 RETURN 3㐞343 IF DECIB = 0 AND P3! < 0 THEN LPRINT TAB(18); USING "#######"; P3!; ELSE IF DECIB = 4 THEN LPRINT TAB(18); USING "##.####"; P3!; ELSE IF DECIB = 5 THEN LPRINT TAB(18); USING "#.#####"; P3!; ELSE LPRINT TAB(18); USING ".######"; P3!; 3344 RETURN 3350 IF ABS(P3!) / 10 ^ (6 - DECIB) < 1 THEN RETURN ELSE DECIB = DECIB - 1: GOTO 3350 3400 GOSUB 592: IF AIGUILLAGE <> 1 THEN LOCATE 24, 27: PRINT " Absorbance file update "; : LOCATE 19, 1 3405 RAJ = 1: GOSUB 593: REMET = 0: RETURN 3422 CUVE = PLACE(㐞AIG2) 3424 GET #1, EN%: BU$ = A1$ 3425 INVEST = 1: FOR LI = 1 TO DERLEC: IF AIGUILLAGE = 3 AND DEJARET = 0 THEN GOSUB 1948: DEJARET = 1 3430 J = LI: GOSUB 2500: IF TROUVE = 0 OR ZE = 1 THEN S!(J) = 0 3431 MID$(BU$, 3 + (LI - 1) * 2, 2) = MKI$(S!(J) * 10000) 3432 NEXT LI: INVEST = 0 3433 IF HCAL AND (K1(6) = 3 OR K1(6) = 12) THEN MID$(BU$, 97, 2) = MKI$(1) ELSE MID$(BU$, 97, 2) = MKI$(0) 3435 LSET A1$ = BU$: PUT #1, EN% 3466 CLOSE #1: GOSUB 592: IF AIGUILLAGE <> 1 THEN GOSUB 34: LOCATE 19, 1 3㐞468 RAJ = 0: GOSUB 593: RETURN 3470 GOSUB 594: GOSUB 3400: GOSUB 2195: IF RELU = 0 THEN GOSUB 3320: RELU = 1 3475 MEC = METI: IF METP THEN MEC = MEC + (METP - 20) * 32 3480 MEC = MEC + (((PAR(23) AND 496) / 16) * 512): ITPE = PAR(23) AND 15 3481 IF (PAR(41 + ITPE) AND 256) THEN MEC = MEC + 16384 3482 IF (PAR(41 + ITPE) AND 512) THEN MEC = -MEC 3485 FOR ET% = 1 TO (O2 / 16): GET #1, ET% 3487 FOR NUM = 0 TO 15: ME = CVI(MID$(A1$, 1 + (NUM * 6), 2)) 3489 IF ME THEN 3499 3492 BU$ = A1$: MID$(BU$, 1 + (㐞NUM * 6), 2) = MKI$(MEC) 3493 MID$(BU$, 3 + (NUM * 6), 2) = MKI$(LE(1) + (DERLEC * 256)) 3496 LSET A1$ = BU$: PUT #1, ET%: CLOSE #1: PAR(52) = PAR(52) + 1: X = 52: GOSUB 2158: GOSUB 2195: GOTO 3525 3499 IF ME <> MEC THEN 3520 3500 EN% = (((ET% - 1) * 16 + NUM) * 48) + 4 + AIG2 3511 GET #1, EN%: BU$ = A1$: IF ASC(LEFT$(BU$, 1)) <> AIG2 THEN 3517 ELSE IF PL(AIG2) = 254 THEN GOSUB 3540: LSET A1$ = BU$: PUT #1, EN%: CUVE = PLACE(AIG2): GOTO 3424 3517 GOTO 3525 3520 NEXT NUM 3522 NEXT ET% 3525 GOSUB 354㐞0 3527 EN% = (((ET% - 1) * 16 + NUM) * 48) + 4 + AIG2 3530 LSET A1$ = BU$: PUT #1, EN% 3535 GOSUB 3422 3537 RETURN 3540 BU$ = CHR$(AIG2) + CHR$(PL(AIG2)) + SPACE$(96) + MKI$(P2(AIG2)) + MKS$(P3!(AIG2)) + MKI$(0): RETURN 3550 DERL = DERLEC: CUVE = DCUVE: RAJ = 1: IF K1(6) = 3 OR K1(6) = 12 THEN DERL = ENZ% 3552 FOR LEC = 1 TO DERL: IF LE(LEC) = 0 THEN LEC = DERL: GOTO 3590 3555 J = LE(LEC): GOSUB 2500 3562 GOSUB 10500: GOSUB 3565: GOTO 3590 3565 IF LE(LEC) < 10 THEN 3575 3570 A = A + 1: LPRINT "AB㐞S("; LE(LEC); ") ="; USING "##.####"; S!(LE(LEC)); : IF A = 1 THEN LPRINT "": GOTO 3580 ELSE 3577'LPRINT TAB(25) "diff = ";:LPRINT USING "##.####";(S!(LE(LEC))-S!(PREC)):GOTO 3580 3575 A = A + 1: LPRINT "ABS( "; LE(LEC); ") ="; USING "##.####"; S!(LE(LEC)); : IF A = 1 THEN LPRINT "": GOTO 3580 3577 LPRINT TAB(25); "diff = "; : LPRINT USING "##.####"; (S!(LE(LEC)) - S!(PREC)) 3580 PREC = LE(LEC) 3582 RETURN 3590 NEXT LEC 3625 TRUC = 0: RAJ = 0: RETURN 3980 GOSUB 2198: GET #1, (MENE - 1) * 100 + 20: FT㐞EMP = CVS(A2$): GET #1, (MENE - 1) * 100 + 21: FLOON = CVS(A2$): CLOSE #1: RETURN 3982 GOSUB 592: TB = 1: Q$ = "TOK": GOSUB 1949: GOSUB 593: RETURN 3985 TOK = 1: RETURN 3990 IF PAR(17) THEN TB = 1: RETURN 3991 IF VOY > 1 THEN VOY = 1 ELSE SOUND 2500, 200: L = 20: C(2) = 3: A$ = "Temp.": C(1) = 5: A3$ = "F1": GOSUB 1527: GOSUB 593: GOSUB 3985 3992 RETURN 3995 PAR(50) = K1(20): PAR(51) = K1(21): GOSUB 4000: RETURN 4000 X = 50: GOSUB 2158: X = 51: GOSUB 2158: RETURN 4005 ' 4010 ' 4025 ' 4030 ' 4035㐞  ' 4075 ' 4085 ' 4090 ' 4095 ' 4100 ' 4110 ' 4120 ' 4135 ' 4140 ' 4141 ' 4142 ' 4145 ' 4150 ' 4155 ' 4157 ' 4158 ' 4160 ' 4161 ' 4162 ' 4165 ' 4167 ' 4168 ' 4170 ' 4175 ' 4177 ' 4178 ' 4180 ' 4185 ' 4190 ' 4200 ' 4205 IF DAC = 0 THEN GOSUB 34: VA = 0 ELSE VA = 1 4210 RETURN 4212 GOSUB 2193: LSET T1$ = MKS$(REVOI): PUT #1, 42: CLOSE #1: RETURN 4215 ' 4220 ' 4225 L = 20: C(2) = 2: A$ = SPACE$(9): C(1) = 4: A3$ = " ": GOSUB 1527: C(2) = 13: C(1) = 17: GOSUB 1527: LOCATE 1㐞9, 10: PRINT SPACE$(7): KEY(1) OFF: KEY(2) OFF: RETURN 4226 L = 20: C(2) = 72: A$ = SPACE$(8): C(1) = 74: A3$ = " ": GOSUB 1527: RETURN 4230 MAJECR = 0: IF (AIG3 AND 255) > 48 THEN GOSUB 1470 4233 GOTO 4500 4240 REMET = 0 4241 REMET = REMET + 1: IF REMET MOD (4) = 1 THEN GOSUB 2525: REMET = 1 4242 GOSUB 850: MUSIC = MUSIC + 1: IF ERREUR% <> 0 AND ECRANAB% = 0 THEN GOSUB 1350 ELSE IF PAR(17) = 0 OR AIGUILLAGE = 3 THEN 4244 4243 IF AIGUILLAGE = 4 THEN GOSUB 1280: GOSUB 1200: PAS = 16: GOTO 675 ELSE 42㐞92 4244 IF ADTER = 1 AND PAR(40) <> 0 AND ((PAR(21 + (3 * PAR(37))) AND 16128) / 256 = 49) AND CHANGE = 0 THEN GOSUB 1485 4245 IF PAR(34) = 64 OR PAR(37) = 4 OR PAR(17) <> 0 OR PASUI <> 0 OR ATTEN <> 0 THEN 4260 4246 IF ETP% = 4 AND AIG3 = K1(64) THEN 4260 4250 IF ADTER = 1 AND MENE <> 0 THEN GOSUB 592: GOTO 1870 4260 IF AIGUILLAGE = 3 THEN GOSUB 1948: AIGUILLAGE = 0: GOSUB 1350: GOTO 4292 4265 IF AIGUILLAGE = 8 THEN KEY(4) OFF: CHANGE = 4: GOSUB 1525: GOSUB 2275: GOSUB 2280: AIGUILLAGE = 0 4270 IF E㐞TP% = 4 AND AIG3 = K1(64) THEN 4290 ELSE IF AIGUILLAGE = 1 AND RAJ = 0 THEN 4275 ELSE 4290 4275 GOSUB 1300 4280 GOSUB 592: ON LIGNE GOTO 615, 680, 670, 615, 620, 696, 1855, 1865, 675, 4285 4285 GOSUB 1950 4290 IF MAJECR = 0 THEN INVEST = 1: J = 1: GOSUB 594: GOSUB 2500: IF TROUVE <> 0 AND PAR(17) = 0 THEN LIGNE = 9: GOSUB 1470 4291 IF MAJECR = 0 THEN FOR WYU = 1 TO 1500: NEXT WYU 4292 IF (CUVE > PAR(54) AND PAR(17) = 2) THEN 4297 ELSE IF K1(6) = 3 OR K1(6) = 12 THEN ADE = LE(DE) ELSE ADE = DE 4293 IN㐞VEST = 1: J = ADE: GOSUB 2500: INVEST = 0: IF TROUVE THEN GOSUB 8000: GOTO 4800 4295 IF PAR(17) = 0 OR (PAR(17) = 2 AND CUVE <= PAR(54)) THEN FOR WYU = 1 TO 2000: NEXT WYU: GOTO 4241 4296 IF REVOI <> 0 AND ALLE = 0 THEN BUT = 45: GOTO 625 4297 IF AIGUILLAGE = 3 THEN GOSUB 1948 4298 GOSUB 1200: PAS = 32: GOTO 675 4300 GOTO 4800 4350 FOR NE = 1 TO K1(1) + BLACOR 4355 IF K1(63 + NE) = 0 THEN 4370 4360 IF AIG3 <> K1(63 + NE) THEN 4370 4365 IF NE = 1 THEN AIG3 = 0 ELSE AIG3 = K1(63 + NE - 1) 4367 GOTO 㐞4380 4370 NEXT NE: IF AIG3 = K1(76) OR (AIG3 = K1(77) AND K1(76) = 0) THEN AIG3 = K1(63 + K1(1) + BLACOR): GOTO 4380 4375 IF AIG3 = K1(77) THEN AIG3 = K1(76) 4380 RETURN 4500 IF (AIG3 = 0) AND (LIMI = 1) THEN 4550 4502 IF (AIG3 AND 255) < LIMI THEN 4806 4504 IF (AIG3 AND 255) >= LIMI1 THEN 4830 4506 IF AIG3 < 256 THEN 4650 ELSE 4808 4550 IF K1(6) > 2 THEN 4560 4552 IF CALIB THEN STANDA = K1(1): CUVE = PLACE(K1(63 + STANDA)): ETP% = 1: GOTO 4240 4554 IF COEF THEN CUVE = PLACE(1): K1(64) = 1: ETP% 㐞= 3: GOTO 4240 4556 IF BLACOR = 1 THEN CUVE = PLACE(1): ETP% = 2: GOTO 4240 ELSE 4800 4560 IF K1(6) = 3 OR K1(6) = 12 THEN CUVE = PLACE(1): ETP% = 1: GOTO 4240 4562 'IF K1(6)=4 THEN CUVE=PLACE(2):ETP%=1:GOTO 4240 4580 IF AIG3 < 256 THEN AIG2 = AIG3 4590 CUVE = PLACE(AIG3): ETP% = 4: GOTO 4240 4600 IF AIG3 THEN 4650 4601 'GOSUB 1330:IF TITR THEN IF K1(6)=3 OR K1(6)=12 THEN GOSUB 6010 4602 IF K1(6) = 3 OR K1(6) = 12 THEN 4610 4604 IF CALIB THEN AIG3 = K1(64): GOTO 4580 4606 IF COEF THEN AIG3 = K1(㐞64): GOTO 4580 ELSE 4666 4610 AIG3 = 1: GOTO 4580 4615 IF CALIB THEN AIG3 = 1: GOTO 4580 4650 IF K1(6) = 3 OR K1(6) = 12 THEN 4666 4652 'IF (K1(6)=4) AND (AIG3=1) THEN AIG3=2:GOTO 4580 4654 'IF K1(6)=4 THEN 4666 4656 IF CALIB = 0 THEN 4666 4658 NE = 1: IF AIG3 = 0 THEN AIG3 = K1(64): GOTO 4580 4660 IF AIG3 = K1(63 + NE) THEN 4670 4662 NE = NE + 1: IF NE <= K1(1) THEN 4660 4664 IF AIG3 <> K1(76) THEN 4668 4665 IF PL(K1(77)) = 254 OR (PL(K1(77)) = 255 AND PL(PLP(K1(77))) = 254) THEN AIG3 = K1(77㐞): GOTO 4580 4666 AIG3 = 256 + 16: GOTO 4806 4668 IF AIG3 = K1(77) THEN 4666 4670 IF NE < K1(1) THEN AIG3 = K1(64 + NE): GOTO 4580 4672 IF PL(K1(76)) = 254 OR (PL(K1(76)) = 255 AND PL(PLP(K1(76))) = 254) THEN AIG3 = K1(76): GOTO 4580 4675 IF PL(K1(76)) = 0 AND PL(K1(77)) = 0 THEN 4666 ELSE IF PL(K1(76)) = 0 THEN 4665 4800 AUTRE = 0: IF CALF = 0 OR ALLE = 1 THEN 4801 ELSE GOSUB 4110: IF AUTRE THEN GOSUB 2193: LSET T1$ = MKS$(1): PUT #1, 41: CLOSE #1: AIG3 = 1: BUT = 45: GOTO 625 ELSE 4830 4801 IF REVO㐞 I <> 0 AND ALLE = 0 AND (AIG3 AND 255) = CALCONT THEN BUT = 45: GOTO 625 4802 IF AIG3 < 256 THEN 4600 4804 IF (AIG3 AND 255) <> AIG2 THEN 4812 4805 IF (AIG3 AND 255) = 48 THEN 4830 4806 IF (AIG3 AND 255) <> 48 THEN AIG3 = AIG3 + 1 4808 IF (AIG3 AND 255) < LIMI THEN 4806 4810 IF (AIG3 AND 255) >= LIMI1 THEN 4830 4812 AIG2 = AIG3 AND 255: IF PL(AIG2) = 0 OR PLACE(AIG2) = 0 OR PL(AIG2) = 254 THEN 4804 ELSE CUVE = PLACE(AIG2): ETP% = 4: GOTO 4240 4830 IF PAR(37) = 1 THEN COLOR 5, 0: LOCATE 25, 70: PRINT㐞 SPACE$(11); : LOCATE 24, 70: PRINT SPACE$(11); : COLOR 1, 2 4835 IF LIMI1 = 49 THEN AIG3 = AIG3 + 1 4838 KEY(4) OFF: GOSUB 2275: GOTO 6050 4845 NOEUD = 1: ENTET% = 0: GOSUB 2245: BLACOR = 0: SSBLK = 0: FOR TY% = 1 TO 48: P2(TY%) = 0: NEXT TY%: AIG2 = 0: AIG3 = 0: IF PAR(17) = 0 THEN FOR TY% = 12 TO 15: LOCATE TY%, 8: PRINT SPACE$(35): NEXT TY% 4846 IF PAR(37) > 1 OR (PAR(37) = 1 AND PAR(57) = 0) THEN GOSUB 4970: IF FINI THEN 675 ELSE 4980 4847 IF ATTEN THEN GOSUB 3980: PAR(50) = FTEMP: PAR(51) = FLOON㐞: X = 50: GOSUB 2158: X = 51: GOSUB 2158: TEMPOK = 30 + (7 * (PAR(50) - 1)): GOTO 1870 ELSE IF PAR(40) <> 0 AND PAR(57) = 0 THEN 1870 ELSE IF PAR(57) THEN 4849 ELSE 2635 4849 IF PAR(17) THEN GOSUB 1200: PAS = 32: GOTO 675 ELSE BUT = 0: VER = 0: GOTO 690 4850 UNE = 1: GOSUB 4851: GOTO 4853 4851 GOSUB 2199: GET #1, UNE 4852 FOR IND = 1 TO 48: LE(IND) = CVI(MID$(FF$, (IND * 2) - 1, 2)): NEXT IND: CLOSE #1: RETURN 4853 DEMET = (PAR(22) AND 15360) / 1024: CALIB = 0 4854 METI = PAR(22) AND 31: METP = (PAR(2㐞2) AND 992) / 32 4855 LIMI = PAR(24) AND 255: LIMI1 = (PAR(24) AND 16128) / 256 4856 ADTER = 0: PASUI = 1':IF METP=0 THEN 4861 4857 MENE = 0: IF PAR(40) THEN GOSUB 2162: GET #1, (PAR(19 + (3 * (PAR(37)))) AND 992) / 32: NMLI$ = ST$ ELSE 4859 4858 MENE = VAL(MID$(NMLI$, (PAR(40) * 3) - 1, 2)): CLOSE #1 4859 IF MENE AND PAR(37) < 4 THEN PASUI = 0 ELSE VAR = 1 4860 IF PAR(34) = 64 THEN PASUI = 1: VAR = 1: GOTO 4865 4861 LIMI2 = (PAR(21 + (3 * PAR(37))) AND 16128) / 256':IF (PAR(20)+(3*PAR(37))) AND 2^13㐞 THEN ADTER=1:GOTO 4865 4862 IF LIMI2 <> 49 OR (PAR(52) + PAR(37)) = O2 THEN PASUI = 1: VAR = 0: GOTO 4865 4863 IF METP = 0 THEN VAR = 1 4865 PTREM = PAR(23) AND 15: UNE = 1: GOSUB 2410 4870 GOSUB 2170: GOSUB 2210 4871 GOSUB 2201: GET #1, METI: QCB! = CVS(QL1$): TOLB! = CVS(QL2$): QCH! = CVS(QH1$): TOLH! = CVS(QH2$): CLOSE #1 4872 IF DEMET = 1 OR METP = 0 THEN GOSUB 3995: TEMPOK = 30 + (7 * (PAR(50) - 1)) 4873 IF MENE <> 0 AND PAR(57) = 0 THEN GOSUB 3980: IF FTEMP <> PAR(50) OR FLOON <> PAR(51) THEN 㐞ATTEN = 1 4874 GOSUB 1510: IF CHANGE = 1 OR CHANGE = 3 THEN CHANGE = 0 4875 OPEN "r", #3, "descpai", 128: FIELD #3, 128 AS CHAMP$ 4880 GET #3, 1: PARPAT$ = CHAMP$ 4895 GOSUB 2202 4905 FOR IND = 1 TO 48: IF PLACE(IND) = 0 THEN 4925 4906 IF IND = 1 AND (K1(6) > 2 OR BLACOR = 1 OR K1(33) <> 0) THEN PL(1) = 254 4910 TES = PL(IND) 4915 IF TES > 250 OR TES = 0 THEN 4925 4917 WBV = ASC(MID$(PARPAT$, TES, 1)): GET #1, WBV: PAT$(IND) = NM$ 4925 NEXT IND: CLOSE #1: CLOSE #3: BUT = 10: DEV% = 52 4926 IF MET㐞P THEN MEP = METP ELSE MEP = METI 4927 IF PAR(17) THEN ADTER = 1 4928 IF METP THEN BUT = 15 4929 GOSUB 2193: GET #1, 46: RBL = CVS(T1$): CLOSE #1 4930 SAUTCC = 1 4932 CALIB = 0: COEF = 0: WBLACORI = 0: WBLACORF = 0: WBLAB = 0: REVOI = 0: DAC = 0: REFU = 0: GOSUB 1981 4933 VOY = 0: TOK = 0'IF CHCAL AND ((AIG3 AND 255)>=LIMI1 OR (AIG3 AND 255)=49) AND K1(6)<3 THEN AFFICH=(2^9)-1:BUTEB=8:GOSUB 1715:GOSUB 593:GOTO 7165 4934 TB = 0: GOSUB 1190: IF TE$ = "0" OR TE$ = "" OR TE$ = CHR$(0) THEN 4935 ELSE IF T㐞E$ = "2" OR MID$(R$, 8, 2) = "00" THEN GOSUB 4950: GOTO 4934 ELSE VOY = VOY + 1: GOSUB 3990: IF TOK THEN GOSUB 3982 ELSE IF TB = 0 THEN GOSUB 4950: GOTO 4934 4935 KEY(1) OFF: BUTEH = 1: GOSUB 4225: GOSUB 592: GOTO 5000 4950 FOR WYU = 1 TO 4000: NEXT WYU: RETURN 4970 FINI = 0: IF PAR(17) = 0 THEN 4975 4973 IF PAR(17) = 4 OR (PAR(17) = 2 AND PAR(54) <= DERRES) THEN PAR(54) = 1: FINI = 1: PAS = 32: CHANGE = 0: GOSUB 2280: GOSUB 1175 4975 RETURN 4980 GOSUB 592: IF BUT = 20 THEN GOSUB 34: KEY(8) ON: GOSUB 㐞1800: GOTO 4850 4981 ' 4982 METI = PAR(22) AND 31: MEMOR$ = PA$: IF METI = 0 THEN K1(6) = 0: GOTO 4985 4983 GOSUB 2198 ' 4984 GET #1, (METI - 1) * 100 + 6: K1(6) = CVS(A2$): CLOSE #1 4985 IF K1(6) = 0 THEN GOSUB 34: MA% = 1: GOSUB 600: GOTO 2635 4986 IF K1(6) = 12 THEN 4989 ELSE ON K1(6) GOTO 4987, 4987, 4989 4987 PA$ = "calc1cp": GOTO 4995 4989 PA$ = "calc2cp" 4995 IF PA$ = MEMOR$ THEN AFTEM = 0: GOTO 4850 ELSE BUT = 20 4996 LOCATE 24, 30: PRINT SPACE$(25): WFREE = FRE(""): CHAIN PA$ 5000 GOTO 5㐞 730 5010 J = 1: IF ABS(K1(38)) = 4 THEN S!(J) = 0 ELSE GOSUB 2500 5020 WSCH = S!(J): K1(80) = WSCH: GOSUB 2198: LSET A2$ = MKS$(WSCH): PUT #1, (METI - 1) * 100 + 80: CLOSE #1: RETURN 5030 ' GOSUB 2162 5040 ' FOR TY%=1 TO 32 5050 ' GET#1,TY% 5060 ' B$(TY%)=T$ 5070 ' NEXT TY% 5080 ' CLOSE#1 5090 ' RETURN 5100 ' LPRINT "SAMPLE "+STR$(AIG2)+" MEASURE "+STR$(CUVE)+" SUBSTRAT DEPLETED" 5110 ' RETURN 5115 IF S!(J) * SGN(K1(35)) > K1(35) THEN P2(AIG2) = P2(AIG2) OR 2 ^ 5: RBL = 1 5117 RETURN 5120 IF A㐞BS(K1(38)) = 4 THEN 5160 5130 J = 1: GOSUB 2500 5140 WDABSI = S!(J) - WSCH 5150 IF WDABSI * SGN(K1(38)) > K1(38) AND ABS(K1(38)) <> 4 THEN P2(AIG2) = P2(AIG2) OR 128 5160 FOR TY% = PE TO DE 5170 J = LE((RECAL * 23) + TY%) 5180 GOSUB 2500 5190 IF AIG2 <> K1(64) OR ABS(K1(35)) = 4 THEN 5210 5200 GOSUB 5115 5210 IF WDABSI < 0 OR WDABSI < K1(38) OR ABS(K1(46)) = 4 OR ABS(K1(38)) = 4 THEN WDABSI = 0 5220 IF S!(J) * SGN(K1(46)) > K1(46) + (WDABSI * SGN(K1(46))) THEN 5240 5230 NEXT TY% 5240 N = TY% - 1㐞 5250 WMIN = 6.5E-07 * K1(47 + (RECAL * 35)) ^ 2 5255 IF K1(6) = 3 THEN LGMIN = 3 ELSE LGMIN = 6 5260 IF N - PE < LGMIN - 1 AND ABS(K1(46)) <> 4 THEN P2(AIG2) = P2(AIG2) OR 2 ^ 10 5270 IF N - PE < LGMIN - 1 AND RECAL THEN 5690 ELSE IF N - PE < 2 THEN 5580 5280 IF RECAL THEN LPRINT " HA": HCAL = 1 5285 IF K1(6) = 12 THEN NB = N: GOSUB 9095: GOTO 5560 5290 IF N - PE > 4 THEN N = PE + 4 5300 FOR P = N - PE TO 2 STEP -1 5305 NUM = 0: IF P = 2 THEN WMIN = 3.2E-07 * K1(47 + (RECAL * 35)) ^ 2: GOTO 5310 㐞5306 IF P = 3 THEN WMIN = .0000005 * K1(47 + (RECAL * 35)) ^ 2 ELSE WMIN = 6.5E-07 * K1(47 + (RECAL * 35)) ^ 2 5310 FOR K% = PE TO N - P 5320 ON P - 1 GOTO 5330, 5350, 5370 5330 AT = 3: RESTORE 5340: GOTO 5390 5340 DATA -1,0,1 5350 AT = 4: RESTORE 5360: GOTO 5390 5360 DATA -1.5,-.5,.5,1.5 5370 AT = 5: RESTORE 5380 5380 DATA -2,-1,0,1,2 5390 WG9 = 0: WG8 = 0: WG7 = 0: WG6 = 0: WG5 = 0 5400 FOR IL = K% TO K% + P 5410 J = LE(IL + (RECAL * 23)) 5420 GOSUB 2500 5430 WG9 = WG9 + S!(J): WG8 = WG8㐞 + S!(J) ^ 2 5440 READ WG5 5450 WG7 = WG7 + S!(J) * WG5: WG6 = WG6 + WG5 ^ 2 5460 NEXT IL 5465 ' GOSUB 10000:' LPRINT "AT=";AT;" WTAM=";WTAM 5470 RESTORE 5480 5480 DATA .00000032,.0000005,.00000065 5490 FOR IL = 1 TO P - 1 5500 READ WG5 5510 NEXT IL 5520 IF P = 2 OR P = 3 THEN 5800 ELSE GOSUB 10000 5530 IF WTAM <= 6.5E-07 * K1(47 + (RECAL * 35)) ^ 2 THEN 5570 5540 NEXT K% 5550 NEXT P 5560 IF K1(6) = 3 OR (K1(6) = 12 AND LIN = 0) THEN P2(AIG2) = P2(AIG2) OR 2 ^ 9 ELSE IF K1(6) = 12 AND LIN = 㐞1 THEN P2(AIG) = P2(AIG) XOR 2 ^ 9 5570 P3!(AIG2) = K1(33) * 60 / K1(45 + (RECAL * 3)): IF K1(6) = 3 THEN P3!(AIG2) = P3!(AIG2) * WG7 / WG6 ELSE P3!(AIG2) = P3!(AIG2) * WRATE 5575 IF AIG2 < 17 OR PL(AIG2) > 251 OR PL(AIG2) = (PAR(58) AND 255) OR PL(AIG2) = (PAR(58) AND 32512) / 256 OR (P2(AIG2) AND (2 ^ 3 + 2 ^ 9 + 2 ^ 10 + 2 ^ 14)) <> 0 THEN 5580 5577 IF (P3!(AIG2) < K1(34) OR P3!(AIG2) > K1(100)) AND (K1(34) <> 0 OR K1(100) <> 0) THEN P2(AIG2) = P2(AIG2) OR 2 ^ 5 5580 IF RECAL THEN 5600 5590 RAJ = 1:㐞 IMPR = 0: GOSUB 2320: IF BLANC = 2 THEN 5595 ELSE IF (P2(AIG2) AND (2 ^ 3 + 2 ^ 14)) THEN RETURN ELSE 5600 5595 IF (P2(1) AND 2 ^ 5) <> 0 THEN LPRINT TAB(24); "RBL"; 5597 GOTO 5710 5600 P2(AIG2) = P2(AIG2) OR 2: IF (P2(AIG2) AND 2 ^ 9 + 2 ^ 10 + 2 ^ 14) OR (AIG2 = 1 AND (P2(1) AND 2 ^ 5) <> 0) THEN 5640 5610 GOSUB 3340: IMPR = 1: IF K1(6) = 12 THEN LPRINT TAB(26); LG(SEQ); "/"; JJ(SEQ); : GOTO 5630 5620 IF NUM <> 0 THEN LPRINT TAB(26); (P + 1); "/"; NUM; ELSE LPRINT TAB(26); (P + 1); "/ 1 "; 5630 IF㐞 P3!(AIG2) < VAL(NE1$) AND AIG2 > 16 THEN LPRINT TAB(36); "<"; ELSE IF P3!(AIG2) > VAL(NE2$) AND AIG2 > 16 THEN LPRINT TAB(36); ">"; ELSE LPRINT TAB(36); " "; 5635 GOSUB 2400: IF RBL THEN 5638 ELSE IF AIG2 > 16 AND (P2(AIG2) AND 2 ^ 5) <> 0 THEN LPRINT " r"; 5638 IF ((PL(AIG2) = (PAR(58) AND 255) OR PL(AIG2) = 253) AND (P3!(AIG2) < QCB! - TOLB! OR P3!(AIG2) > QCB! + TOLB!)) OR ((PL(AIG2) = (PAR(58) AND 32512) / 256 OR PL(AIG2) = 252) AND (P3!(AIG2) < QCH! - TOLH! OR P3!(AIG2) > QCH! + TOLH!)) THEN _ L㐞PRINT " *"; 5640 IF P2(AIG2) AND 1664 THEN LPRINT TAB(22); " "; 5650 IF (P2(AIG2) AND 2 ^ 5) <> 0 AND AIG2 = 1 THEN LPRINT TAB(23); " RBL"; 5665 IF (P2(AIG2) AND 2 ^ 9) <> 0 THEN LPRINT " NL"; 5667 'IF (P2(AIG2) AND 2^14)<>0 THEN LPRINT TAB(24) "OVERFLOW" 5670 IF (P2(AIG2) AND 2 ^ 7) <> 0 AND RBL = 0 THEN LPRINT " SIC"; 5680 IF (P2(AIG2) AND 2 ^ 10) = 0 THEN 5710 ELSE LPRINT " DES"; 5690 IF K1(48) = 0 OR RECAL = 1 THEN GOTO 5710 5700 RECAL = 1: P2(AIG2) = P2(AIG2) AND 31231: GOTO 5120 5710 NUM = 0:㐞  LPRINT : IF IMPR = 0 THEN NONL$ = NONL$ + STR$(AIG2) + "."'IF (P2(AIG2) AND (2^7+2^9+2^10))<>0 OR RECAL OR (RBL=1 AND AIG2=1) THEN NONL$=NONL$+STR$(AIG2)+"." 5715 RECAL = 0: IF RBL = 1 AND AIG2 = 1 THEN LPRINT "Unusable Blank" 5720 RETURN 5730 'BUTEB=7 5740 GOSUB 8100 5750 K1(64) = 1: NE = K1(44) 5760 IF K1(6) = 12 AND K1(44) >= 23 AND K1(48) THEN NE = 22'high calcul regression 5770 IF K1(6) = 3 AND K1(44) >= 5 THEN NE = 5'idem pour activites emzymatiques 5780 PE = 1 + K1(44) - NE: DE = PE + NE - 1㐞 5785 IF AIG3 THEN WSCH = K1(80) 5790 GOTO 6030 5800 GOSUB 10000 5810 IF WTAM < WMIN THEN WMIN = WTAM: NUM = K% 5820 IF ((P = 2) AND (K% = N - P)) THEN 5850 5830 IF ((P = 3) AND (K% = N - P)) THEN 5850 5840 GOTO 5540 5850 IF P = 2 THEN WLIM = 3.2E-07 * K1(47 + (RECAL * 35)) ^ 2: GOTO 5860 5855 IF P = 3 THEN WLIM = .0000005 * K1(47 + (RECAL * 35)) ^ 2 ELSE WLIM = 6.5E-07 * K1(47 + (RECAL * 35)) ^ 2 5860 IF WMIN < WLIM THEN 5880 5870 NUM = 0: IF P = 2 THEN 5560 ELSE 5550 5880 WG9 = 0: WG8 = 0: WG㐞7 = 0: WG6 = 0: WG5 = 0 5890 IF P = 2 THEN RESTORE 5340 ELSE RESTORE 5360 5900 IF NUM = 0 THEN NUM = 1 5910 FOR IK = NUM TO NUM + P 5920 J = LE(IK + (RECAL * 23)) 5930 GOSUB 2500 5940 WG9 = WG9 + S!(J): WG8 = WG8 + S!(J) ^ 2 5950 READ WG5 5960 WG7 = WG7 + S!(J) * WG5: WG6 = WG6 + WG5 ^ 2 5970 NEXT IK 5980 IF P = 2 THEN WG5 = 3.2E-07 ELSE WG5 = .0000005 5990 GOTO 5570 6000 GOSUB 5010: RETURN 6010 GOSUB 2000: LPRINT : RETURN 6020 IF ENTET% = 0 THEN ENTET% = 1: GOSUB 2245: GOSUB 6010 6025 P = 0:㐞 NUM = 0: HCAL = 0: GOSUB 594: GOSUB 5120: GOSUB 3470: RETURN 6030 GOSUB 2540 6040 GOTO 4230 6050 GOSUB 2019 6060 IF LIMI1 = 49 AND ENTET% = 1 THEN GOSUB 7180 6070 RELU = 0: GOSUB 46: GOSUB 592: GOTO 1875 6080 GOTO 4845 7180 FOR TY% = 1 TO 7: LPRINT : NEXT TY%: RETURN 7998 ' 7999 ' 8000 WPERTE = 0: DERRES = CUVE 'IF K1(6)=3 OR K1(6)=12 THEN 8010 8010 ON ETP% GOTO 6000, 5720, 5720, 6020 8100 MA% = 1: SUP% = F9%: GOSUB 600 8105 'MAX=6:LIGNE=7:AFFICH=&HFF:GOSUB 1715 8110 AIG1 = K1(6): DEV% = 5㐞2: RET% = 0: RETURN 8200 ' 8210 ' 8220 ' 8230 'gosub 9400 8240 COLOR 5, 0: VIEW PRINT 1 TO 21: CLS : VIEW PRINT 8250 COLOR 1, 2: VIEW PRINT 3 TO 19: CLS : VIEW PRINT 8260 VIEW PRINT 22 TO 25: CLS : VIEW PRINT 8270 COLOR 5, 0: LOCATE 23, 1: PRINT SPACE$(11): LOCATE 23, 70: PRINT SPACE$(11) 8280 LOCATE 24, 1: PRINT SPACE$(11): LOCATE 24, 70: PRINT SPACE$(11) 8290 LOCATE 25, 1: PRINT SPACE$(11); : LOCATE 25, 70: PRINT SPACE$(11); : COLOR 1, 2 8300 ' gosub 9430 8310 LOCATE 23, 32: PRINT "Instrument 㐞Status TC :" 8320 LOCATE 23, 64: PRINT USING "##.#"; VAL(TEMPER$) 8330 RETURN 8400 ' 8410 SCREEN 2: RETURN 8420 ' 8430 LINE (88, 152)-(88, 167), 2 8440 LINE (180, 152)-(180, 167), 2 8450 LINE (272, 152)-(272, 167), 2 8460 LINE (364, 152)-(364, 167), 2 8470 LINE (456, 152)-(456, 167), 2 8480 LINE (550, 152)-(550, 167), 2 8490 RETURN 8500 ' KEY(1) ON 8510 ' KEY(2) ON 8520 ' KEY(3) ON 8530 ' KEY(4) ON 8540 ' KEY(5) ON 8550 ' KEY(6) ON 8560 ' KEY(7) ON 8570 ' KEY(8) ON 8580 ' KEY(9㐞) ON 8590 ' KEY(10) ON 8600 'KEY(11) ON 8610 'KEY(12) ON 8620 'RETURN 8997 ' 8998 ' 8999 ' 9000 ' 9005 '**************** test F *********************** 9010 DATA 3.84,3.00,2.60,2.37,2.21,2.10 9015 DATA 2.01,1.94,1.88,1.83,1.79,1.75 9020 DATA 1.72,1.69,1.67,1.65,1.63,1.61 9025 DATA 1.59,1.57,1.56,1.54,1.53,1.52 9030 DATA 1.51,1.50,1.49,1.48,1.47,1.46 9035 DATA 1.45,1.45,1.44,1.43,1.42,1.42 9040 DATA 1.41,1.40,1.40,1.39,1.39,1.38 9045 DATA 1.38,1.37,1.37,1.37,1.36,1.36 9050 '************** 㐞recherche du point eloigne et calcul de WRSS ************** 9055 WSUPD = 0: WRSS = 0: FOR BV% = PPT TO DPT: IF FLAG(BV%) THEN WABT = WORD + PENTE! * BV%: WD = ABS(S!(LE(BV% + RECAL * 23)) - WABT): WRSS = WRSS + WD ^ 2: IF WD > WSUPD THEN WSUPD = WD: ND = BV% 9060 NEXT: WSD2 = WRSS / (NN - 2): RETURN 9065 '***************** regression lineaire ************************************ 9070 ST1 = 0: ST2 = 0: WSA1 = 0: WSTA = 0: NN = 0: WRSS = 0':TS=0:TSS=0 9075 FOR BV% = PPT TO DPT: IF FLAG(BV%) THEN ST1 = ST㐞1 + BV%: ST2 = ST2 + BV% ^ 2: WSA1 = WSA1 + S!(LE(BV% + RECAL * 23)): WSTA = WSTA + BV% * S!(LE(BV% + RECAL * 23)): NN = NN + 1 9080 NEXT: WMA1 = WSA1 / NN: WMT1 = ST1 / NN: ET# = NN * ST2: WNVT = ET# - ST1 ^ 2'wmt2=st2/nn:wmta=wsta/nn 9085 WNCVTA = NN * WSTA - ST1 * WSA1: PENTE! = WNCVTA / WNVT: WORD = WMA1 - PENTE! * WMT1: RETURN 9090 '*** debut du programme principal 9095 FOR TY% = 1 TO 48: FLAG(TY%) = 0: JJ(TY%) = 0: LG(TY%) = 0: PENTE!(TY%) = 0: NEXT 9096 FOR TY% = 1 TO NB: FLAG(TY%) = 1: NEXT 91㐞 00 'test aig2 9105 PPT = 1: DPT = NB: CHG = 0: GOSUB 9070 9110 GOSUB 9055: WSD1 = SQR(WSD2)'cherche point eloigne 9115 'PASS=PASS+1 9120 ' elimination des points aberrants 9125 FOR BV% = 1 TO NB: IF FLAG(BV%) THEN WABT = PENTE! * BV% + WORD: IF ABS(S!(LE(BV% + RECAL * 23)) - WABT) > 2.5 * WSD1 AND ABS(S!(LE(BV% + RECAL * 23)) - WABT) > .000001 THEN FLAG(BV%) = 0: CHG = 1 9130 NEXT: IF CHG THEN 9105'nvelle regression 9135 WRPTLIM = PENTE! 9140 WRPTLIM = .85 * WRPTLIM: WVR = WRSS / (NN - 2)':SDR=SQR(W㐞VR/ST2):CSV=SDR/PENTE! 9145 ' 9150 LG = 0: S = 0: SUPLG = 0: FOR BV% = DPT TO PPT STEP -1: IF FLAG(BV%) THEN LG = LG + 1: IF BV% > 1 THEN 9175 9155 IF LG < LGMIN THEN 9170 9160 S = S + 1: LG(S) = LG: IF BV% > PPT THEN JJ(S) = BV% + 1: GOTO 9170 9165 IF FLAG(PPT) = 1 THEN JJ(S) = PPT ELSE JJ(S) = PPT + 1 9170 LG = 0 9175 NEXT: NS = S 9180 ' boucle pour segmentation des sequences 9185 LIN = 0: SUPLG = 0: FOR Z = 1 TO DPT: IF Z > NS THEN 9260 9190 PPT = JJ(Z): DPT = JJ(Z) + LG(Z) - 1: GOSUB 9070: GO㐞SUB 9055' regr lin, WRSS et point 9195 ' test F 9200 WFR = WSD2 * 12 / (.000001 * K1(47 + RECAL * 35) ^ 2): RESTORE 9010: FOR K% = 1 TO LG(Z) - 2: READ WFF: NEXT: IF WFR <= WFF THEN 9245 9205 ' segmentation d'un sequence en deux 9210 IF ND = JJ(Z) THEN FLAG(ND) = 0: LGS1 = 0: LGS2 = LG(Z) - 1: JJS2 = JJ(Z) + 1: GOTO 9225 9215 IF ND = JJ(Z) + LG(Z) - 1 THEN FLAG(ND) = 0: LGS1 = LG(Z) - 1: LGS2 = 0: JJS1 = JJ(Z): GOTO 9225 9220 JJS1 = JJ(Z): JJS2 = ND: LGS1 = JJS2 - JJS1 + 1: LGS2 = LG(Z) - LGS1 + 1 㐞 9225 IF LGS1 >= LGMIN THEN NS = NS + 1: JJ(NS) = JJS1: LG(NS) = LGS1 9230 IF LGS2 >= LGMIN THEN NS = NS + 1: JJ(NS) = JJS2: LG(NS) = LGS2 9235 GOTO 9260 9240 ' validation d'une sequence 9245 PENTE!(Z) = PENTE! 9250 IF ABS(PENTE!(Z)) >= ABS(WRPTLIM) THEN PENTE!(Z) = PENTE!: IF LG(Z) >= SUPLG THEN SUPLG = LG(Z) 9255 '---------- 9260 NEXT: ZZ = 0 9265 FOR Z = 1 TO NS: IF LG(Z) = SUPLG THEN ZZ = ZZ + 1: WRATE(ZZ) = PENTE!(Z): SEQ(ZZ) = Z 9270 NEXT: LIN = 0: WRATE = 0 9275 FOR Z = 1 TO ZZ: IF ABS(WRAT㐞E(Z)) >= ABS(WRATE) THEN WRATE = WRATE(Z): SEQ = SEQ(Z): LIN = LIN + 1 9280 NEXT'CSV=SQR((WRSS/(NN-2))/ST2)/PENTE! 9285 'LIN=0 : non lineaire sinon resultat WRATE (PENTE!) et SEQ (no. sequence) 9290 RETURN 9999 'Fin 10000 WTAM = 0: WG5 = 0: IF AT = 3 THEN RESTORE 5340: GOTO 10040 10020 IF AT = 4 THEN RESTORE 5360: GOTO 10040 10030 RESTORE 5380 10040 FOR IM = K% TO K% + P 10050 READ WG5 10070 J = LE(IM + (RECAL * 23)): GOSUB 2500 10080 WG10 = (S!(J) - (WG7 / WG6) * WG5 - (WG9 / (P + 1))) ^ 2 1010㐞0 WTAM = WTAM + WG10 10120 NEXT IM 10130 RETURN 10500 IF K1(48) <> 0 THEN 10600 ELSE RETURN 10600 IF TRUC = 0 THEN 10700 ELSE 10800 10700 HACT = 23: TRUC = 1 10800 IF HACT < 23 + K1(44) THEN HACT = HACT + 1 ELSE RETURN 10900 IF LE(LEC) > LE(HACT) THEN 11000 ELSE RETURN 11000 J = LE(HACT): GOSUB 2500: A = A + 1: LPRINT "abs( "; LE(HACT); ") ="; USING "##.####"; S!(LE(HACT)); : IF A = 1 THEN LPRINT "" ELSE LPRINT TAB(25); "diff = "; : LPRINT USING "##.####"; (S!(LE(HACT))) - S!(PREC) 11010 PREC = LE(㐞HACT): GOTO 10800 15000 IMPRESULT = IMPRESULT + 1: IF IMPRESULT = 1 THEN AIGUILLAGE = 1: LIGNE = 7 15010 RETURN 20000 OPEN "r",#4,"SIMABS",192:FIELD#4,192 AS LECUV$:RETURN 30000 OPEN "r", #1, "NAMETH", 105 30010 FIELD #1, 6 AS A1$, 6 AS D$, 32 AS A2$, 32 AS A3$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$ 30020 FOR I = 1 TO 32 30030 GET #1, I 30040 B$(I) = A1$: MTT$(I) = A3$ 30050 NEXT I: CLOSE #1: RETURN 360) / 1024: CALIB = 0 4854 METI = PAR(22) AND 31: METP = (PAR(2㐞1 '******************************************************* 3 ' CHECKCP version 2.4 + 3.0 5 '******************************************************* 7 'check abs et change calibration 04/10/88 15 DEFINT A-D,F,H-J,L-Z 19 DIM PL(50),PLM(50),K1(100),S!(48),PZ(48),HF$(28) 'cc(12) 20 DIM P64(64),LE(48),PLACE(48),PAR(60),B$(32),MTT$(32),L(5),C(5) 30 COMMON STATUS,METH,P64(),LE(),PLACE(),O1!,C1!,O2,C2,AIG1,AIG3,PAR(),M,M1,RE,VER,BUT,PAS,PA$,LIGNE,METP,DEMET,LIMI,NONL$,TEMPE㐞R$,DATEF$ 31 lprint "in checkcp":GOSUB 30000:F9%=2^8 'CALL ITR 'hard copy 32 GOSUB 9100:SUP%=F9%:MA%=0:GOSUB 600:DEV%=52:IF BUT=30 THEN 4990 ELSE 7710 'VERS PROG 33 LOCATE 25,27:PRINT SPACE$(29);:RETURN 34 LOCATE 24,26:PRINT SPACE$(30):RETURN 35 C=33-INT(LEN(PA$)/2) 36 GOSUB 592:CLOSE 40 EFREE=FRE(""):lprint "chain ";pa$:CHAIN PA$ 50 IF PAR(37)=0 THEN RETURN ELSE BAN=1:MSE=PAR(19+(3*BAN)) AND 31:MME=(PAR(19+(3*BAN)) AND 992)/32:DPL=(PAR(20+(3*BAN)) AND 2032)/16:DPL$=RIGHT$(STR$(DPL),LEN(STR㐞 $(DPL))-1) 53 IF MME THEN ECRI$="M" ELSE ECRI$="S" 54 IF (PAR(20+(3*PAR(37))) AND 2^12)<>0 THEN ECRI$=ECRI$+"R" ELSE ECRI$=ECRI$+" " 55 IF MME THEN ECRI$=ECRI$+"- Tray:"+DPL$+"-"+LEFT$(B$(MSE),6) ELSE ECRI$=ECRI$+"- "+LEFT$(B$(MSE),6)+" Tray : "+DPL$ 60 LOCATE 2,50:PRINT ECRI$+SPACE$(30-LEN(ECRI$)):RETURN 100 READ A$ 105 IF LON=0 THEN 110 106 IF A$="" THEN A$=" " 107 N=INT(LEN(A$)/2):RETURN 110 PRINT A$;:LON=0:RETURN 120 COLOR 5,0:LOCATE 1,20,0:PRINT SPACE$(40):LOCATE 2,30:PRINT SPACE$(20㐞):COLOR 1,2 121 GOSUB 602:COLOR 5,0:CB=5 122 FOR I=1 TO 7:READ A$:CUR=11*(I-1)+INT(.4*I) 160 IF I>1 THEN LOCATE 20,2+CUR ELSE LOCATE 20,1+CUR 162 A3$=SPACE$(5-LEN(A$)/2)+A$:A$=A3$+SPACE$(10-LEN(A3$)):PRINT A$ 164 LOCATE 21,CB:IF A$<>SPACE$(10) THEN PRINT "F"+RIGHT$(STR$(I),1) ELSE PRINT " " 165 CB=CB+11+CINT(I/2-INT(I/2)):NEXT I 166 L(1)=24:C(1)=7:L(2)=24:C(2)=75:L(3)=1:C(3)=39:L(4)=1:C(4)=6:L(5)=2:C(5)=40 170 FOR I=8 TO 12:LON=1:GOSUB 100:LOCATE L(I-7),C(I-7)-N:GOSUB 110:NEXT I 205 A1$=SPACE$(11)㐞:A2$=SPACE$(11) 210 LON=1:A$=A1$:GOSUB 105:LOCATE 24,1:GOSUB 110:A$=A2$:LOCATE 25,1:GOSUB 110 220 IF STATUS<>9 THEN A1$=SPACE$(11):A2$=SPACE$(11) ELSE A1$=" Abort ":A2$=" S F9 " 225 LON=1:A$=A1$:GOSUB 105:LOCATE 24,70:GOSUB 110:A$=A2$:LOCATE 25,70:GOSUB 110 250 LOCATE 2,2:PRINT DATEF$;:LOCATE 2,53 255 PRINT SPACE$(27) 280 LOCATE 2,53:IF AUTMET AND MUTE THEN PRINT "MULT -"+LEFT$(MTT$(MUTE+20),12):GOTO 300 ELSE IF AUTMET THEN 300 285 GOSUB 50 300 COLOR 1,2:LOCATE 3,1:SUP%=F9%:RETURN 305 'tou㐞ches 310 R$="":I=0:CBAK=C 311 IF C=81 THEN L=L+1:C=1 312 IF MASK=1 THEN LOCATE L,C,0 ELSE LOCATE L,C-2,1:PRINT" "; 315 COMPTEUR=0 320 A$=INKEY$:IF A$="" THEN COMPTEUR=COMPTEUR+1 ELSE COMPTEUR=0 325 IF COMPTEUR<2 THEN 320 330 A$=INKEY$:IF A$="" THEN 330 340 IF A$=CHR$(13) THEN J=10:GOTO 575 345 IF A$=CHR$(8) THEN 565 350 IF (MASK AND 1)=0 THEN 405 355 IF A$=CHR$(130) AND (FONCT AND 2^1)<>0 THEN J=1:IF I<>0 THEN LOCATE L,C:PRINT SPACE$(MAX+1):GOTO 585 ELSE 585 360 IF A$=CHR$(131) AND (FONCT AND 2^㐞2)<>0 THEN J=2:GOTO 585 365 IF A$=CHR$(132) AND (FONCT AND 2^3)<>0 THEN J=3:GOTO 585 370 IF A$=CHR$(133) AND (FONCT AND 2^4)<>0 THEN J=4:GOTO 585 375 IF A$=CHR$(134) AND (FONCT AND 2^5)<>0 THEN J=5:GOTO 585 385 IF A$=CHR$(135) AND (FONCT AND 2^6)<>0 THEN J=6:GOTO 585 390 IF A$=CHR$(136) AND (FONCT AND 2^7)<>0 THEN J=7:GOTO 585 395 'IF A$=CHR$(137) AND STATUS=8 THEN STATUS=9:GOTO 620 400 IF A$=CHR$(138) AND PAR(37) AND PAR(17)=0 THEN GOSUB 810:J=9:GOTO 585 405 IF (MASK AND 2)=0 THEN 415 410 IF A$>CH㐞R$(47) AND A$0 THEN 435 425 IF A$="-" THEN 525 430 IF A$="+" THEN 525 435 IF (MASK AND 8)=0 THEN 450 440 IF ASD=1 THEN 450 445 IF A$="." THEN ASD=ASD+1:ROU=I:GOTO 505 450 IF (MASK AND 16)=0 THEN 460 455 IF (A$>CHR$(64) AND A$CHR$(96) AND A$CHR$(31) AND A$CHR$(64) AND A$(MAX-1) THEN 330 510 IF VALMIN=0 AND VALMAX=0 THEN 525 515 Q$=R$+A$:IF (I+1=MAX AND VAL(Q$)VALMAX THEN 330 ELSE 550 525 IF MIN$="" AND MAX$="" THEN 550 530 IF A$>=MIN$ AND 㐞A$<=MAX$ THEN 550 ELSE 330 535 'photcp 540 ' GOTO 550 'parcp 550 IF I=0 THEN LOCATE L,C:PRINT SPACE$(MAX+2):C=CBAK+1:LOCATE L,C 555 I=I+1:R$=R$+A$:PRINT A$; 560 IF (C+I)=81 THEN C=1:I=1:L=L+1 561 GOTO 330 565 IF I<>0 THEN I=I-1:R$=LEFT$(R$,I):IF MASK=1 THEN 330 ELSE LOCATE L,(C+I),1:PRINT " ";:LOCATE L,C:PRINT R$;:IF I=ROU THEN ASD=0 570 IF I=0 THEN LOCATE L,(C-2),1:PRINT " ";:GOTO 330 ELSE GOTO 330 575 IF I<>0 AND (VALMIN<>0 OR VALMAX<>0) AND VAL(R$)0 AND PAR(17)=0 THEN GOSUB 810:GOTO 900 ELSE IF A$=CHR$(136) THEN 5215 ELSE IF A$=CHR$(13) AND QUEST=2 THEN BOU=0:Q=0:GOTO 5282 ELSE 900 920 IF BOU>20 THEN HH=0:GG=21 ELSE IF QUEST=2 THEN 900 ELSE 922 921 IF MTT$(BOU)=SPACE$(32) OR MTT$(BOU)="" THEN 900 ELSE TABL$=LEFT$(MTT$(BOU),6):GOTO 925 922 IF BOU<11 THEN GG=1:HH=1 ELSE GG=11:HH=2 924 IF B$(BOU)=SPACE㐞$(12) OR B$(BOU)="" THEN 900 ELSE TABL$=LEFT$(B$(BOU),6) 925 GOSUB 970:DD=(BOU-GG) 926 GOSUB 931:R$=STR$(BOU):GOSUB 593:IF QUEST=1 THEN 5180 ELSE 5280 929 COU=2:GOSUB 932:RETURN 930 COU=7:GOSUB 933:GOSUB 935:RETURN 931 COU=0:GOSUB 932:COLOR 5,0:GOSUB 935:COLOR 1,2:RETURN 932 LINE((X1+(HH*24)+(DD*56)),Y1+(HH*24))-((53+X1)+(DD*56)+(HH*24),Y2+(HH*24)),COU,BF:RETURN 933 LINE((X1+(HH*24)+(DD*56)),Y1+(HH*24))-((53+X1)+(DD*56)+(HH*24),Y2+(HH*24)),COU,B:RETURN 935 LOCATE 6+(HH*3),(4+((HH*3)+(DD*7))):PRINT T㐞ABL$:LOCATE 7+(HH*3),(4+((HH*3)+(DD*7))):PRINT " ";HF$(BOU):RETURN 970 Y1=36:Y2=58:X1=21:RETURN 999 LOCATE 17,18:PRINT "Press labelled key to select the single method":RETURN 1000 LOCATE 17,3:PRINT "Press labelled key to select the multiple test ( Enter for single meth.)":RETURN 1100 V$=RIGHT$(STR$(V),LEN(STR$(V))-1):RETURN 1132 RESTORE 1300:FOR PO%=1 TO 28:READ BX$:HF$(PO%)=BX$:NEXT PO%:RETURN 1135 X1=21:Y1=36:Y2=58:Y4=0:WD=45:LR=20 1140 FOR PR=0 TO 2:X1=21:IF PR=1 THEN Y4=112:LR=0:WD=59 1145 RP㐞=PR:GOSUB 1160:RP=0:FOR X1=(77+(PR*24)) TO ((413+(PR*24))+Y4) STEP 56:GOSUB 1160:NEXT X1:GOSUB 1150:NEXT PR:LOCATE 6,60:PRINT "MULTITESTS":RETURN 1150 FOR SS=4+(PR*3) TO WD+14 STEP 7:LR=LR+1:GOSUB 1155:LOCATE 6+(PR*3),SS:PRINT PW$:LOCATE 7+(PR*3),SS:PRINT" ";HF$(LR):NEXT SS:LR=10:RETURN 1155 IF LR>20 THEN PW$=LEFT$(MTT$(LR),6):RETURN ELSE PW$=LEFT$(B$(LR),6):RETURN 1160 LINE (X1+(RP*24),Y1+(PR*24))-((X1+53)+(RP*24),Y2+(PR*24)),7,B:RETURN 1300 DATA /Q,/W,/E,/R,/T,/Y,/U,/I,/O,/P,/A,/S,/D,/F,/G,/H,/J,/K㐞,/L,/;,/1,/2,/3,/4,/5,/6,/7,/8 1310 DATA 81,87,69,82,84,89,85,73,79,80,65,83,68,70,71,72,74,75,76,59,49,50,51,52,53,54,55,56 1400 ECR$="":IF RAN>1 OR AUTMET<>0 THEN 1420 ELSE IF (PAR(19+(3*RAN)) AND 992)<>0 THEN ECR$="M" ELSE ECR$="S" 1410 IF (PAR(20+(3*RAN)) AND 2^12)<>0 THEN ECR$=ECR$+"R" ELSE ECR$=ECR$+" " 1415 GOTO 1440 1420 IF (TTCHO AND 480)<>0 THEN ECR$="M" ELSE ECR$="S" 1430 IF CHARG THEN ECR$=ECR$+"R" ELSE ECR$=ECR$+" " 1440 ECR$=ECR$+"- ":RETURN 1505 DATA ,,,,,,EXIT,,,Check Absorbances,, 㐞1510 DATA "S.Abs.","S.Graph","All Abs.",Other,,,EXIT,,,Check Absorbances,, 1515 DATA "Print",Other,,,,,EXIT,,,"Absorbance List : Single Sample",, 1520 DATA Plot,Next,,,,,EXIT,,,"Absorbance Graph : Single Sample",, 1525 DATA ".S.Abs : ABSORBANCE LIST SINGLE SAMPLE",".S.Graph : ABSORBANCE GRAPH SINGLE SAMPLE",".All Abs. : ABSORBANCE LIST ALL SAMPLES",".Other : OTHER METHODS / TRAYS" 1530 DATA ,,,,,,EXIT,,,Check Absorbances,, 1971 SA$=SPACE$(7)+"Exit"+SPACE$(7) 1975 GOSUB 1990:GOSU㐞B 2030:IF AIG1=0 THEN 2015 ELSE ON AIG1 GOTO 2000,2000,2010,2025,2020,2020,2029,2010,2027,2025,2027,2010 1990 IF BUT=30 OR SA$="Exit" THEN RETURN 1995 OPEN"r",#1,"nameth",105:FIELD#1,105 AS DH$:GET#1,34:ENT$=DH$:MID$(ENT$,57,2)=MKI$(0):LSET DH$=ENT$:PUT#1,34:CLOSE#1:IF RESULT=0 THEN NONL$="" 1997 RETURN 2000 PA$="calc1cp":GOTO 35 2010 PA$="calc2cp":GOTO 35 2015 PA$="maincp":GOTO 35 2020 PA$="calc3cp":GOTO 35 2025 PA$="calc4cp":GOTO 35 2027 PA$="calc5cp":GOTO 35 2029 PA$="calc6cp":GOTO 35 2030 LOC㐞ATE 24,40-(LEN(SA$)/2),0:PRINT SA$:RETURN 2040 FOR BV!=TOP TO LEN(R$) 'traitem. chaine ABC DOC 2045 IF MID$(R$,BV!,1)=ARRIV$ THEN ARRIV=BV!-1:BV!=LEN(R$):ARR=ARRIV-TOP+1 2050 NEXT BV!:RETURN 2055 'I=1 'routine w i/o 2065 'CIM%=&H10:CALL IO(DEV%,CIM%,DAT%,RET%):IF RET%=0 THEN 2065 ELSE CHAR=ASC(MID$(QP$,I,1)):CIM%=1:DAT%=CHAR 2075 'GOSUB 2095:I=I+1:IF CHAR<>10 THEN 2065 ELSE RETURN 2095 'CALL IO(DEV%,CIM%,DAT%,RET%):RETURN 2100 'R$="":INU=0:BUFFER=0:DEV%=52:CIM%=&HC:DAT%=0:GOSUB 2095 2110 'CIM㐞 %=2:DAT%=0 2115 'GOSUB 2095:CHAR=RET% 2125 'IF CHAR=-1 THEN INU=INU+1 ELSE R$=R$+CHR$(CHAR):GOTO 2135 2130 'IF INU=6000 AND REPET THEN ARRET=1:RETURN ELSE IF INU=6000 THEN REPET=1:GOTO 2152 ELSE 2115 2135 'IF CHAR<>10 THEN 2115 2140 'GOSUB 2095:IF RET%=-1 AND BUFFER<>0 THEN R$="ERR" ELSE IF RET%<>-1 THEN BUFFER=1:INU=5900:GOTO 2115 2150 'IF Q$<>LEFT$(R$,3) AND REPET THEN ARRET=1:GOTO 2155 ELSE IF Q$<>LEFT$(R$,3) THEN REPET=1:FOR BV!=1 TO 3000:NEXT BV! ELSE 2155 2152 'GOSUB 2055:GOTO 2100 2155 RETURN㐞 'DEV%=52:CIM%=&HC:DAT%=1:GOSUB 2095:RETURN 2158 GOSUB 2194:LSET P1$=MKI$(PAR(X!)):PUT#1,X!:CLOSE#1:RETURN 2160 DAV%=56:CIM%=2:DAT%=0:RET%=0:CALL IO(DAV%,CIM%,DAT%,RET%) 2162 SOUND 2500,200:RETURN 2193 OPEN "r",#1,"temper",4:FIELD#1,4 AS T1$:RETURN 'temperature 2194 OPEN"R",#1,"pargen",2:FIELD#1,2 AS P1$:RETURN 2195 OPEN "r",#1,"ABSORB",106:FIELD#1,106 AS A1$:RETURN 2198 OPEN"r",#1,"method",4:FIELD#1,4 AS A2$:RETURN 2210 GOSUB 2198 '*** lect. method 2225 FOR IU!=1 TO 100:GET#1,(METI-1)*㐞100+IU!:K1(IU!)=CVS(A2$):NEXT IU! 2240 CLOSE#1:RETURN 2290 OPEN"r",#1,FIL$,14:FIELD#1,2 AS F1$,4 AS F2$,2 AS F4$,6 AS F5$:RETURN '*** raz tray 2435 OPEN"r",#1,"plac",96:FIELD#1,96 AS FF$ 'lect places 2436 GET#1,UNE:FOR PO%=1 TO 48:PLACE(PO%)=CVI(MID$(FF$,(PO%*2)-1,2)):NEXT PO% 2437 CLOSE#1:RETURN 2440 DATA tray11,tray12,tray13,tray14,tray21,tray22,tray23,tray24 2504 'Q$="DST":QP$=Q$+CHR$(13)+CHR$(10):GOSUB 2055:GOSUB 2100 'test DST 2507 TEMPER!=VAL(MID$(R$,8,4)):TEMPER$=MID$(STR$(TEMPER!),2㐞,4) 2510 COLOR 1,2:LOCATE 23,64:PRINT USING "##.#"; VAL(TEMPER$) 'affiche la temperature 2511 RETURN 2516 IF AUTMET<>0 OR METFIN<>0 THEN GOSUB 7100:GOTO 2620 2518 TROUVE=0:PASSE=0 2520 'PASSE=PASSE+1:V=CUVE:GOSUB 1100:Q$="DOC"+V$:QP$=Q$+CHR$(13)+CHR$(10):GOSUB 2055:GOSUB 2100 2525 'MINI=6:IF LEFT$(R$,3)<>"DOC" THEN 2530 ELSE TOP=4:ARRIV$=",":GOSUB 2040:IF VAL(MID$(R$,TOP,ARR))<>CUVE THEN 2530 ELSE TOP=ARRIV+2:ARRIV$=CHR$(13):GOSUB 2040:DISPO=VAL(MID$(R$,TOP,ARR)) 2527 'IF CHERCHE OR DISPO"ABC" THEN 2530 ELSE TOP=4:ARRIV$=",":GOSUB 2040:IF VAL(MID$(R$,TOP,ARR))<>CUVE THEN 2530 ELSE TOP=ARRIV+2:ARRIV$=",":GOSUB 2040:IF VAL(MID$(R$,TOP,ARR))<>J THEN 2530 2555 'TOP=ARRIV+2:AB$=MID$(R$,TOP,(LEN(R$)-1-TOP)):IF 㐞(AB$="::::::" OR AB$=";;;;;;" OR AB$="======") THEN PASSE=MINI:GOTO 2530 2560 'ZE=0:PT=0:FOR G=1 TO LEN(AB$):IF MID$(AB$,G,1)=CHR$(46) OR (MID$(AB$,G,1)>CHR$(47) AND MID$(AB$,G,1)1 AND VAL(AB$)=0) OR PT>1 THEN ZE=1 2575 'IF ZE THEN S!(J)=0:GOTO 2530 2580 'ABSI!=VAL(AB$):IF ABSI!=0 THEN ABSO!=0:GOTO 2595 2585 'ABSO!=LOG(ABSI!)/LOG(10) 2590 'IF ABSO!>3.2 THEN ABSO!=3.2 2595 'S!(J)=ABSO! 2620 'DEMAN=DEMAN+㐞1:IF DEMAN MOD(50)=1 THEN GOSUB 2504:DEMAN=2 2625 RETURN 2681 SA$="Exit":GOSUB 602:GOSUB 2030:RETURN 2763 FOR IU!=1 TO PTREM:READ FIL$:NEXT IU! 2765 GOSUB 2290 2767 FOR IND=1 TO 50:GET#1,IND:PLM(IND)=CVI(F4$):BAN=RAN:IF BAN=0 THEN BAN=1 2770 IF ((PAR(19+(3*BAN)) AND 992)/32)<>0 AND (PLM(IND) AND 2^(DEMET-1))<>0 THEN PL(IND)=CVI(F1$):GOTO 2775 2772 IF ((PAR(19+(3*BAN)) AND 992)/32)<>0 THEN PL(IND)=0 ELSE PL(IND)=CVI(F1$) 2775 NEXT IND:CLOSE#1:RETURN 3000 A$=INKEY$:IF A$=CHR$(134) THEN LOCATE 24,29:㐞PRINT SPACE$(9)+"Stop"+SPACE$(9);:DEV%=&H35:CIM%=8:DAT%=0:RET%=0:CALL IO(DEV%,CIM%,DAT%,RET%):DEV%=52:FOR IU!=1 TO 250:NEXT IU!:QW=48:LEC=DERLEC 3005 RETURN 3320 PRIMIT=LE(1):IF K1(6)=3 OR K1(6)=12 THEN DERN=23 ELSE DERN=3 3325 FOR PO%=1 TO DERN 3330 IF LE(PO%)<>0 THEN DERLEC=LE(PO%) ELSE PO%=DERN 'rang de la dern lect. 3335 NEXT PO% 3340 RETURN 3350 IF PAR(37)<>0 AND VIDE=0 THEN RETURN ELSE COLOR 5,0 3360 LOCATE 20,3:PRINT "S.Abs.";:LOCATE 20,15:PRINT"S.Graph";:LOCATE 20,26:PRINT "All Abs.":LOCATE 㐞21,5:PRINT "F1";:LOCATE 21,17:PRINT "F2";:LOCATE 21,28:PRINT "F3";:COLOR 1,2:RETURN 3370 GOSUB 2195:FOR ET%=1 TO CINT((O2/16)+.05):GET#1,ET%:ENR$=A1$:FOR ER=91 TO 1 STEP-6 'cherche la 1ere partie du plateau,avant le change cup 3380 IF CVI(MID$(ENR$,ER,2))<>0 THEN LASTE=1+((ER-1)/6):ETOK%=ET%:ER=1:ET%=CINT((O2/16)+.05) 3390 NEXT ER:NEXT ET%:CLOSE#1:RETURN 3400 AUTMET=COUPE:MONCH=METI:ABDIS=DERLEC:MUTE=((PAR(22) AND 992)/32)-20:ORDR=LASTE:RETURN'plateau en 2 parties 3500 UN=0:DEUX=0: ON K1(6) GOTO 3524,3㐞 510,3530,3510,3505,3505,3555,3555,3555,3505,3555,3530 3505 ON K1(5) GOTO 3524,3510 3510 IF LEC>=PRIMIT THEN UN=1 3520 IF LEC+1>=PRIMIT THEN DEUX=1 3522 RETURN 3524 IF LEC=DERLEC OR (LEC=PRIMIT AND K1(30)<>0) THEN UN=1 ELSE UN=0 3526 IF LEC+1=DERLEC OR (LEC+1=PRIMIT AND K1(30)<>0) THEN DEUX=1 ELSE DEUX=0 3529 RETURN 3530 FOR BV!=1 TO 47 3535 IF (LE(BV!)=LEC AND S!(48)=0 AND BV!<24) OR (LE(BV!)=LEC AND S!(48)<>0 AND BV!>23) THEN UN=1 3540 IF (LE(BV!)=LEC+1 AND S!(48)=0 AND BV!<24) OR (LE(BV!)=LEC+1 㐞AND S!(48)<>0 AND BV!>23) THEN DEUX=1:BV!=47 3545 NEXT BV! 3550 RETURN 3555 UN=1:DEUX=1:RETURN 3570 BLANSYS=0:IF (K1(6)=3 OR K1(6)=12 OR (K1(6)<3 AND K1(33)<>0) OR K1(6)=4) THEN BLANSYS=1 'temporaire jusqu'a assigne ds ltst 3575 IF (K1(30)=0 OR (K1(30)0 AND K1(30)PZ(IK) THEN IK=IK+1:GOTO 3835 3845 NEXT IN 3850 ACT=1 3855 FOR IN=0 TO K1(44)-1:IF ACT=1 THEN LZB=K1(30)+(IN*K1(45)) ELSE LZB=LZ1+(IN*K1(48)) 3860 IK=1 3865 IF LZB=PZ(IK) THEN LE(ACT+IN)=IK ELSE IK=IK+1:GOTO 3865 3870 NEXT IN:IF ACT=24 THEN 3880 3875 IF K1(48) THEN ACT=24:GOTO 3855 3880 RETURN 3885 FOR BV!=48 TO IK+1 STEP -1:PZ(BV!)=PZ(BV!-1):NEXT BV!:PZ(IK)=LZB:RETURN 3900 SERT=0:IF ENZYM=0 THEN SERT=1:RETURN 3910 FOR LO=1+(23*S!(48)*10000) TO K1(44)+(23*S!㐞(48)*10000) 3920 IF LE(LO)=CORR THEN SERT=1:INVER=LO 3930 NEXT LO:RETURN 4000 GOSUB 4851:GOSUB 2435:RESTORE 2440:GOSUB 2763:GOSUB 2210:RETURN 4851 OPEN"r",#1,"cyclec",96:FIELD#1,96 AS FF$:GET#1,UNE 'cycle lectures 4852 FOR PO%=1 TO 48:LE(PO%)=CVI(MID$(FF$,(PO%*2)-1,2)):NEXT PO%:CLOSE#1:RETURN 4975 COLOR 5,0:LOCATE 20,39,0:PRINT SPACE$(5):LOCATE 21,40:PRINT " ":COLOR 1,2:LOCATE 12,1:PRINT SPACE$(37):RETURN 4980 'debut prog 4990 GOSUB 1132:IF PAR(37)<>0 THEN RAN=1:METI=PAR(22) AND 31:PLATO=(PAR(23) A㐞ND 496)/16:UNE=1:GOSUB 4851:GOSUB 2435:PTREM=PAR(23) AND 15:RESTORE 2440:GOSUB 2763:GOSUB 2210:GOSUB 3320 ELSE OTHER=1 'place,le,pl,K1 4992 IF (PAR(24) AND 255)>1 THEN GOSUB 3370:COUPE=METI+(PLATO*512) ELSE 4995 'plateau en 2 parties 4993 IF METP THEN COUPE=COUPE+((METP-20)*32) 4995 MA%=0:GOSUB 600:DEV%=52 4996 GOSUB 2195:PCHAM%=INT((PAR(53)+1)/16.0001)+1:DCHAM%=INT(PAR(52)/16.0001)+1:NUME%=16*PCHAM%+PAR(53):GET#1,PCHAM%:IF PAR(52)=0 THEN VIDE=1 4998 METABS=CVI(MID$(A1$,1+NUME%,2)):IF (PAR(37)=1㐞) AND (CVI(MID$(A1$,11,2))=0) AND (METI=(METABS AND 31)) AND (PLATO=((METABS AND 15872)/512)) AND (((PAR(22) AND 992)/32)=((METABS AND 480)/32)) THEN VIDE=1 4999 CLOSE#1:IF PAR(37)>1 OR (PAR(37) AND VIDE=0) THEN OTHER=1 'plusieurs methodes dont au - 1 en cours 5000 IF PAR(37)=0 THEN 5155 ELSE AUTMET=0:RAN=1 5003 IF OTHER THEN RESTORE 1510 ELSE RESTORE 1505 5005 GOSUB 120:GOSUB 34:GOSUB 33:L=6:C=1:GOSUB 593:GOTO 5077' ecran A6 5010 GOSUB 3320 5020 IF CUVE=0 THEN ABDIS=0:TROUVE=0:GOTO 5075 ELSE CHERCHE㐞=1:GOSUB 2518:ABDIS=DISPO:CHERCHE=0 5075 RETURN 5077 LOCATE 4,27:GOSUB 1400:IF (RAN>1 OR AUTMET<>0) THEN COLOR 5,0:PRINT ECR$;SONCH$;" ";"TRAY :";PLATE:COLOR 1,2:GOTO 5081 5078 IF PAR(37) THEN METI=PAR(22) AND 31:PLATO=(PAR(23) AND 496)/16:COLOR 5,0:PRINT ECR$;B$(METI);" ";"TRAY :";PLATO:COLOR 1,2 ELSE 5081 5080 UNE=1:PTREM=PAR(23) AND 15:DEMET=(PAR(22) AND 15360)/1024:GOSUB 4000:GOSUB 3320:METFIN=0:AUTMET=0:RAN=0:GOTO 5082 5081 IF AUTMET THEN METFIN=1 5082 MOIC=0:RESTORE 1525:IF OTHER THEN RIZ=4 ELSE㐞 RIZ=3 5085 FOR BV!=1 TO RIZ:READ TEX$:LOCATE L,C:PRINT TEX$:L=L+2:NEXT BV! 5090 IF (K1(6)=5 OR K1(6)=6 OR K1(6)=10) AND K1(58)<>0 THEN PRETRT=1 ELSE PRETRT=0 5095 DOCAL=0:IF (K1(6)=1 OR ((K1(6)=5 OR K1(6)=6 OR K1(6)=10) AND K1(5)=1)) AND PAR(59)=1 AND (AUTMET<>0 OR METFIN<>0) THEN DOCAL=1 5100 GOSUB 3350 5105 LPRINT "ACCES CHECKC ABS":GOTO 1971 'MASK=1:FONCT=158:GOSUB 310:ON J GOTO 5360,5110,6320,5150,5100,5100,1971,5100,5100,5100 5110 IF (K1(6)=1 OR K1(6)=5 OR K1(6)=6 OR K1(6)=10) AND K1(30)=0 AND D㐞 OCAL=1 THEN LOCATE 24,32:PRINT "One Point Methode";:GOTO 5105 ELSE 5760 5150 IF OTHER=0 THEN 5100 5155 SCREEN 2:GOSUB 9100:RESTORE 1505:GOSUB 120:GOSUB 1135 5160 ENCOUR=0:ORDR=0:GOSUB 2195:FOR ET%=PCHAM% TO DCHAM%:GET#1,ET%:AN1$(ET%)=A1$:NEXT ET%:CLOSE#1:GOSUB 999 5170 QUEST=1:GOTO 900 5180 Q=BOU:FOR ET%=PCHAM% TO DCHAM%:FOR PO=1 TO 16:PREV$=MID$(AN1$(ET%),1+((PO-1)*6),2):PREV1=CVI(PREV$):PREV1=ABS(PREV1):PREV=PREV1 AND 31:IF PREV=Q THEN MONCH=Q:SONCH$=B$(MONCH):GOTO 5200 5182 NEXT PO:NEXT ET% 5185 F㐞OR PO=1 TO PAR(37):IF Q=(PAR(19+(3*PO)) AND 31) THEN MONCH=Q:SONCH$=B$(Q):GOTO 5200 5186 NEXT PO 5190 GOSUB 929:GOSUB 930:GOTO 5170 5200 LOCATE 17,18:PRINT "TRAY NUMBER : ";SPACE$(30); 5210 MASK=3:VALMAX=999:L=17:C=35:FONCT=128:MAX=3:LOCATE L,C,1:GOSUB 310:ON J GOTO 5210,5210,5210,5210,5210,5210,5215,5210,5210,5230 5215 SCREEN 0:GOSUB 9100:IF PAR(37) THEN 5000 ELSE 1971 5220 GOSUB 5225:GOTO 5190 5225 LOCATE 17,1,0:PRINT SPACE$(75);:RETURN 5230 IF Q=0 THEN GOSUB 5225:GOTO 5200 ELSE LOCATE 17,40,0 㐞5234 MECHO=0 5235 FOR ET%=PCHAM% TO DCHAM%:FOR PO=1 TO 16:PREV1=CVI(MID$(AN1$(ET%),1+((PO-1)*6),2)):PREV1=ABS(PREV1):PREV=PREV1 AND (31+15872):IF PREV=MONCH+(Q*512) THEN TTCHO=PREV:PLATE=Q:MUTE=(PREV1 AND 480)/32:ORDR=PO:MECHO=MECHO+1:IF MECHO=1 THEN ETOK%=ET% 5237 NEXT PO:NEXT ET% 5242 FOR PO=1 TO PAR(37):IF MONCH=(PAR(19+(3*PO)) AND 31) AND Q=(PAR(20+(3*PO)) AND 2032)/16 THEN PLATE=Q:TTCHO=MONCH+(PLATE*512):ENCOUR=1:RAN=PO:MECHO=MECHO+1 5243 NEXT PO:IF MECHO THEN 5250 5244 LOCATE 17,35,1:PRINT " 㐞";:GOTO 5210 5250 IF (MECHO=1 AND ENCOUR<>0) OR (MECHO=2 AND ENCOUR<>0 AND RAN=1 AND ORDR<>0 AND MUTE=(PAR(22) AND 992)/32) THEN 5305 ELSE IF MECHO=1 THEN 5310 5252 MECHO=0:ENCOUR=0:RAN=0:ORDR=0:LOCATE 17,18:PRINT "M = Manual R = Report";SPACE$(24); 5255 MASK=17:L=17:C=42:FONCT=128:MAX=1:LOCATE L,C,1:GOSUB 310:ON J GOTO 5255,5255,5255,5255,5255,5255,5215,5255,5255,5257 5257 IF R$="M" THEN CHARG=0 ELSE IF R$="R" THEN CHARG=1 ELSE GOSUB 5225:GOTO 5252 5260 LOCATE 16,40,0:FOR ET%=PCHAM% TO DCHAM%:FOR PO=㐞1 TO 16:PREV1=CVI(MID$(AN1$(ET%),1+((PO-1)*6),2)):PREV1=ABS(PREV1):PREV=PREV1 AND (31+15872+16384):IF PREV=TTCHO+(16384*CHARG) THEN ORDR=PO:MECHO=MECHO+1:IF MECHO=1 THEN ETOK%=ET% 5262 NEXT PO:NEXT ET% 5264 FOR PO=1 TO PAR(37):IF MONCH=(PAR(19+(3*PO)) AND 31) AND PLATE=(PAR(20+(3*PO)) AND 2032)/16 AND CHARG=(PAR(20+(3*PO)) AND 4096)/4096 THEN TTCHO=MONCH+(PLATE*512):ENCOUR=1:RAN=PO:MECHO=MECHO+1 5265 NEXT PO:IF MECHO=0 THEN GOSUB 5225:GOTO 5252 ELSE TTCHO=TTCHO+(16384*CHARG) 5267 IF (MECHO=1 AND ENCOUR<㐞>0) OR (MECHO=2 AND ENCOUR<>0 AND RAN=1 AND ORDR<>0 AND MUTE=(PAR(22) AND 992)/32) THEN 5305 ELSE IF MECHO=1 THEN 5310 5268 GOSUB 1000 5270 QUEST=2:GOTO 900 5280 Q=BOU-20 5282 IF PAR(37)<>0 AND ENCOUR<>0 THEN 5283 ELSE 5290 5283 FOR PO=1 TO PAR(37):IF MONCH=(PAR(19+(3*PO)) AND 31) AND PLATE=(PAR(20+(3*PO)) AND 2032)/16 AND CHARG=(PAR(20+(3*PO)) AND 16384)/16384 AND Q=(PAR(19+(3*PO)) AND 992)/32 THEN RAN=PO:GOTO 5305 5285 NEXT PO 5290 FOR ET%=PCHAM% TO DCHAM%:FOR PO=1 TO 16:PREV1=CVI(MID$(AN1$(ET%),1+㐞((PO-1)*6),2)):PREV1=ABS(PREV1):PREV1=(PREV1 AND 16383+16384):IF PREV1=TTCHO+(Q*32) THEN TTCHO=PREV1:ORDR=PO:MUTE=Q:ETOK%=ET%:GOTO 5310 5300 NEXT PO:NEXT ET%:GOSUB 929:GOSUB 930:GOTO 5270 5305 METFIN=0:AUTMET=0:IF RAN=0 THEN RAN=1 5306 UNE=RAN:PTREM=PAR(20+(3*RAN)) AND 15:DEMET=(PAR(19+(3*RAN)) AND 15360)/1024:METI=PAR(19+(3*UNE)) AND 31:GOSUB 4000:DERN=23:GOSUB 3325:GOSUB 4975:GOTO 5330 'lit plac,cyclec,derlec 5310 PREV1=CVI(MID$(AN1$(ETOK%),1+((ORDR-1)*6),2)):TTCHO=ABS(PREV1):AUTMET=TTCHO 5315 DLEC=㐞CVI(MID$(AN1$(ETOK%),3+(6*(ORDR-1)),2)):PRIMIT=DLEC AND 255:DERLEC=(DLEC AND 32512)/256:ABDIS=DERLEC:PLATO=PLATE:GOSUB 2198:GET#1,(MONCH-1)*100+6:K1(6)=CVS(A2$):CLOSE#1:GOSUB 3800 5320 FOR PO%=1 TO 48:PL(PO%)=0:NEXT PO%:GOSUB 4975 5330 SCREEN 0:GOSUB 9100:GOTO 5003 5340 LOCATE 19,43,0:PRINT " ";:GOTO 5220 5350 'abs list:single sample 5355 IF AUTMET<>0 THEN METAUT=AUTMET 5360 IF METFIN<>0 AND AUTMET=0 THEN 5100 ELSE SA$="Absorbance List ":GOSUB 2030 5370 RESTORE 1515:GOSUB 120 '*** ecran B6 538㐞0 GOSUB 7250:IF AUTMET=0 THEN GOSUB 3320 5390 MASK=35:MAX=3:VALMAX=32:LOCATE 4,49:PRINT "SAMPLE NUMBER :":L=4:C=66:FONCT=128:LOCATE L,C,1:GOSUB 310:ON J GOTO 5400,5400,5400,5400,5400,5400,5410,5400,5400,5420 5400 LOCATE 4,66:PRINT SPACE$(4):GOTO 5390 5410 TTCHO=0:LOCATE 4,75,0:GOSUB 34:SCREEN 0:GOSUB 9100:GOSUB 2681:PROCH=0:PREMLEC=0:GOTO 5000 5420 IF R$="" THEN 5390 ELSE IF Q THEN TRAITE=Q+16 ELSE QQ$=RIGHT$(R$,LEN(R$)-1):Q=VAL(QQ$):IF Q THEN TRAITE=Q ELSE 5400 5421 IF TRAITE>=(PAR(24) AND 255) THEN A㐞 UTMET=0 5422 IF AUTMET=0 AND TRAITE<(PAR(24) AND 255) AND PLACE(TRAITE)=0 THEN GOSUB 3400 5425 LOCATE 5,1,0:IF AUTMET=0 THEN CUVE=PLACE(TRAITE):GOSUB 5020 5430 IF (AUTMET<>0) OR (METFIN<>0) THEN J=1:GOSUB 7100:IF TRAITE=0 THEN 5400 ELSE IF ((AUTMET<>0) OR (METFIN<>0)) AND (TRAITE<>0) THEN 5450 5435 GOSUB 3570:IF AUTMET=0 AND TRAITE=1 AND PLACE(TRAITE) AND BLANSYS THEN DCUVE=PLACE(TRAITE):GOTO 5450 5440 IF PL(TRAITE)<>0 AND PL(TRAITE)<>255 AND PLACE(TRAITE)<>0 AND ABDIS>0 THEN DCUVE=PLACE(TRAITE) ELSE 5㐞400 5450 LOCATE 5,10:IF ABDIS0 AND (K1(6)<>3 AND K1(6)<>12) THEN FOR PO%=1 TO 48:LE(PO%)=0:NEXT PO% 5460 LOCATE 6,1:PRINT "ABSORBANCES" 5470 L=7:C=1:IF K1(6)=3 OR K1(6)=12 THEN 5640 'enzymes 5480 FOR LEC=1 TO DERLEC 'abs pour une cuve 5490 IF AUTMET<>0 OR METFIN<>0 THEN 5505 5500 CUVE=DCUVE:GOSUB 5020:J=LEC:IF LEC>ABDIS THEN LEC=DERLEC:GOTO 5570 ELSE GOSUB 2516 5505 LOCATE L,C 5507 IF LEC MOD(2)=1 THEN GOSUB 3500㐞 5508 IF ((UN=0 AND (LEC MOD(2)=1)) OR (DEUX=0 AND (LEC MOD(2)=0))) AND DOCAL=1 THEN 5570 5510 IF (UN AND (LEC MOD(2)=1)) OR (DEUX AND (LEC MOD(2)=0)) THEN COLOR 5,0 ELSE COLOR 1,2 5530 IF LEC<10 THEN PRINT STR$(LEC)+" :" USING "##.####"; (S!(LEC)) ELSE PRINT STR$(LEC)+":" USING "##.####"; (S!(LEC)) 5540 C=C+16 5550 IF C>75 THEN L=L+1:C=1 5570 NEXT LEC 5580 COLOR 1,2:LOCATE 17,1:PRINT "Print : PRINT ABSORBANCES" 5600 MASK=1:FONCT=134:GOSUB 310:ON J GOTO 6700,5605,5600,5600,5600,5600,5610,5600,56㐞00,5600 5605 IF AUTMET=0 THEN AUTMET=METAUT 5607 GOTO 5350 5610 FOR PO%=1 TO 48:LE(PO%)=0:NEXT PO%:GOTO 5410 5640 FOR KJ=1 TO DERLEC:J=KJ:IF AUTMET<>0 OR METFIN<>0 THEN LEC=KJ ELSE 5650 5642 IF KJ MOD(2)=1 THEN GOSUB 3530 5645 'IF (UN AND (KJ MOD(2)=1)) OR (DEUX AND (KJ MOD(2)=0)) THEN COLOR 5,0 ELSE COLOR 1,2 5647 GOTO 5670 5650 CUVE=DCUVE:GOSUB 5020 5660 IF J>ABDIS THEN KJ=DERLEC:GOTO 5740 ELSE GOSUB 2516 5670 COLOR 1,2:FOR BV!=1 TO DERLEC:IF LE(BV!)=KJ AND BV!<24 THEN COLOR 5,0 5675 NEXT BV! 㐞5680 LOCATE L,C 5690 IF J<10 THEN PRINT STR$(J)+" :" USING "##.####"; (S!(J)) ELSE PRINT STR$(J)+":" USING "##.####"; (S!(J)) 5720 C=C+16:IF C>75 THEN L=L+1:C=1 5740 NEXT KJ:GOTO 5580 5750 'abs graph 5760 ORIG=AUTMET:GOSUB 7285:IF METFIN<>0 AND AUTMET=0 THEN 5100 ELSE SA$="Absorbance Graph":GOSUB 2030 5770 IF PROCH THEN PROCH=0:GOTO 5840 ' *** ecran C6 5780 SCREEN 2:GOSUB 9100:S!(48)=0::RESTORE 1520:GOSUB 120:GOSUB 7250:IF AUTMET=0 AND METFIN=0 THEN GOSUB 3320 5785 IF K1(6)=3 OR K1(6)=12 THEN ENZYM=㐞1 ELSE ENZYM=0 5790 LOCATE 4,48:PRINT "SAMPLE NUMBER : ":MAX=3:MASK=35:VALMAX=32:L=4:C=65:FONCT=128:LOCATE L,C,1:GOSUB 310:ON J GOTO 5790,5790,5790,5790,5790,5790,5410,5790,5790,5800 5800 LOCATE 4,70,0:IF R$="" THEN 5790 ELSE IF Q THEN TRAITE=Q+16:GOTO 5805 ELSE QQ$=RIGHT$(R$,LEN(R$)-1):Q=VAL(QQ$):IF Q THEN TRAITE=Q ELSE LOCATE 4,65:PRINT " ":GOTO 5790 5805 IF AUTMET=0 AND TRAITE<(PAR(24) AND 255) AND PLACE(TRAITE)=0 THEN ITRAITE=TRAITE:GOSUB 3400:GOSUB 7285:TRAITE=ITRAITE 5806 GOSUB 3570:IF AUTMET=0㐞 AND TRAITE=1 AND PLACE(TRAITE) AND BLANSYS THEN CUVE=PLACE(TRAITE):GOSUB 5020:GOTO 5840 5807 IF AUTMET=0 THEN CUVE=PLACE(TRAITE):GOSUB 5020:GOTO 5820 5810 IF (AUTMET<>0) OR (METFIN<>0) THEN J=1:GOSUB 7100:IF TRAITE=0 THEN LOCATE 4,65:PRINT " ":GOTO 5790 ELSE IF ((AUTMET<>0) OR (METFIN<>0)) AND (TRAITE<>0) THEN RETI(2)=LEN(MEMO$):GOTO 5840 5820 IF PL(TRAITE)<>0 AND PL(TRAITE)<>255 AND PLACE(TRAITE)<>0 AND ABDIS>0 THEN CUVE=PLACE(TRAITE) ELSE LOCATE 4,65:PRINT SPACE$(4):GOTO 5790 5840 IF ENZYM THEN DE㐞RCRA=K1(44):PRECRA=LE(1+(23*S!(48)*10000)) ELSE DERCRA=DERLEC:PRECRA=1 5845 IF PREMLEC>1 THEN 5980 ELSE IF PREMLEC=0 THEN PREMLEC=1 5850 IF ABDISMAXI! THEN MAXI!=S!(LKJ) 5900 NEXT LKJ 5910 IF MAXI!>.5 THEN MAXIY!=(INT(MAXI!*2))/2+.5:GOTO 5930 5920 IF MAXI!<.01 THEN MAXIY!=.01 ELSE IF MAXI!<.1 THEN MAX㐞IY!=.1 ELSE MAXIY!=.5 5930 IF MAXI!-MINNI!<.1 THEN MINIY!=INT(10*MAXI!-2)/10:GOTO 5950 5940 IF MAXI!-MINNI!<.05 THEN MINIY!=INT(10*MAXI!-1)/10 ELSE MINIY!=(INT(MINNI!*2))/2 5950 IF MINIY!<0 THEN MINIY!=0 5960 GRANDEUR=MAXIY!-MINIY!:ECHELLE=GRANDEUR+GRANDEUR/10:GRADUATION=MAXIY!:TAILLE!=DERCRA/200:GOSUB 6030 5962 IF PAR(59)=1 AND (AUTMET<>0 OR METFIN<>0) AND (K1(6)=1 OR ((K1(6)=5 OR K1(6)=6 OR K1(6)=10) AND K1(5)=1)) THEN 5965 ELSE 6220 'graphe optimise 5965 CIRCLE (PRECRA,(S!(PRECRA)-MINIY!)),TAILLE!:㐞 LINE(PRECRA,(S!(PRECRA)-MINIY!))-(DERCRA,(S!(DERCRA)-MINIY!)):CIRCLE(DERCRA,(S!(DERCRA)-MINIY!)),TAILLE!:GOTO 6300 5970 LEC=1:J=LEC:GRANDEUR=2.5:GRADUATION=GRANDEUR:MAXIY!=GRANDEUR:MINIY!=0:ECHELLE=GRANDEUR+.3:TAILLE!=DERCRA/200:GOSUB 6030:GOSUB 2516:IF TROUVE=0 THEN 6310 'graphe depart 5980 ECT=0:FOR LEC=PREMLEC TO DERLEC:CORR=LEC:GOSUB 3900:IF SERT=0 THEN 6210 5990 IF LEC>1 THEN J=LEC:GOSUB 2516:IF TROUVE=0 THEN 6310 6000 IF S!(J)>GRANDEUR AND LEC=PRECRA THEN LOCATE 6,10:PRINT SPACE$(4):LOCATE 6,10:P㐞RINT GRADUATION:LOCATE 12,10:PRINT SPACE$(4):LOCATE 12,10:PRINT ((MAXIY!-MINIY!)/2+MINIY!):LOCATE 18,10:PRINT SPACE$(4):LOCATE 18,10:PRINT MINIY!:GOTO 6020 6010 IF S!(J)>GRANDEUR THEN WINDOW:VIEW PRINT 6 TO 18:CLS:VIEW PRINT ELSE 6190 6020 GRANDEUR=((INT(2*S!(J)))/2+.5):ECHELLE=GRANDEUR+.3:GRADUATION=GRANDEUR:MAXIY!=GRANDEUR:GOSUB 6030:GOTO 6150 6030 VIEW(130,37)-(550,140) 'affich. graphe 6040 WINDOW(1,ECHELLE)-(DERCRA+.3,0) 6050 LINE(1,0)-(DERCRA+.3,0) 6060 LINE(1,0)-(1,ECHELLE) 6070 FOR QWE=1 TO 4 㐞'grad. en y 6080 LINE(1,(QWE*GRANDEUR/4))-(DERCRA/150,(QWE*GRANDEUR/4)) 6090 NEXT QWE 6100 LOCATE 5,10:PRINT "ABS":LOCATE 6,10:PRINT " ":LOCATE 6,10:PRINT GRADUATION:LOCATE 12,10:MILIEU!=((MAXIY!-MINIY!)/2+MINIY!):PRINT " ":LOCATE 12,10:IF MILIEU!<1 THEN PRINT USING ".##"; MILIEU! ELSE PRINT MILIEU! 6105 LOCATE 18,10:PRINT " ":LOCATE 18,10:IF MINIY!<1 AND MINIY!<>0 THEN PRINT USING ".##"; MINIY! ELSE PRINT MINIY! 6110 LOCATE 19,14:PRINT PRECRA:GOSUB 10000:LOCATE 19,54:PRINT "MEAS. NUMBER 㐞";TOTO 6120 FOR IND=1 TO DERCRA 6130 LINE(IND,0)-(IND,ECHELLE/50) 'graduations en abscisse 6140 NEXT IND:RETURN 6150 ECR=0:FOR RECOP=1 TO LEC-1:CORR=RECOP:GOSUB 3900:IF SERT=0 THEN 6180 'graphe nouvelle echelle 6155 IF ENZYM THEN ECRB=ECR:ECRBA=LE(ECR):ECR=INVER ELSE ECRB=RECOP-1:ECRBA=ECRB:ECR=RECOP 6160 IF RECOP>PRECRA THEN LINE(ECRB,S!(ECRBA))-(ECR,S!(RECOP)) 6170 CIRCLE (ECR,S!(RECOP)),TAILLE!:IF ECR=PRIMIT AND ENZYM=0 AND K1(30)<>0 THEN LINE(RECOP,(S!(RECOP)-ECHELLE/10-MINIY!))-(RECOP,(S!(RECOP㐞)+ECHELLE/10-MINIY!)) 6180 NEXT RECOP 6190 IF ENZYM THEN ECT=INVER ELSE ECTB=LEC-1:ECTBA=ECTB:ECT=LEC 6195 IF LEC>PRECRA THEN LINE(ECTB,S!(ECTBA))-(ECT,S!(LEC))'graphe raffraichi (en cours) 6200 CIRCLE(ECT,S!(LEC)),TAILLE!:IF LEC=PRIMIT AND ENZYM=0 AND K1(30)<>0 THEN LINE(LEC,(S!(LEC)-ECHELLE/10-MINIY!))-(LEC,(S!(LEC)+ECHELLE/10-MINIY!)) 6205 IF ENZYM THEN ECTB=ECT:ECTBA=LE(ECT) 6210 NEXT LEC:WINDOW:VIEW PRINT 6 TO 18:CLS:VIEW PRINT:GOTO 5860 6220 ECR=0:FOR MN=1 TO DERLEC:CORR=MN:GOSUB 3900:IF SERT=0㐞 THEN 6250 'graphe optimise 6225 IF ENZYM THEN ECRB=ECR:ECRBA=LE(ECR):ECR=INVER ELSE ECRB=MN-1:ECRBA=ECRB:ECR=MN 6226 IF S!(48)=.0001 THEN 6227 ELSE 6230 6227 IF ECRB>=23 THEN ECRB=ECRB-23 6228 IF ECR>=23 THEN ECR=ECR-23 6230 IF MN>PRECRA THEN LINE(ECRB,(S!(ECRBA)-MINIY!))-(ECR,(S!(MN)-MINIY!)) 6240 CIRCLE (ECR,(S!(MN)-MINIY!)),TAILLE!:IF MN=PRIMIT AND ENZYM=0 AND K1(30)<>0 THEN LINE(MN,(S!(MN)-ECHELLE/10-MINIY!))-(MN,(S!(MN)+ECHELLE/10-MINIY!)) 6249 IF S!(48)=.0001 THEN ECRB=ECRB+23:ECR=ECR+23 6250㐞 NEXT MN 6300 PREMLEC=1:MASK=1:FONCT=134:GOSUB 310:ON J GOTO 6305,7000,6300,6300,6300,6300,5410,6300,6300,6300 6305 GOSUB 6980:GOTO 6300 6310 PREMLEC=LEC 6315 A$=INKEY$:IF A$<>"" THEN FONCT=134:L=5:GOSUB 355:ON J GOTO 6319,7000,6315,6315,6315,6315,5410,6315,6315,6315 6318 GOSUB 2516:IF TROUVE THEN 5840 ELSE 6315 6319 GOSUB 6980:GOTO 6315 6320 SA$="Absorbances Print":GOSUB 2030:IF TTCHO THEN METI=MONCH:GOSUB 2210 6330 COLOR 5,0:LOCATE 20,50:PRINT "Stop":LOCATE 21,51:PRINT "F5";:COLOR 1,2 6350 LPRINT㐞 TAB(1) "ABSORBANCES LIST ALL SAMPLES" 6360 GOSUB 7270 6380 ORIG=AUTMET:GOSUB 7285:FOR QW=1 TO 48:AUTMET=ORIG:IF AUTMET=0 AND QW<(PAR(24) AND 255) THEN GOSUB 3400:GOSUB 7285 6381 IF AUTMET=0 THEN CUVE=PLACE(QW):GOSUB 5020:GOTO 6390 6382 RETI(1)=1 6385 FOR WE=RETI(1)+1 TO LEN(CHAINE$):IF MID$(CHAINE$,WE,1)="." THEN RETI(2)=WE:WE=LEN(CHAINE$) 6387 NEXT WE:TRAITE=VAL(MID$(CHAINE$,RETI(1)+2,RETI(2)-(RETI(1)+2))):IF TRAITE=(PAR(24) AND 255) AND AUTMET=COUPE THEN QW=(PAR(24) AND 255)-1:GOTO 6680 6388 GOSUB㐞 7100:QW=TRAITE:PL=PL(QW):GOSUB 6410:GOSUB 6780:GOSUB 6670:IF QW=48 THEN 6680 6389 IF TRAITE<>MOIC THEN RETI(1)=RETI(2):GOTO 6385 ELSE QW=48:GOTO 6680 6390 GOSUB 3570:IF AUTMET=0 AND QW=1 AND PLACE(QW) AND BLANSYS THEN PL=254:GOTO 6400 6395 PL=PL(QW):IF PL=0 OR PL=255 OR (PLACE(QW)=0 AND ORIG=0) OR (AUTMET=0 AND ABDIS=0) THEN 6680 6400 GOSUB 6410:GOSUB 6780:GOTO 6660 6410 ECH=QW 6420 IF PL=254 AND (ECH=K1(77) OR (PRETRT=1 AND (ECH-16)=K1(77))) THEN ECH$="CAL. CONT2":GOTO 6460 6430 IF PL=254 AND (ECH=㐞 K1(76) OR (PRETRT=1 AND (ECH-16)=K1(76))) THEN ECH$="CAL. CONT1" :GOTO 6460 ELSE IF PL=254 THEN 6440 6435 IF PL=252 THEN ECH$="QC 2" ELSE IF PL=253 THEN ECH$="QC 1" ELSE IF PL=251 AND ECH<17 THEN ECH$="Stat" ELSE IF PL=251 THEN ECH$="Sample X" ELSE ECH$=" " 'a lire dans paille 6436 IF ECH$=" " AND PL>250 THEN 6440 ELSE 6460 6440 FOR BV!=1 TO 12 6445 IF ECH=1 OR (PRETRT=1 AND ECH=17) THEN ECH$="BLANK":GOTO 6450 6447 IF (ECH=K1(63+BV!)) OR (PRETRT=1 AND (ECH-16)=K1(63+BV!)) THEN ECH$="STD"+STR$(K1(6+BV!)㐞):BV!=12 6450 NEXT BV! 6460 DCUVE=PLACE(QW) 6470 IF QW<17 AND PRETRT=1 THEN LPRINT QW, ELSE IF QW<17 THEN LPRINT "C ";QW, ELSE LPRINT QW-16, 6480 LPRINT ECH$,:IF AUTMET THEN LPRINT:RETURN ELSE LPRINT "cuv. :";DCUVE:RETURN 6660 GOSUB 6670:GOTO 6680 'IF SIMPLE THEN SIMPLE=0:RETURN ELSE GOSUB 6670:GOTO 6680 6670 GOSUB 6965 6675 GOSUB 3000:RETURN 6680 NEXT QW:GOSUB 6967 6690 TTCHO=0:GOSUB 34:IF AUTMET<>0 OR RAN>1 THEN 5000 ELSE COLOR 5,0:LOCATE 20,50:PRINT " ":LOCATE 21,51:PRINT " ":COLOR 1,2:GOT㐞O 5100 6700 SA$="Absorbances Print":GOSUB 2030:IF TTCHO THEN METI=MONCH:GOSUB 2210 6730 LPRINT TAB(9) "SINGLE SAMPLE ABS LIST" 6740 GOSUB 7270 6760 IF AUTMET THEN GOSUB 7100 6765 QW=TRAITE:PL=PL(QW):GOSUB 6410:GOSUB 6780:GOTO 6940 6770 'IF AUTMET OR METFIN THEN GOSUB 7100 6780 IF AUTMET<>0 OR METFIN<>0 THEN 6785 ELSE CUVE=DCUVE:GOSUB 5020 6785 FOR LEC=1 TO DERLEC STEP 2:UN=0:DEUX=0 6790 IF AUTMET<>0 OR METFIN<>0 THEN GOSUB 3500:IF DOCAL=1 AND UN=0 THEN 6820 ELSE 6809 6800 IF LEC>ABDIS THEN LEC=DER㐞LEC:GOTO 6850 ELSE J=LEC:GOSUB 2516 6803 IF K1(6)<>3 AND K1(6)<>12 THEN GOSUB 3500:GOTO 6809 6805 FOR BV!=1 TO DERLEC:IF BV!>23 THEN BV!=DERLEC ELSE IF LE(BV!)=LEC THEN UN=1 ELSE IF LE(BV!)=LEC+1 THEN DEUX=1 6806 NEXT BV! 6809 IF UN THEN LPRINT TAB(1) "ABS ("; ELSE LPRINT "abs ("; 6810 LPRINT LEC;")" TAB(11) USING "##.####"; S!(LEC); 6820 J=LEC+1:IF AUTMET OR METFIN THEN 6835 6830 IF J>ABDIS THEN LEC=DERLEC:LPRINT:GOTO 6850 ELSE GOSUB 2516 6835 IF J>DERLEC THEN 6840 ELSE IF DOCAL=1 AND DEUX=0 THEN 6㐞845 6837 IF DEUX THEN ECR$="ABS (" ELSE ECR$="abs (" 6840 IF J>DERLEC THEN LPRINT " ":LEC=DERLEC:GOTO 6850 ELSE LPRINT TAB(20) ECR$;(LEC+1);")" TAB(31) USING "##.####"; S!(LEC+1) 6845 GOSUB 3000 6850 NEXT LEC:RETURN 6940 GOSUB 6965:GOSUB 6967 6960 GOSUB 34:GOTO 5600 6965 FOR IU!=1 TO 20:LPRINT "- ";:NEXT IU!:LPRINT:RETURN 6967 FOR IU!=1 TO 7:LPRINT:NEXT IU!:RETURN 6970 'plot en check abs 6980 GOSUB 34:SA$="Plot":GOSUB 2030 6985 'IF AUTMET THEN BV!=25000 ELSE BV!=35000! 6990 GOSUB 595:GOSUB 6967:㐞GOSUB 34:RETURN 7000 GOSUB 34:SA$="Next":GOSUB 2030 7002 S!(48)=0 7005 GOSUB 7010:GOTO 7020 7010 GOSUB 7220:IF TRAITE=48 THEN TRAITE=0 'dernier av change cups ou d'1 meth 7015 IF TRAITE=0 AND AUTMET=0 AND (PAR(24) AND 255)>1 THEN GOSUB 3400:GOSUB 7285:RETI(2)=1 '1er du plateau qd change cups 7016 IF AUTMET=COUPE AND TRAITE=MOIC AND AUTMET<>0 THEN AUTMET=0:METFIN=0 7017 RETURN 7020 IF AUTMET<>0 OR METFIN<>0 THEN RETI(1)=RETI(2) ELSE 7040 7022 FOR WE=RETI(1)+1 TO LEN(CHAINE$):IF MID$(CHAINE$,WE,1)=".㐞" THEN RETI(2)=WE:WE=LEN(CHAINE$) 7024 NEXT WE:TRAITE=VAL(MID$(CHAINE$,RETI(1)+2,RETI(2)-(RETI(1)+2))) 7030 GOSUB 7100:PLA=TRAITE:GOTO 7050 7040 GOSUB 3570:TRAITE=TRAITE+1:IF (PL(TRAITE)<>0 AND PL(TRAITE)<>255 AND PLACE(TRAITE)<>0) OR (TRAITE=1 AND BLANSYS) THEN CUVE=PLACE(TRAITE):GOSUB 5020:PLA=TRAITE ELSE GOSUB 7010:GOTO 7020 7045 IF ABDIS=0 THEN GOSUB 7010:GOTO 7020 7050 PREMLEC=1 'next en abs. graph 7060 PROCH=1:VIEW PRINT 6 TO 18:CLS:VIEW PRINT:LOCATE 4,66:GOSUB 3570:IF (PLA<17 AND PL(PLA)) OR (P㐞LA=1 AND BLANSYS) THEN PRINT "C";RIGHT$(STR$(PLA),LEN(STR$(PLA))-1); ELSE PRINT PLA-16; 7070 PRINT " ":GOTO 5770 'vers abs.graph ..renvoyer en 2893 pour choix next cuve 7080 'REP=VAL(R$):IF REP=K1(64) THEN ECH$="BLANK" ELSE IF (REP>0 AND REP<17) THEN ECH$="STD" ELSE IF PL(REP)=0 THEN ECH$="no Sample" ELSE ECH$="Sample" 7090 'RETURN 7100 MEMO$=".":IF AUTMET THEN GOSUB 7210:GOSUB 2195 'k1 7130 DEPA=5+(16*(ETOK%-1)+(ORDR-1))*48:FINA=DEPA+47 'cherche l'enregistrement de traite 7140 FINAL=FINA:FI㐞RST=0:LAST=0 7150 FOR TY=DEPA TO FINAL 7160 TYU=TY 7170 GET#1,TYU:AN2$=A1$:TRO=ASC(LEFT$(AN2$,1)):IF TRO<>0 THEN MEMO$=MEMO$+STR$(TRO)+"." ELSE 7190 7175 IF FIRST=0 THEN FIRST=TRO 7177 IF FIRST<>0 THEN LAST=TRO 7178 GOSUB 3570:IF TRAITE=TRO AND TRO=1 AND BLANSYS THEN PL(TRAITE)=254:GOTO 7200 7180 IF TRAITE=TRO THEN PL(TRAITE)=ASC(MID$(AN2$,2,1)):GOTO 7200 7190 NEXT TY:JUST=FIRST:MOIC=LAST:CLOSE#1:TRAITE=0:RETURN 7200 FOR PO%=1 TO 48:SI$=MID$(AN2$,1+(PO%*2),2):S!(PO%)=CVI(SI$)/10000:NEXT PO%:CLOSE#㐞 1:RETURN 7210 MITBA=METI:METI=MONCH:GOSUB 2210:METI=MITBA:RETURN 'k1 quand autmet 7220 IF AUTMET<>0 OR METFIN<>0 THEN 7230 ELSE RETURN 7230 IF TRAITE=MOIC AND ORIG=0 THEN AUTMET=0:RETURN ELSE IF TRAITE=MOIC THEN RETI(2)=1 7240 RETURN 7250 IF TTCHO<>0 OR RAN>1 THEN METI=(TTCHO AND 31):PLATO=(TTCHO AND 15872)/512 ELSE PLATO=(PAR(23) AND 496)/16 7255 GOSUB 1400:LOCATE 4,20:PRINT ECR$;B$(METI);" TRAY :";PLATO 7260 RETURN 7270 MUL$="":IF AUTMET=0 THEN MUTE=((PAR(19+(3*RAN)) AND 992)/32)-20 7275 IF MUTE>㐞0 THEN MUL$="MULT:"+LEFT$(MTT$(MUTE+20),6) 7277 IF RAN>1 OR AUTMET<>0 THEN LPRINT SONCH$ TAB(15) MUL$ TAB(29) "TRAY :";PLATE:GOTO 7282 7280 LPRINT B$(METI) TAB(15) MUL$ TAB(29) "TRAY :";PLATO 7282 GOSUB 6965:RETURN 7285 IF ORIG<>0 OR AUTMET<>0 THEN TRAITE=49:GOSUB 7100:CHAINE$=MEMO$ 7290 RETURN 7300 '--------- change calibration ----- 7390 CALCONT=K1(63+K1(1)+BLACOR) 7392 IF K1(76)>CALCONT THEN CALCONT=K1(76) 7394 IF K1(77)>CALCONT THEN CALCONT=K1(77) 7396 AIG3=CALCONT:RETURN 7480 OPEN"r",#1,"nam㐞eth",105:FIELD#1,105 AS DH$:GET#1,33:IF DH$=SPACE$(105) THEN DATHI$="00-00-00":CLOSE#1:RETURN ELSE DAH$=MID$(DH$,1+((METI-1)*4),4):MJ=CVI(LEFT$(DAH$,2)):IF MJ=0 THEN DATHI$="00-00-00":CLOSE#1:RETURN 7485 MOI=INT(MJ/100):JOU=MJ-(100*MOI):ANN$=RIGHT$(DAH$,2):DATHI$=STR$(MOI)+"-"+STR$(JOU)+"-"+ANN$:CLOSE#1:RETURN 7490 'change calib. 7500 DATA Move,Toggle,"Plot ",Last Calib,Print,Results,,,,"Change Calibration",, 7510 DATA Previous,Next,,,,,EXIT,,,Calibration Controls,, 7520 DATA ,,,,,Result,,,,Last Calib㐞ration,, 7530 REFU=PRESENCE:GOSUB 2193:LSET T1$=MKS$(REFU):PUT#1,26:LSET T1$=MKS$(SCH!):PUT#1,25 'raj calib 7540 LSET T1$=MKS$(C1!):PUT#1,23:LSET T1$=MKS$(O1!):PUT#1,24 7590 LSET T1$=MKS$(ALLE):PUT#1,39:LSET T1$=MKS$(CHCAL):PUT#1,40:LSET T1$=MKS$(ABAND):PUT#1,41:LSET T1$=MKS$(REVOI):PUT#1,42:LSET T1$=MKS$(BLACOR):PUT#1,43 7650 CLOSE#1:RETURN 7660 GOSUB 2193:GET#1,24:INTERC!=CVS(T1$):GET#1,25:SCH!=CVS(T1$):GET#1,26:REFU=CVS(T1$) 'lecture de la calib 7665 GET#1,23:ANGL!=CVS(T1$):GET#1,40:CHCAL=CVS(T1㐞$):GET#1,41:ABAND=CVS(T1$):GET#1,42:REVOI=CVS(T1$):GET#1,43:BLACOR=CVS(T1$):GET#1,44:BLACORI!=CVS(T1$):GET#1,45:BLACORF!=CVS(T1$):GET#1,46:RBL=CVS(T1$) 7670 C1!=ANGL!:O1!=INTERC! 7680 FOR BV!=1 TO K1(1)+BLACOR 7690 GET#1,(BV!+26):CC!(BV!)=CVS(T1$) 7700 NEXT BV!:CLOSE#1:RETURN 7710 LPRINT "CHANGE CALIBRATION":ALLE=1:CHCAL=0:METI=PAR(22) AND 31:GOSUB 2210:GOSUB 7660 'change calib 7715 MA%=0:GOSUB 600:GOSUB 34:GOSUB 33:RAN=1:GOSUB 7480:GOSUB 2160 7717 IF ABAND THEN DEJAAB=1:GOSUB 593:GOTO 8120 7718 IF㐞 BLACOR THEN PLUS=1 'IF ((ABS(K1(38))+ABS(K1(35)))<>8 AND K1(64)<>1) OR BLACOR<>0 THEN PLUS=1 7720 COMBIEN=0:IF REFU THEN PRESENCE=REFU ELSE 7750 7730 FOR BV!=1+BLACOR TO K1(1)+BLACOR:IF (REFU AND 2^(BV!-1))<>0 THEN COMBIEN=COMBIEN+1 7740 NEXT BV!:GOTO 7760 7750 FOR ETA=1+BLACOR TO K1(1)+BLACOR:PRESENCE=PRESENCE OR 2^(ETA-1) 7755 NEXT ETA:COMBIEN=K1(1) 7760 GOSUB 8580 7765 'droite de calib. 7770 IF CORRESPOND<>0 AND O1!>0 THEN LINE(0,-O1!)-(MAXX!,(ABS(C1!*MAXX!))-O1!),1:GOTO 7790 7780 IF CORRESPON㐞D THEN LINE(0,ABS(O1!))-(MAXX!,(ABS(C1!*MAXX!))+ABS(O1!)),1 ELSE LINE(0,O1!)-(MAXX!,(C1!*MAXX!)+O1!),1 7790 LOCATE 19,10:PRINT "SLOPE :";USING "###.#####"; C1!:LOCATE 19,29:PRINT "INTERCEPT :";USING "##.#####";O1! 7800 ETAPE=1+PLUS 7810 GOSUB 8490:GOSUB 593 'curseur 7815 FONCT=126 7820 GOTO 8290 'MOINS=3:MASK=1:L=19:C=1:GOSUB 310:ON J GOTO 7880,7930,7990,7830,7821,8290,7820,7820,7820,7820 7821 LOCATE 24,37:PRINT "Print":GOSUB 595:LOCATE 24,37:PRINT SPACE$(5):GOTO 7820 7830 IF RIGHT$(DATHI$,2)="㐞00" THEN 7820 ELSE 8120 7870 'move en ch. calib. 7880 CONTOUR=2:RAYON!=2*TAILLE!:GOSUB 8410 7890 IF ETAPE=6 THEN ETAPE=1+PLUS ELSE ETAPE=ETAPE+1 7895 IF K1(63+ETAPE)=0 THEN 7890 7900 CONTOUR=1:RAYON!=2*TAILLE!:GOSUB 8410 7910 GOTO 7820 7920 'toggle en ch. cal. 7930 IF ETAPE=1 AND PLUS<>0 THEN 7820 ELSE MOINS=3 7940 IF (PRESENCE AND 2^(ETAPE-1))=0 THEN PRESENCE=PRESENCE+2^(ETAPE-1):COMBIEN=COMBIEN+1:GOTO 7960 7950 IF (PRESENCE AND 2^(ETAPE-1))<>0 AND COMBIEN<=MOINS THEN 7970 ELSE PRESENCE=PRESENCE-㐞2^(ETAPE-1):COMBIEN=COMBIEN-1 7960 IF (PRESENCE AND 2^(ETAPE-1)) THEN CONTOUR=0:GOSUB 8440:CONTOUR=1:RAYON!=TAILLE!:GOSUB 8410 ELSE CONTOUR=0:RAYON!=TAILLE!:GOSUB 8410:CONTOUR=1:GOSUB 8440 7970 GOTO 7820 7980 'plot en ch. cal. 7990 CHPLOT=1:GOSUB 8580 8000 'correspondance des points pour regression 8010 GOSUB 8315:IF IDEM<1 THEN 7720 'nb de points 8060 ETAPE=1+PLUS:GOSUB 8490 'touches fonct. 8065 IF CORRESPOND <>0 AND B2!>0 THEN LINE(0,-B2!)-(MAXX!,ABS((B1!*MAXX!)-B2!)):GOTO 8090 8070 IF CORRESPO㐞 ND THEN LINE(0,ABS(B2!))-(MAXX!,(ABS(B1!*MAXX!))+ABS(B2!)):GOTO 8090 8080 LINE(0,B2!)-(MAXX!,(B1!*MAXX!)+B2!) 'trace droite 8090 LOCATE 19,10:PRINT "SLOPE :";USING "###.#####"; B1!:LOCATE 19,29:PRINT "INTERCEPT :";USING "##.#####";B2! 8100 GOTO 7820 8110 'manual en ch. cal. 8120 SCREEN 0:GOSUB 9100:RESTORE 7520:GOSUB 120:ABAND=ABAND+1:IF ABAND=1 THEN COLOR 5,0:LOCATE 20,72,0:PRINT " EXIT ":LOCATE 21,74:PRINT "F7";:COLOR 1,2 'ecran manuel 8125 SLO!=K1(78):ORI!=K1(79) 8130 LOCATE 6,1:PRINT "LAST VALI㐞DATED CALIBRATION : SLOPE =";:PRINT USING "###.#####";SLO! 8140 LOCATE 6,50:PRINT "INTERCEPT =";:PRINT USING "##.#####";ORI!:PRINT "DATE : ";DATHI$ 8155 IF ABAND=1 THEN FONCT=192:COLOR 5,0:LOCATE 20,72:PRINT " EXIT ":LOCATE 21,74:PRINT "F7":COLOR 1,2 ELSE FONCT=64 8157 IF RIGHT$(DATHI$,2)="00" THEN FONCT=FONCT-64 8160 ' MASK=1:L=7:C=1:GOSUB 310:ON J GOTO 8160,8160,8160,8160,8160,8200,8280,8160,8160,8160 8200 LOCATE 13,48,0:SA$="Last Valid":C1!=K1(78):O1!=K1(79) 8205 B1!=C1!:B2!=O1! 8210 CHCAL=1:GOSUB㐞 2193:FOR BV!=22 TO 38 8220 IF BV!=23 THEN LSET T1$=MKS$(B1!) ELSE IF BV!=24 THEN LSET T1$=MKS$(B2!) ELSE LSET T1$=MKS$(0) 8230 PUT#1,BV!:NEXT BV!:IF BLACOR=1 AND RBL=1 THEN LSET T1$=MKS$(K1(91)):PUT#1,44:LSET T1$=MKS$(K1(92)):PUT#1,45 8235 GOSUB 7590 8270 GOSUB 602:GOTO 1975 8280 ABAND=ABAND-1:CHPLOT=0:GOTO 7760 8290 TEMOIN=0:FOR MN=0+BLACOR TO 5:IF PRESENCE AND 2^(MN) THEN TEMOIN=TEMOIN+1 'results en ch. cal. 8300 NEXT MN 8305 IF (K1(1)=TEMOIN) AND (PRESENCE=(REFU AND 63)) THEN GOSUB 7390:VIEW:W㐞INDOW:SCREEN 0:GOSUB 9100:GOSUB 602:SA$="Results":RESULT=1:GOTO 1975 8310 GOSUB 8315:IF IDEM<1 THEN 7720 ELSE 8340 8315 DERNIER=K1(1)+BLACOR 8320 FOR PO%=1 TO DERNIER:X!(PO%)=K1(6+PO%):Y!(PO%)=CC!(PO%):NEXT PO% 8330 GOSUB 8890:RETURN 'regression 8340 C1!=B1!:O1!=B2! 'nouveaux coeff. 8350 CHCAL=1:VIEW:WINDOW:GOSUB 7530:GOSUB 602 'raj calib ds temper 8360 SA$="Results":GOTO 1975 8370 'exit en ch. cal. 8380 VIEW:WINDOW:SCREEN 0:GOSUB 9100:CHPLOT=0:GOTO 1971 8400 'cercle 8410 MET!=CC!(ETAPE) 841㐞5 IF CORRESPOND THEN CIRCLE(K1(6+ETAPE),ABS(MET!)),RAYON!,CONTOUR:RETURN 8420 CIRCLE(K1(6+ETAPE),MET!),RAYON!,CONTOUR:RETURN 8430 'croix 8440 MET!=CC!(ETAPE) 8445 IF CORRESPOND THEN LINE(K1(6+ETAPE)+TAILLE!,ABS(MET!)+COTE!)-(K1(6+ETAPE)-TAILLE!,ABS(MET!)-COTE!),CONTOUR ELSE 8460 '/ 8450 LINE(K1(6+ETAPE)-TAILLE!,ABS(MET!)+COTE!)-(K1(6+ETAPE)+TAILLE!,ABS(MET!)-COTE!),CONTOUR:RETURN '\ 8460 LINE(K1(6+ETAPE)+TAILLE!,MET!-COTE!)-(K1(6+ETAPE)-TAILLE!,MET!+COTE!),CONTOUR '\ 8470 LINE(K1(6+ETAPE)-TAILLE!,㐞MET!-COTE!)-(K1(6+ETAPE)+TAILLE!,MET!+COTE!),CONTOUR:RETURN '/ 8480 'position cercle curseur 8490 RAYON!=2*TAILLE!:GOSUB 8410:RETURN 8570 'dessin de depart 8580 IF CHPLOT=0 THEN SCREEN 2:GOSUB 9100 8581 RESTORE 7500:GOSUB 120:IF REVOI=0 THEN COLOR 5,0:LOCATE 20,72:PRINT " EXIT ": LOCATE 21,74:PRINT "F7";:COLOR 1,2 8600 MINY!=100:MAXY!=-100:MAXX!=0:CORRESPOND=0 'test des dabs et conc. 8610 IF C1!<0 AND O1!<=0 THEN COE=-1:CORRESPOND=1 ELSE COE=1 8615 FOR ETA=1+BLACOR TO K1(1)+BLACOR 8620 IF (CC!(ET㐞A))>MAXY! THEN MAXY!=(CC!(ETA))*COE 8630 IF (CC!(ETA)) MAXX! THEN MAXX!=K1(6+ETA) 8650 NEXT ETA 8652 IF C1!<0 AND MAXY!<0 AND MINY!<0 THEN COE=1:CORRESPOND=0:MAXY!=-MAXY!:MINY!=-MINY! 8655 VALSUP!=MAXY!:VALINF!=MINY! 8660 IF (MAXY!0 THEN MINY!=0:GOTO 8690 8680 IF MINY!>=-.001 THEN MINY!=-.001 ELSE IF MINY!>=-.01 THEN MINY!=-.01 ELSE IF MINY!>=-.1 THEN MINY!=-.1 ELSE IF MIN㐞Y!>=-.2 THEN MINY!=-.2 ELSE MINY!=((INT(MINY!*2))/2-.5) 8690 IF MAXY!<.001 THEN GRANDEUR=.001 ELSE IF MAXY!<.01 THEN GRANDEUR=.01 ELSE IF MAXY!<.1 THEN GRANDEUR=.1 ELSE IF MAXY!<.25 THEN GRANDEUR=.25 ELSE GRANDEUR=(INT(MAXY!*2))/2+.5 8700 IF MAXX!<.001 THEN DERCON!=.001 ELSE IF MAXX!<.01 THEN DERCON!=.01 ELSE IF MAXX!<.1 THEN DERCON!=.1 ELSE IF MAXX!<.25 THEN DERCON!=.25 ELSE DERCON!=(INT(MAXX!*2))/2+.5 8710 TAILLE!=DERCON!/120:COTE!=GRANDEUR/50:ECHELLEY=GRANDEUR+GRANDEUR/10+ABS(MINY!):ECHELLEX=DERCON!+D㐞ERCON!/10 8720 IF DERCON!>.5 THEN ECHELLEX=DERCON!+.3 8730 IF GRANDEUR>.5 THEN ECHELLEY=GRANDEUR+.3 8740 VIEW(130,30)-(552,140) 8750 WINDOW(-2*TAILLE!,ECHELLEY)-(ECHELLEX,MINY!-(2*COTE!)) 8755 IF MINY!=0 OR (MINY!<0 AND MAXY!>=0) THEN LINE(0,0)-(ECHELLEX,0) 8760 LINE(0,MINY!)-(0,ECHELLEY) 'trace des axes X puis Y! 8770 FOR QWE=1 TO 4 'grad. en y 8780 LINE(0,(QWE*GRANDEUR/4))-(TAILLE!,(QWE*GRANDEUR/4)) 8790 NEXT QWE 8800 LOCATE 5,10:IF K1(6)=1 THEN PRINT "dAbs" ELSE PRINT "dAbs/t" 8810 LOCATE 18㐞 ,12:PRINT MINY!:IF CORRESPOND THEN LOCATE 12,10:PRINT -GRANDEUR/2:LOCATE 6,10:PRINT -GRANDEUR ELSE LOCATE 6,10:PRINT GRANDEUR 8820 L=INT(12*GRANDEUR/(GRANDEUR-MINY!))+6:IF CORRESPOND=0 AND MINY!=0 THEN LOCATE 12,10:PRINT GRANDEUR/2 ELSE IF L<18 AND CORRESPOND=0 THEN LOCATE L,12:PRINT "0" 8830 LOCATE 19,66:PRINT "CONC" 8840 FOR ETAPE=1+BLACOR TO K1(1)+BLACOR 'trace des points 8845 IF K1(63+ETAPE)=0 THEN 8860 8850 IF PRESENCE AND 2^(ETAPE-1) THEN CONTOUR=0:GOSUB 8440:CONTOUR=1:RAYON!=TAILLE!:GOSUB 8410 㐞ELSE CONTOUR=0:RAYON!=TAILLE!:GOSUB 8410:CONTOUR=1:GOSUB 8440 8860 NEXT ETAPE 8870 RETURN 8880 'regression des elements y par elements x 8890 G9=0:G8=0:G7=0:G6=0:G5=0 8900 IDEM=0:KJ=0:QW=0:FOR PAT=1 TO DERNIER 'moyenne x et y 8910 IF (PRESENCE AND 2^(PAT-1))=0 THEN 8930 8915 QW=QW+1:IF QW=1 THEN 8916 ELSE IF K1(6+PAT)<>KJ THEN IDEM=IDEM+1 8916 KJ=K1(6+PAT) 8920 G9=G9+1:G8=G8+Y!(PAT):G7=G7+X!(PAT) 8930 NEXT PAT:IF IDEM<1 THEN LPRINT "IMPOSSIBLE CALCULATION":RETURN 8940 G8=G8/G9:G7=G7/G9:G9=0 895㐞0 FOR PAT=1 TO DERNIER 'regression 8960 IF (PRESENCE AND 2^(PAT-1))=0 THEN 8990 8970 G6=G6+(Y!(PAT)-G8)*(X!(PAT)-G7) 8980 G5=G5+(X!(PAT)-G7)^2 8990 NEXT PAT 9000 B1!=G6/G5 'slope 9010 B2!=G8-B1!*G7 'origine y 9020 RETURN 9100 COLOR 5,0:VIEW PRINT 1 TO 21:CLS:VIEW PRINT'cadre 9150 COLOR 1,2:VIEW PRINT 3 TO 19:CLS:VIEW PRINT 9160 VIEW PRINT 22 TO 25:CLS:VIEW PRINT 9170 COLOR 5,0:LOCATE 23,1:PRINT SPACE$(11):LOCATE 23,70:PRINT SPACE$(11) 9180 LOCATE 24,1:PRINT SPACE$(11):LOCATE 24,70:PRINT SPACE$㐞(11) 9190 LOCATE 25,1:PRINT SPACE$(11);:LOCATE 25,70:PRINT SPACE$(11);:COLOR 1,2 9210 LOCATE 23,32,0:PRINT "Instrument Status TC :" 9220 LOCATE 23,64:PRINT USING "##.#"; VAL(TEMPER$) 9230 RETURN 9300 SCREEN 2:RETURN 10000 IF S!(48)<>.0001 THEN TOTO=DERLEC ELSE IF K1(30)>8 THEN TOTO=(K1(44)+1) ELSE TOTO=DERLEC 10010 RETURN 30000 OPEN"r",#1,"NAMETH",105 30010 FIELD#1,6 AS A1$,6 AS D$,32 AS A2$,32 AS A3$,6 AS U1$,6 AS U2$,1 AS D1$,1 AS D2$,5 AS COF$,5 AS E1$,5 AS E2$ 30020 FOR I=1 TO 32 300㐞30 GET#1,I 30040 B$(I)=A1$:MTT$(I)=A3$ 30050 NEXT I:CLOSE#1:RETURN 0,O1!)-(MAXX!,(C1!*MAXX!)+O1!),1 7790 LOCATE 19,10:PRINT "SLOPE :";USING "###.#####"; C1!:LOCATE 19,29:PRINT "INTERCEPT :";USING "##.#####";O1! 7800 ETAPE=1+PLUS 7810 GOSUB 8490:GOSUB 593 'curseur 7815 FONCT=126 7820 GOTO 8290 'MOINS=3:MASK=1:L=19:C=1:GOSUB 310:ON J GOTO 7880,7930,7990,7830,7821,8290,7820,7820,7820,7820 7821 LOCATE 24,37:PRINT "Print":GOSUB 595:LOCATE 24,37:PRINT SPACE$(5):GOTO 7820 7830 IF RIGHT$(DATHI$,2)="Z>㐞1 ' modif IMMUNO 06.01.88 modif 3.0.0 06.04.88 2 '************************************************************* 5 ' programme pret a etre compile LTCP 15.11.88 6 ' modif pour repropositions 23.10.87 7 '************************************************************* 8 'charg. plat.,modif 2 rn part+tab m()+4 trays+cl in+a-g 10 DEFINT A-J, N-U, W-Z 15 DIM P64(64), LE%(48), PLACE(48), PAR(60), B$(32), MTT$(32) 16 DIM PL(50), PLP(50), PLS(50), PLM(50), PLPM(50), PRED(8) 㐞17 DIM PLB(50), PLPB(50), PLMB(50), PLPMB(50) 20 DIM K1(100), NMLI$(32), PAT$(32), MUL(9), HF$(28), L(5), C(5), TCAL(10), RDX(2) 30 COMMON STATUS, METH%, P64(), LE%(), PLACE(), O1!, C1!, O2, C2, AIG1, AIG3, PAR(), M%, M1%, RE, VER%, BUT, PAS, PA$, LIGNE%, METP%, DEMET, LIMI%, NONL$, TEMPER$, DATEF$, RSTART, STAT, INTMETH, CALB, METCO, MULTI 31 LPRINT "in ltcp": GOSUB 30000: F9% = 2 ^ 8: RIV = 1: MA% = 0: GOSUB 600: GOSUB 1000: GOTO 6525 34 LOCATE 24, 13: PRINT SPACE$(55): LOCATE 25, 16: PRINT SPACE$(39)㐞; : RETURN 35 C = 33 - INT(LEN(PA$) / 2) 36 GOSUB 592: CLOSE : IF PA$ = "RDCP" THEN 40 38 RSTART = 0: STAT = 0: INTMETH = 0: CALB = 0: METCO = 0: MULTI = 0 40 VFREE = FRE(""): CHAIN PA$ 100 READ A$ 105 IF LON = 0 THEN 110 106 IF A$ = "" THEN A$ = " " 107 N = INT(LEN(A$) / 2): RETURN 110 PRINT A$; : LON = 0: RETURN 120 GOSUB 600: COLOR 5, 0: LOCATE 1, 20, 0: PRINT SPACE$(40): LOCATE 2, 30: PRINT SPACE$(20): COLOR 1, 2 121 IF (PRETR AND APRET) AND NO = 0 THEN 122 ELSE NO = 0: IF NON = 0 TH㐞 EN GOSUB 602 ELSE NON = 0 122 COLOR 5, 0: C12 = 5: FOR I = 1 TO 7: READ A$: CUR = 11 * (I - 1) + INT(.4 * I) 160 IF I > 1 THEN LOCATE 20, 2 + CUR ELSE LOCATE 20, 1 + CUR 162 A3$ = SPACE$(5 - LEN(A$) / 2) + A$: A$ = A3$ + SPACE$(10 - LEN(A3$)): PRINT A$ 164 LOCATE 21, C12 - 2 165 IF A$ = SPACE$(10) THEN PRINT " ": GOTO 168 166 IF (SUP% AND 2 ^ (I - 1)) = 2 ^ (I - 1) THEN PRINT " S F" + RIGHT$(STR$(I), 1): GOTO 168 167 PRINT " F" + RIGHT$(STR$(I), 1) + " " 168 C12 = C12 + 11 + CINT(I / 2 - INT(I㐞 / 2)): NEXT I 169 L(1) = 24: C(1) = 7: L(2) = 24: C(2) = 75: L(3) = 1: C(3) = 39: L(4) = 1: C(4) = 6: L(5) = 2: C(5) = 40 170 FOR I = 8 TO 12: LON = 1: GOSUB 100: LOCATE L(I - 7), C(I - 7) - N: GOSUB 110: NEXT I 205 IF PASSAG AND PAR(34) <> 64 THEN A1$ = " Start ": A2$ = " F8 " ELSE A1$ = SPACE$(11): A2$ = SPACE$(11) 210 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 1: GOSUB 110: A$ = A2$: LOCATE 25, 1: GOSUB 110 220 IF STATUS <> 9 OR NOSAMP OR NOSAM THEN A1$ = SPACE$(11): A2$ = SPACE$(11) ELSE 㐞A1$ = " Abort ": A2$ = " S F9 " 225 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 70: GOSUB 110: A$ = A2$: LOCATE 25, 70: GOSUB 110 226 COLOR 1, 2: SUP% = F9%: RETURN 230 SS$ = "": IF PAR(16) THEN ME = PAR(7 + PAR(16)): GOTO 233 ELSE 232 231 IF PAR(9 + PAR(16)) THEN 233 232 AFF$ = SPACE$(30): GOTO 240 233 GOSUB 1659 235 GOSUB 1665 237 GOSUB 1670 240 LOCATE 2, 50: COLOR 5, 0: PRINT AFF$; : COLOR 1, 2: RETURN 592 DAT% = &HFF40: GOTO 594 593 DAT% = &HBF00 594 DOV% = &H32: cim% = &HF: CALL IO(DO㐞V%, cim%, DAT%, RET%): RETURN 595 CALL HAR: RETURN 600 CALL CLA(MA%, SUP%): RETURN 601 DOV% = &H32: cim% = 5: RET% = 0: CALL IO(DOV%, cim%, DAT%, RET%): RETURN 602 VIEW PRINT 3 TO 19: CLS : VIEW PRINT: IF FRECU THEN LOCATE 25, 16: PRINT 64 - PAR(34); : RETURN ELSE RETURN 610 PA$ = "maincp": GOTO 35 625 IF AIG1 THEN T1 = AIG1 ELSE M% = PAR(22) AND 31: GOSUB 5130: GET #1, (M% - 1) * 100 + 6: T1 = CVS(A1$): CLOSE #1 627 ON T1 GOTO 630, 630, 640, 660, 650, 650, 664, 640, 662, 660, 640, 640 630 IF BUT <>㐞 0 THEN PA$ = "calc1cp": GOTO 35 640 IF BUT <> 0 THEN PA$ = "calc2cp": GOTO 35 650 IF BUT <> 0 THEN PA$ = "calc3cp": GOTO 35 660 IF BUT <> 0 THEN PA$ = "calc4cp": GOTO 35 662 IF BUT <> 0 THEN PA$ = "calc5cp": GOTO 35 664 IF BUT <> 0 THEN PA$ = "calc6cp": GOTO 35 670 PA$ = "anast": GOTO 35 680 BUT = 3: PA$ = "parcp": GOTO 35 740 REPO = 0: F$ = INKEY$: IF F$ = "" THEN 790 745 REIT = 0: IF F$ = CHR$(138) AND PAR(37) AND PAR(17) = 0 AND NOSAMP = 0 THEN GOSUB 810 750 IF (ENTREE AND 2 ^ REIT) THEN 755 E㐞LSE 785 755 IF F$ = CHR$(130 + REIT) THEN REPO = REIT + 1: GOTO 790 785 IF REIT < 7 THEN REIT = REIT + 1: GOTO 750 790 RETURN 810 LOCATE 24, 30: PRINT " ABORT REQUESTED " ': QP$ = "STO" + CHR$(13) + CHR$(10) 813 'I = 1: DEV% = 52 816 'cim% = &H10: GOSUB 5157: IF RET% = 0 THEN 816 ELSE CHAR = ASC(MID$(QP$, I, 1)): cim% = 1: DAT% = CHAR 819 'GOSUB 5157: I = I + 1: IF CHAR <> 10 THEN 816 822 'R$ = "": cim% = &HC: DAT% = 0: GOSUB 5157 825 'cim% = 2: DAT% = 0 828 'GOSUB 5157: CHAR = RET% 831 'IF C㐞HAR = -1 THEN 828 ELSE R$ = R$ + CHR$(CHAR) 834 'IF CHAR <> 10 THEN 828 ELSE cim% = &HC: DAT% = 1: GOSUB 5157 837 'test reponse valide 840 COLOR 5, 0: FOR T = 24 TO 25: LOCATE T, 1, 0: PRINT SPACE$(11); : LOCATE T, 70, 0: PRINT SPACE$(11); : NEXT T: COLOR 1, 2: PAR(17) = 1: STATUS = 0: CHOIX = 17: GOSUB 1310: RETURN 900 GOSUB 601: GOSUB 593 902 A$ = INKEY$: IF A$ = "" THEN 902 ELSE GOSUB 592 905 RESTORE 5001: FOR BOU = 1 TO 28: READ T: IF A$ = CHR$(T) THEN 920 910 NEXT BOU 911 IF A$ = CHR$(136) AND 㐞STAT = 0 THEN 7945 ELSE IF A$ = CHR$(138) AND PAR(37) <> 0 AND PAR(17) = 0 THEN GOSUB 810: GOTO 900 ELSE 900 920 IF BOU > 20 THEN HH = 0: GG = 21 ELSE 922 921 IF MTT$(BOU) = SPACE$(32) OR MTT$(BOU) = "" THEN 900 ELSE TABL$ = LEFT$(MTT$(BOU), 6): GOTO 925 922 IF BOU < 11 THEN GG = 1: HH = 1 ELSE GG = 11: HH = 2 924 IF B$(BOU) = SPACE$(12) OR B$(BOU) = "" THEN 900 ELSE TABL$ = LEFT$(B$(BOU), 6) 925 GOSUB 970: DD = (BOU - GG) 926 GOSUB 931: R$ = STR$(BOU): GOSUB 593: GOTO 6595 929 COU = 2: GOSUB 932: RE㐞TURN 930 COU = 7: GOSUB 933: GOSUB 935: RETURN 931 COU = 0: GOSUB 932: COLOR 5, 0: GOSUB 935: COLOR 1, 2: RETURN 932 LINE ((X1 + (HH * 24) + (DD * 56)), 36 + (HH * 24))-((53 + X1) + (DD * 56) + (HH * 24), 58 + (HH * 24)), COU, BF: RETURN 933 LINE ((X1 + (HH * 24) + (DD * 56)), 36 + (HH * 24))-((53 + X1) + (DD * 56) + (HH * 24), 58 + (HH * 24)), COU, B: RETURN 935 LOCATE 6 + (HH * 3), (4 + ((HH * 3) + (DD * 7))): PRINT TABL$: LOCATE 6 + 1 + (HH * 3), (4 + ((HH * 3) + (DD * 7))): PRINT " "; HF$(BOU): 㐞 RETURN 970 X1 = 21: RETURN 997 IF VER% <> 8 THEN SCREEN 2 998 GOSUB 9240: RETURN 999 LOCATE 17, 18: PRINT "Press a labelled key to select a method": RETURN 1000 IF VER% = 8 THEN GOSUB 9240: RETURN ELSE SCREEN 2: GOSUB 9240: RETURN 1001 IF ECRALPHA THEN ECRALPHA = 0: RETURN ELSE SCREEN 0: GOSUB 9240: RETURN 1090 GOSUB 5135 1110 FOR I = 1 TO 28: GET #1, I: IF I > 20 THEN 1120 1115 B$(I) = A1$ + SPACE$(6): GOTO 1125 1120 NMLI$(I) = A2$: MTT$(I) = A3$ 1125 NEXT I: CLOSE #1: GOSUB 1132: RETURN 1132 R㐞ESTORE 5000: FOR T = 1 TO 28: READ BX$: HF$(T) = BX$: NEXT T: RETURN 1135 X1 = 21: Y4 = 0: WD = 45: LR = 20 1140 FOR T = 0 TO 2: X1 = 21: IF T = 1 THEN Y4 = 112: LR = 0: WD = 59 1145 RP = T: GOSUB 1160: RP = 0: FOR X1 = (77 + (T * 24)) TO ((413 + (T * 24)) + Y4) STEP 56: GOSUB 1160: NEXT X1: GOSUB 1150: NEXT T: LOCATE 6, 60: PRINT "MULTITESTS": RETURN 1150 FOR SS = 4 + (T * 3) TO WD + 14 STEP 7: LR = LR + 1: GOSUB 1155: LOCATE 6 + (T * 3), SS: PRINT PW$: LOCATE 7 + (T * 3), SS: PRINT " "; HF$(LR): NE㐞XT SS: LR = 10: RETURN 1155 IF LR > 20 THEN PW$ = LEFT$(MTT$(LR), 6): RETURN ELSE PW$ = LEFT$(B$(LR), 6): RETURN 1160 LINE (X1 + (RP * 24), 36 + (T * 24))-((X1 + 53) + (RP * 24), 58 + (T * 24)), 7, B: RETURN 1170 NBMO = 0: IF VER% >= 16 OR RSTART THEN RSTART = 0: RETURN 1171 NBMO = PAR(52) + PAR(37) 1172 FOR T = 1 TO 8 1173 IF MUL(T) = 0 THEN 1177 1174 IF (PLM(50) AND 2 ^ (T - 1)) THEN 1177 ELSE NBMO = NBMO + 1 1177 NEXT T 1178 IF NBMO > O2 THEN NBMO = 1 ELSE NBMO = 0 1179 RETURN 1180 IF (PLM(5㐞0) AND 2 ^ (PAR(40) - 1)) THEN PAR(40) = PAR(40) + 1: GOTO 1180 ELSE RETURN 1185 IF NEWT = 0 THEN RETURN 1186 IF (PAR(41 + POINTEUR + (METCO - 1) * 4) AND 256) THEN RETURN 1187 PAR(41 + POINTEUR + (METCO - 1) * 4) = 0: RETURN 1200 PLM(50) = 0: FOR IX = 1 TO 8 1201 IF MUL(IX) THEN PLM(50) = PLM(50) OR 2 ^ (IX - 1) ELSE 1218 1203 FOR IJ = 2 TO 48 1204 IF (PLM(50) AND 2 ^ (IX - 1)) = 0 THEN 1218 1205 IF (PLM(IJ) AND 2 ^ (IX - 1)) THEN PLM(50) = PLM(50) XOR 2 ^ (IX - 1) 1217 NEXT IJ 1218 NEXT IX: LSET㐞 F4$ = MKI$(PLM(50)): PUT #3, 50: RETURN 1240 IF PARTF THEN PART = PARTF: REPORT = 1 1245 RETURN 1250 VIR = 0: IF RIV = 0 THEN RETURN 1251 M% = (PAR(19 + (3 * PAR(37))) AND 992) / 32: IF M% THEN MULTI = M%: GOTO 1260 1255 M% = PAR(19 + (3 * PAR(37))) AND 31 1260 IF M% = PAR(8) THEN METCO = 1 ELSE METCO = 2 1265 IF PAR(37 + METCO) THEN VIR = 2: GOTO 1290 1270 IF PAR(40 - METCO) THEN VIR = 1 ELSE VIR = 0: M% = 0: MULTI = 0: GOTO 1290 1280 MULTI = 0: M% = PAR(10 - METCO): IF M% > 20 THEN MULTI = M% 1㐞290 RETURN 1300 L = 25 1301 IF BTL THEN BI$ = "4 TRAYS IN MEMORY" ELSE BI$ = "2 METHODS IN MEMORY" 1302 BTL = 0: GOSUB 2021: RETURN 1310 GOSUB 5140: LSET P1$ = MKI$(PAR(CHOIX)): PUT #1, CHOIX: CLOSE #1: RETURN 1315 ENR = ASC(MID$(CHA$, PXI, 1)): GET #2, ENR 1320 NOMU = 1: RANG = PXI - (PART - 1) * 32 + 16 1321 IF STAGNE THEN 1360 1323 ME = MUL(NOMU) 1325 IF ME > 10 THEN TY = 1 ELSE TY = 0 1326 MP2 = CVI(MID$(P$, ((MUL(NOMU) - 1) * 6) + 1, 2)) 1330 IF TY THEN MDE = CVI(M2$): MFA = CVI(MR2$) ELSE M㐞DE = CVI(M1$): MFA = CVI(MR1$) 1332 MAS1 = 2 ^ ((ME - 1) - (TY * 10)) 1335 IF MFA AND MAS1 THEN 1355 1340 IF (MDE AND MAS1) = 0 THEN 1355 1341 IF RERUN THEN 1343 1342 IF (MP2 AND (2 ^ 11 + 2 ^ 12 + 2 ^ 14)) = 2048 THEN 1345 1343 IF (MP2 AND 2 ^ 14) = 16384 THEN DILMA = 1 1344 IF (MP2 AND (2 ^ 11 + 2 ^ 12)) = 4096 THEN REDIL = REDIL + 1: IF REDIL > 15 THEN 1355 ELSE GOTO 1345 1345 PLM(RANG) = PLM(RANG) OR 2 ^ (NOMU - 1): IF RED < REDIL THEN I = RANG: LIEU = NOMU: GOSUB 8735: RED = REDIL 1355 NOMU = 㐞NOMU + 1: IF MUL(NOMU) THEN 1323 1360 PL(RANG) = PXI: PLM(RANG) = PLM(RANG) OR PLMB(RANG): PLP(RANG) = PLP(RANG) OR PLPB(RANG): PLPM(RANG) = PLPM(RANG) OR PLPMB(RANG) 1365 IF PLM(RANG) THEN PAT$(RANG - 16) = NM$ ELSE PL(RANG) = 0 1370 RETURN 1380 FOR REC = 1 TO 48: IF REC > 16 THEN RECI = REC - 16 ELSE RECI = 0 1381 PXI = (PART - 1) * 32 + RECI 1382 IF PLB(REC) >= 251 THEN PL(REC) = PLB(REC): PLM(REC) = PLMB(REC): PLP(REC) = PLPB(REC): PLPM(REC) = PLPMB(REC): GOTO 1400 1383 IF RECI THEN GOSU㐞B 1315 1400 NEXT REC: RETURN 1405 GOSUB 5150: GOSUB 5152: GET #1, 1 1410 GOSUB 1380: CLOSE #1: CLOSE #2: RETURN 1420 GOSUB 1455: IF REPORT THEN 1440 1425 IF NEWT THEN 1450 ELSE GOSUB 1470: GOTO 1450 1440 IF NEWT = 0 THEN GOSUB 1470 1445 GOSUB 1405 1450 GOSUB 1680: RETURN 1455 PTREM = POINTEUR + (4 * (METCO - 1)) 1456 RESTORE 5095: FOR T = 1 TO PTREM: READ FIL$: NEXT T: RETURN 1460 GOSUB 1455 1470 GOSUB 2000: RETURN 1480 IF VER% >= 16 AND VER% <> 512 AND VER% <> 1024 THEN STAGNE = 1 1485 IF VER㐞 % = 10 OR VER% = 512 OR VER% = 1024 THEN LECTURE = 0 1490 IF (LECTURE AND 2) = 0 THEN LECTURE = LECTURE OR 2: GOSUB 1420 1500 GOSUB 6516: RETURN 1505 REPORT = 0: NEWT = 0: PARTF = 0 1510 PTREM = POINTEUR + (4 * (METCO - 1)) 1515 IF PAR(41 + PTREM) = 0 THEN NEWT = 1: GOTO 1525 1520 IF (PAR(41 + PTREM) AND 256) THEN PARTF = PAR(41 + PTREM) AND 255: TPAR = PARTF: GOSUB 1600 ELSE PARTF = 0 1521 IF (PAR(41 + PTREM) AND 512) THEN RERUN = 1 1522 RETURN 1525 IF PAR(20) = 0 THEN 1557 ELSE TPAR = 0 1527 RAN㐞G = 0: TPAR = TPAR + 1: IF TPAR = 5 THEN 1555 1530 GOSUB 1560: IF RANG THEN 1527 1535 GOSUB 1580: IF RANG THEN 1527 1540 GOSUB 1600: IF RANG THEN 1527 1541 IF PARTF THEN 1557 1555 PARTF = 0 1557 RETURN 1560 FOR ME = 1 TO 4 1565 TY = 41 + (METCO - 1) * 4 + ME 1570 IF (PAR(TY) AND 256) = 0 THEN 1575 1572 IF (PAR(TY) AND 255) = TPAR THEN RANG = 1: GOTO 1576 1575 NEXT ME 1576 RETURN 1580 IF PAR(52) = 0 THEN RETURN 'ds absorb 1581 GOSUB 4510 1582 FOR ET% = 1 TO NBCHAM%: GET #1, ET% 1583 FOR TY = 㐞0 TO 15: IF TY > PAR(52) - ((ET% - 1) * 16) THEN TY = 15: GOTO 1590 1584 REMIS = CVI(MID$(AB$, 1 + (TY * 6), 2)): IF (REMIS AND 16384) = 0 THEN 1590 1585 IF (ABS(REMIS) AND 15872) / 512 <> TPAR THEN 1590 1586 IF PAR(7 + METCO) > 20 THEN 1588 1587 IF (ABS(REMIS) AND 31) = PAR(7 + METCO) THEN RANG = 1: GOTO 1592 1588 IF (ABS(REMIS) AND 480) / 32 = PAR(7 + METCO) - 20 THEN RANG = 1: GOTO 1592 1590 NEXT TY: NEXT ET% 1592 CLOSE #1: RETURN 1600 GOSUB 2020: GET #1, 1 1605 US = (TPAR - 1) * 32 + 1 1610 FO㐞R ES = US TO US + 31: IF ES >= PAR(20) + 1 THEN 1645 1615 ENR = ASC(MID$(CHA$, ES, 1)): GET #2, ENR: NOMU = 1 1620 TME = MUL(NOMU): IF TME > 10 THEN PTY = 1 ELSE PTY = 0 1625 IF PTY THEN MDE = CVI(M2$): MFA = CVI(MR2$) ELSE MDE = CVI(M1$): MFA = CVI(MR1$) 1626 MP2 = CVI(MID$(P$, ((MUL(NOMU) - 1) * 6) + 1, 2)) 1630 MAS1 = 2 ^ ((TME - 1) - (PTY * 10)) 1632 IF ((MP2 AND (2 ^ 11 + 2 ^ 12)) = 2048 OR (MP2 AND (2 ^ 11 + 2 ^ 12)) = 4096) AND (MDE AND MAS1) <> 0 AND (MFA AND MAS1) = 0 THEN RERUN = 1 1635 IF 㐞(MFA AND MAS1) <> 0 THEN 1642 1640 IF (MDE AND MAS1) <> 0 THEN PARTF = TPAR: GOTO 1645 1642 NOMU = NOMU + 1: IF MUL(NOMU) THEN 1620 1643 NEXT ES: RANG = 1 1645 CLOSE #1: CLOSE #2 1650 RETURN 1652 IF (WTY AND 256) THEN METYP$ = METYP$ + "R" ELSE METYP$ = METYP$ + " " 1653 RETURN 1654 IF ME = PAR(8) THEN POIN = 1 ELSE POIN = 2 1655 IF PAR(7 + POIN) > 20 THEN METYP$ = "M" ELSE METYP$ = "S" 1656 RETURN 1659 GOSUB 1654 1661 IF TRL THEN WTY = PAR(41 + POINTEUR + (POIN - 1) * 4) ELSE WTY = PAR(41 + PAR㐞(37 + POIN) + (POIN - 1) * 4) 1662 GOSUB 1652 1663 WTY = WTY AND 255: RETURN 1665 IF ME < 21 THEN NOM$ = B$(ME) ELSE NOM$ = LEFT$(MTT$(ME), 6) 1670 IF WTY THEN AFF$ = METYP$ + "-" + NOM$ + " Tray : " + STR$(WTY) + SS$ ELSE AFF$ = SPACE$(3) + NOM$ + SPACE$(16) 1671 RETURN 1680 IF PAR(41 + POINTEUR + (METCO - 1) * 4) THEN RETURN 1682 IF REDIL > 15 THEN REDIL = 15 1685 IF REPORT THEN PAR(41 + POINTEUR + (METCO - 1) * 4) = PART + 256 + (REDIL * 1024): IF RERUN THEN PAR(41 + POINTEUR + (METCO - 1) * 4) =㐞 PART + 256 + 512 + (REDIL * 1024): REDIL = 0: RETURN ELSE REDIL = 0: RETURN 1687 INDM = PAR(37 + METCO): NUM = PAR(13 + METCO) 1688 IF INDM > 4 THEN INDM = INDM - 4 1696 IF INDM = POINTEUR THEN PAR(41 + POINTEUR + (METCO - 1) * 4) = NUM: RETURN 1697 IF (PAR(41 + INDM + (METCO - 1) * 4) AND 256) = 0 THEN NUM = NUM + 1 1698 INDM = INDM + 1: GOTO 1688 1700 TME = PAR(41 + POINTEUR + (METCO - 1) * 4) 1702 IF TME = 0 THEN 1715 1705 IF (TME AND 256) THEN NEWT = 0: PART = TME AND 255: REPORT = 1: RETURN 1㐞707 NEWT = 0: PART = 0: REPORT = 0: RETURN 1715 REPORTB = REPORT: GOSUB 1505: NEWT = 1 1717 IF REPORTB = 0 THEN PART = 0: RETURN 1719 IF PARTF THEN PART = PARTF: REPORT = 1: RETURN 1720 PART = 0: REPORT = 0: RETURN 1730 TME = PAR(41 + POINTEUR + (METCO - 1) * 4): NEWT = 0 1731 IF (TME AND 256) THEN PART = TME AND 255: REPORT = 1: RETURN 1732 PART = 0: REPORT = 0: RETURN 1950 COL = 0: GOSUB 1954: GOSUB 9190: RETURN 1954 IF MULTI = 0 THEN COL = 1: GOTO 1980 1955 COL = 0 1960 COL = COL + 1: IF (COL 㐞= 9) OR (MUL(COL) = 0) THEN COL = 0: GOTO 1980 1965 FOR ECH = 3 TO 48 1968 IF PL(ECH) = 0 THEN 1975 1970 IF PLM(ECH) AND 2 ^ (COL - 1) THEN 1980 1975 NEXT ECH: GOTO 1960 1980 RETURN 2000 GOSUB 5145 2005 FOR IND = 1 TO 50: GET #3, IND 2006 'IF STP THEN 2010 2007 IF REPORT THEN 2015 2010 GOSUB 4350 2015 PLB(IND) = CVI(F1$): PLMB(IND) = CVI(F4$): PLPB(IND) = CVI(F2$): PLPMB(IND) = CVI(F5$) 2017 IF MULTI = 0 AND PLB(IND) THEN PLMB(IND) = 1 2018 NEXT IND: CLOSE #3: PLM(49) = PLM(49) OR PLMB(49㐞 ): IF PLM(49) THEN LECTURE = 3 ELSE LECTURE = 2 2019 RETURN 2020 GOSUB 5150: GOSUB 5152: GET #1, 1: RETURN 2021 C = 40: C = C - (LEN(BI$) / 2): LOCATE L, C, 0: PRINT BI$; : RETURN 2023 RETURN 'QP$ = Q$ + CHR$(13) + CHR$(10): GOSUB 5782: GOSUB 5790: RETURN 2060 LSET MR1$ = MKI$(DMR1): LSET MR2$ = MKI$(DMR2): PUT #2, ENR: RETURN 2192 RETURN 'Q$ = "IND": GOSUB 2023: RETURN 2193 RETURN 'Q$ = "OUD": GOSUB 2023: RETURN 2460 IF PAR(9 + METCO) THEN 2475 ELSE PAR(9 + METCO) = (PAR(23) AND 15) - ((METCO - 1) 㐞* 4) 2462 IF PAR(37) = 1 THEN 2475 2465 FOR IN = 2 TO PAR(37) 2467 IF MULTI = 0 THEN 2471 2468 IF M% <> (PAR(19 + (3 * IN)) AND 31) THEN 2473 2469 PAR(9 + METCO) = (PAR(20 + (3 * IN)) AND 15) - ((METCO - 1) * 4): GOTO 2473 2471 IF M% = (PAR(19 + (3 * IN)) AND 992) / 32 THEN 2469 2473 NEXT IN 2475 RETURN 2560 IF MULTI THEN FOR IND = 1 TO 8: MUL(IND) = VAL(MID$(NMLI$(MULTI), (IND * 3 - 1), 2)): NEXT IND: MUL(9) = 0 ELSE MUL(1) = M%: MUL(2) = 0 2565 RETURN 2570 IF PREMI = 0 THEN 2580 2571 FLSTD㐞 = 0: IF PLM(49) = 0 THEN 2580 2572 FOR EX = 17 TO 48: IF PL(EX) THEN 2580 2574 NEXT EX: FLSTD = 1: IF RSTART <> 0 THEN NOSAMP = 1 2580 PREMI = 0: RETURN 2600 GOSUB 5145: PL(50) = 0: AW = 50: BW = 1 2605 FOR IN = BW TO AW: IF IN > 48 THEN 2680 2610 IF IN > 16 THEN 2625 2615 IF PL(IN) THEN PL(50) = PL(50) + 256 2625 IF MULTI = 0 THEN 2650 2630 IF PLPM(IN) = 0 THEN PLP(IN) = 0 2640 IF (PLM(IN) OR PLP(IN)) = 0 THEN PL(IN) = 0 2645 IF IN < 17 THEN 2655 2650 IF PL(IN) THEN PL(50) = PL(50) + 1 2655 L㐞SET F2$ = MKI$(PLP(IN)): LSET F5$ = MKI$(PLPM(IN)) 2670 IF K1(6) = 3 OR K1(6) = 12 OR ((K1(6) = 1 OR K1(6) = 2) AND K1(33) <> 0) AND IN = 1 THEN PL(1) = 254 ELSE IF K1(6) = 4 THEN PL(1) = 254: PL(2) = 254 2680 LSET F1$ = MKI$(PL(IN)): IF MULTI <> 0 OR (PLM(49) <> 0 AND IN = 49) THEN LSET F4$ = MKI$(PLM(IN)) 2685 PUT 3, IN: NEXT IN: GOSUB 1200: CLOSE 3: RETURN 2720 PLM(49) = 0: GOSUB 5130 2725 FOR T = 1 TO 8: IF MUL(T) = 0 THEN T = 8: GOTO 2735 ELSE GET #1, (MUL(T) - 1) * 100 + 1: T1 = CVS(A1$): GET #1,㐞 (MUL(T) - 1) * 100 + 6: T2 = CVS(A$) 2730 IF T1 <> 0 AND T2 < 3 THEN PLM(49) = PLM(49) OR 2 ^ (T - 1) 2735 NEXT T: CLOSE #1: RETURN 2960 POINTEUR = PAR(23) AND 15 2962 IF POINTEUR > 4 THEN POINTEUR = POINTEUR - 4 2964 RETURN 2970 IF PAR(37 + METCO) = 0 THEN 2980 2972 UN = PAR(36): PROCH = PAR(37 + METCO): GOSUB 2990 2973 IF TET = 0 THEN 2980 2974 PROCH = PROCH + 1: IF PROCH = 5 THEN PROCH = 1 2975 UN = PAR(35): GOSUB 2990 2976 IF TET = 0 THEN PAR(37 + METCO) = 0: GOTO 2980 2977 UN = PAR(36): GO㐞SUB 2990 2978 IF TET = 0 THEN PAR(37 + METCO) = PAR(37 + METCO) + 1 ELSE PAR(37 + METCO) = 0 2980 RETURN 2990 IF (UN AND 2 ^ (PROCH - 1 + (8 * (METCO - 1)))) = 0 THEN TET = 0 ELSE TET = 1 2992 RETURN 4050 IF CAL = 0 THEN RETURN ELSE GOSUB 4200: IND = 1 4055 FOR T = 1 TO KN: IF TCAL(T) = MUL(IND) THEN PLM(49) = PLM(49) OR 2 ^ (IND - 1): M% = TCAL(T): GOSUB 5160: GOTO 4070 ELSE NEXT T 4060 IND = IND + 1: IF MUL(IND) = 0 THEN NOCALI = 0: CALB = 0: GOSUB 5145 ELSE GOTO 4055 4062 AW = 16: BW = 1: GOSUB 2㐞605 4064 IF PRETR THEN AW = 32: BW = 17: GOSUB 5145: GOSUB 2605 4068 GOSUB 5145: LSET F4$ = MKI$(PLM(49)): PUT #3, 49: LSET F1$ = MKI$(PL(50)): PUT #3, 50: CLOSE #3: RETURN 4070 FOR K = 64 TO 77: IF K1(K) THEN GOSUB 5800 4075 NEXT K: GOTO 4060 4110 KN = 0: FOR T% = 1 TO 10: TCAL(T%) = 0: NEXT T%: RETURN 4200 GOSUB 1455: GOSUB 5145 4205 IF PRETR THEN T = 32 ELSE T = 16 4210 FOR IND = 1 TO T: GET #3, IND 4215 GOSUB 4350 4220 NEXT IND: GET #3, 49: PLM(49) = CVI(F4$): GET #3, 50: PL(50) = CVI(F1$): CL㐞OSE #3: RETURN 4350 PL(IND) = CVI(F1$): PLM(IND) = CVI(F4$): PLP(IND) = CVI(F2$): PLPM(IND) = CVI(F5$) 4352 IF MULTI = 0 AND PL(IND) THEN PLM(IND) = 1 4354 RETURN 4365 NOPLACE = 0: IF PLM(49) THEN RETURN ELSE IF PRETR THEN GOSUB 5130: GOSUB 4405: CLOSE #1: GOTO 4390 4370 IF MULTI = 0 AND PRED(1) = 0 THEN RETURN ELSE FOR T = 1 TO 8: IF PRED(T) = 0 THEN NEXT T: RETURN 4375 MBAK = M% 4380 GOSUB 5130: FOR T = 1 TO 8: M% = MUL(T): IF MUL(T) = 0 THEN T = 8 ELSE GOSUB 4405 4385 NEXT T: CLOSE #1: M% = MBAK 㐞 4390 FOR T = 1 TO 15: IF ((ABS(PLACAL) AND 2 ^ (T - 1)) AND PL(T)) OR (PLACAL < 0 AND PL(16)) THEN NOPLACE = 1: L = 25: BI$ = "Not enough positions": GOSUB 2021: FOR TT = 1 TO 30000: NEXT TT: GOSUB 6798: T = 16: IBAK = I ELSE NOPLACE = 0 4400 NEXT T: PLACAL = 0: MBAK = 0: RETURN 4405 FOR TT = 64 TO 77: GET #1, (M% - 1) * 100 + TT: A = CVS(A1$): IF A <> 0 THEN IF A = 16 THEN IF PLACAL < 0 THEN 4410 ELSE PLACAL = -PLACAL ELSE PLACAL = ABS(PLACAL) OR 2 ^ (A - 1) 4410 NEXT TT: RETURN 4500 IF MULTI THEN T =㐞  MULTI ELSE T = M% 4501 IF VER% = 16 OR VER% = 32 OR VER% = 64 THEN 4504 4502 PAR(60) = (PAR(41 + PTREM) AND 1023) + (T * 1024) 4504 IF F8MEMO THEN PAR(57) = T: RETURN ELSE RETURN 4510 NBCHAM% = INT(PAR(52) / 16.0001) + 1: GOSUB 5151: RETURN 5000 DATA /Q,/W,/E,/R,/T,/Y,/U,/I,/O,/P,/A,/S,/D,/F,/G,/H,/J,/K,/L,/;,/1,/2,/3,/4,/5,/6,/7,/8 5001 DATA 81,87,69,82,84,89,85,73,79,80,65,83,68,70,71,72,74,75,76,59,49,50,51,52,53,54,55,56 5002 LOCATE 16, 20: PRINT "CHECK CORRECT REAGENT TRAY IS USED." 5003 LOCAT㐞E 18, 20: PRINT "CHECK REAGENTS ARE CORRECTLY POSITIONED.": RETURN 5004 L = 24: BI$ = " NEXT ": RETURN 5005 L = 24: BI$ = " PREVIOUS ": RETURN 5006 L = 24: BI$ = " MAIN MENU ": RETURN 5007 LOCATE 24, 26, 0: PRINT SPACE$(30): RETURN 5008 L = 24: BI$ = " RESTART ": RETURN 5015 DATA Verif.,Manual,Report,,New Stds,,EXIT,,,Standard Loading,, 5020 DATA Verif.,Manual,,,New Stds,,EXIT,,,Standard Loading,, 5021 DATA ,,,,,,,,,Standard㐞 Loading,, 5025 DATA Verif.,,Report,,New Stds,,EXIT,,,Standard Loading,, 5060 DATA BLANK,STD 5065 DATA M.Menu,Next,Previous,,Standards,,Exit,,,Tray Loading,,," Sample X"," QC 1"," QC 2"," Sample X Dil." 5066 DATA M.Menu,Next,Previous,,,,Exit,,,Tray Loading,,," Sample X"," QC 1"," QC 2"," Sample X Dil." 5070 DATA ,,,,,,,,,"Set Up And Start : Method List",,, 5080 DATA ,Manual,,,,,,,,,, 5082 DATA ,,Report,,,,,,,,, 5085 DATA ,Manual,Report,,,,,,,,, 5091 DATA ,,,,,,,,,Tray Loading,,," Sample X"," QC 1",㐞" QC 2"," Sample X Dil." 5092 DATA ,,,,,,,,,WARNING,, 5095 DATA tray11,tray12,tray13,tray14 5100 DATA tray21,tray22,tray23,tray24 5105 DATA Reagent Tray," Reagent 1"," Reagent 2"," Reagent 3" 5106 DATA ,,,Change,,,,,,Cuvettes Change,, 5107 DATA ,,,,,,EXIT,,,Tray Loading,, 5108 DATA ,,,Change,,,Exit,,,Cuvettes Change,, 5112 DATA Protocol,,,,,,,,,WARNING,, 5126 DATA ,,,,,,EXIT,,,Calibration Verification,, 5128 DATA NEXT,,,,,,EXIT,,,Calibration Verification,, 5130 OPEN "r", 1, "method", 4: FIELD㐞 1, 4 AS A1$: RETURN 5132 OPEN "r", #1, "nameth", 105: FIELD #1, 105 AS A1$: RETURN 5135 OPEN "r", #1, "nameth", 105: FIELD #1, 6 AS A1$, 6 AS AA1$, 32 AS A2$, 32 AS A3$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS E1$, 5 AS E2$: RETURN 5140 OPEN "R", #1, "PARGEN", 2: FIELD #1, 2 AS P1$: RETURN 5145 OPEN "r", #3, FIL$, 14: FIELD #3, 2 AS F1$, 2 AS F2$, 2 AS F3$, 2 AS F4$, 2 AS F5$, 2 AS F6$, 2 AS F7$: RETURN 5147 OPEN "r", #3, FIL$, 14: FIELD #3, 14 AS FL1$: RETURN 5150 OPEN "r", #2, "paille", 206: F㐞IELD #2, 12 AS NM$, 2 AS M1$, 2 AS M2$, 2 AS MR1$, 2 AS MR2$, 120 AS P$, 6 AS M2P$, 18 AS P2P$, 42 AS RP$: RETURN 5151 OPEN "r", #1, "absorb", 106: FIELD #1, 106 AS AB$: RETURN 5152 OPEN "r", #1, "descpai", 128: FIELD #1, 128 AS CHA$: RETURN 5153 L = 25: BI$ = "MANUAL DILUTION FOR CHECK": GOSUB 2021: RETURN 5154 L = 24: BI$ = "PLACE THE CORRECT INNER TRAY": GOSUB 2021: IF MUSIC = 0 THEN SOUND 2000, 40: MUSIC = 1: RETURN ELSE RETURN 5155 L = 24: BI$ = "PLACE THE CORRECT TRAY": GOSUB 2021: RETURN 5156 L㐞 = 24: BI$ = "VERIFY THE REAGENT TRAY": GOSUB 2021: RETURN 5157 RETURN 'CALL IO(DEV%, cim%, DAT%, RET%): RETURN 5158 IF PAR(37) > 0 AND NOSAMP = 0 THEN 7490 ELSE GOTO 8500 5160 GOSUB 5130: FOR IN = 1 TO 100: GET #1, (M% - 1) * 100 + IN 5162 K1(IN) = CVS(A1$): NEXT IN: CLOSE #1: RETURN 5164 GOSUB 5130: IN = 33: GET #1, (M% - 1) * 100 + IN: K1(33) = CVS(A1$): IN = 6: GET #1, (M% - 1) * 100 + IN: CLOSE #1: RETURN 5176 DEV% = &H35: cim% = 1: DAT% = 0: RET% = 0: GOSUB 5157 5177 IF RET% < 2000 THEN IMPOUT%㐞 = 1 ELSE IMPOUT% = 0 5178 DEV% = 52: RETURN 5179 WHILE IMPOUT% = 1 5180 FOR I = 1 TO 30000: NEXT I: GOSUB 5176 5181 WEND: RETURN 5190 FOR T = 1 TO 16: LOCATE 3 + T, 1: PRINT "C"; T: NEXT T: RETURN 5195 FOR T = 1 TO 8: C = 1: LOCATE L, C: PRINT "C"; T; : C = 41: LOCATE L, T: PRINT "C"; T + 8: L = L + 1: NEXT T: RETURN 5197 FOR T = 1 TO 16: LOCATE 3 + T, 1: PRINT T: NEXT T: L = 4: C = 20: APRET = 1: GOSUB 5260: IND = 1: GOSUB 5400: RETURN 5198 RETURN 'Q$ = "DST": GOSUB 2023: RETURN 5199 L = 25: BI$ 㐞= " START REQUEST ": GOSUB 2021: RETURN 5200 RESTORE 5105: L = 4: C = 1 5205 FOR NLE = 1 TO 4: READ NLE$: LOCATE L, C 5206 IF NLE = 1 THEN COLOR 5, 0 5212 PRINT NLE$ 5213 COLOR 1, 2: L = L + 1 5214 NEXT NLE: GOSUB 5245: RETURN 5220 GOSUB 5135: GET #1, M% 5225 UN1$ = U1$: UN2$ = U2$: CLOSE #1: RETURN 5230 FOR HJ = 1 TO 50: PL(HJ) = 0: PLB(HJ) = 0: PLP(HJ) = 0: PLPB(HJ) = 0 5233 PLM(HJ) = 0: PLMB(HJ) = 0: PLPM(HJ) = 0: PLPMB(HJ) = 0 5235 NEXT HJ: RETURN 5240 IF VER% = 10 THEN VER% = 㐞 0 5241 RETURN 5245 L = 3: C = 6 + (IND * 8) 5250 FOR T = 1 TO 4: LOCATE L + T, C: PRINT ":": NEXT T: RETURN 5255 L = 4: C = 5 + ((IND - 1) * 9) 5260 FOR T = 0 TO 15: LOCATE L + T, C: PRINT ":": NEXT T: RETURN 5262 IND = 1 5263 M% = MUL(IND): GOSUB 5160 5264 IF (K1(6) <> 4) AND (K1(33) = 0) THEN TOT = TOT + 1 5265 IF MULTI THEN 5267 5266 IF (K1(6) = 5 OR K1(6) = 6 OR K1(6) = 10) AND (K1(58) <> 0) THEN PRETR = 1 5267 IF K1(58) THEN PRED(IND) = 1 5269 IND = IND + 1: IF MUL(IND) THEN 5263 ELSE RETUR㐞N 5270 GOSUB 5140: FOR T = 1 TO 60 5280 GET #1, T: PAR(T) = CVI(P1$): NEXT T: CLOSE #1: RETURN 5395 LOCATE 3, 6 + ((IND - 1) * 9): PRINT B$(M%): RETURN 5400 LOCATE 3, 21 + ((IND - 1) * 7): PRINT LEFT$(B$(M%), 6): RETURN 5405 C = 7 + (8 * IND): IF MULTI THEN LOCATE 3, C: PRINT LEFT$(B$(M%), 6) 5410 IF K1(26) THEN LOCATE 4, C: COLOR 5, 0: PRINT K1(26): COLOR 1, 2 5415 IF K1(23) THEN LOCATE 5, C: PRINT CHR$(&H40 + (K1(59) AND 15)) + "=" + STR$(K1(23)) 5420 IF K1(24) THEN LOCATE 6, C: PRINT CHR$(&H40 + 㐞((K1(60) AND 240) / 16)) + "=" + STR$(K1(24)) 5425 IF K1(25) THEN LOCATE 7, C: PRINT CHR$(&H40 + (K1(60) AND 15)) + "=" + STR$(K1(25)) 5427 IF PRETR AND MULTI = 0 THEN LOCATE 7, 25, 0: PRINT "Pre-treatment :"; CHR$(&H40 + (K1(59) AND 240) / 16) + "=" + STR$(K1(4)) 5430 RETURN 5435 LOCATE 10, C: PRINT UN1$ 5466 IF K1(26) = 0 AND K1(23) = 0 AND K1(24) = 0 AND K1(25) = 0 THEN 5470 ELSE IF K1(26) = 0 THEN 5474 5467 IF K1(23) THEN IF (K1(59) AND 15) = 0 THEN 5474 5468 IF K1(24) THEN IF (K1(60) AND 240) = 㐞0 THEN 5474 5469 IF K1(25) THEN IF (K1(60) AND 15) = 0 THEN 5474 5470 RETURN 5474 VER% = 6: GOSUB 6500: RETURN 5475 BTL = 0: IF MULTI THEN M% = MULTI 5476 NOUV = 0: PLM(49) = 0: IF M% = PAR(8) THEN METCO = 1: GOTO 5500 5477 IF M% = PAR(9) THEN METCO = 2: GOTO 5500 5479 IF PAR(8) = 0 AND PAR(9) = 0 THEN PAR(16) = 1: METCO = 1: GOTO 5490 5480 IF PAR(8) = 0 THEN METCO = 1: GOTO 5490 5482 IF PAR(9) = 0 THEN METCO = 2: GOTO 5490 ELSE 5509 5490 NOUV = 1: PAR(7 + METCO) = M%: PAR(9 + METCO) = 1: PAR(37 +㐞 METCO) = 1 5492 GOSUB 5132: GET #1, 34: PAR(13 + METCO) = CVI(MID$(A1$, (M% - 1) * 2 + 1, 2)): CLOSE #1 5494 IF PAR(13 + METCO) = 0 THEN PAR(13 + METCO) = 1 5500 IF (VER% >= 16) AND VER% <> 512 AND VER% <> 1024 THEN GOSUB 9000: RETURN ELSE IF PAR(37 + METCO) THEN 5506 5501 VIE = 0: POI = PAR(11 + METCO) + 1: IF POI = 5 THEN POI = 1 5502 IF (PAR(36) AND 2 ^ (POI - 1 + (8 * (METCO - 1)))) = 0 THEN 5505 5503 VIE = VIE + 1: POI = POI + 1: IF POI = 5 THEN POI = 1 5504 IF VIE <> 4 THEN 5502 ELSE BTL = 1: 㐞GOTO 5509 5505 PAR(37 + METCO) = POI: PAR(9 + METCO) = POI 5506 IF (PAR(16) = 0) OR (STAT = 1) THEN PAR(16) = METCO 5507 POINTEUR = PAR(37 + METCO): RETURN 5509 M% = 0: RETURN 5530 PTREM = POINTEUR + (4 * (METCO - 1)) 5535 RESTORE 5095: FOR T = 1 TO PTREM: READ FIL$: NEXT T 5536 IF NOUV THEN RETURN 5595 GOSUB 2000 5625 GOSUB 2020: FOR I = 17 TO 48: NL = PL(I) AND 255 5630 IF (NL = 0) OR (NL > 250) THEN 5655 5640 ENR = ASC(MID$(CHA$, PL(I) AND 255, 1)): GET #2, ENR: PAT$(I - 16) = NM$ 5655 NEXT I㐞: CLOSE #2: CLOSE #1: RETURN 5665 GOSUB 5140 5685 FOR T = 1 TO 60: LSET P1$ = MKI$(PAR(T)): PUT #1, T: NEXT T 5690 CLOSE #1: RETURN 5700 GOSUB 5132: GET #1, 34: FIC$ = A1$: MID$(FIC$, (PAR(7 + PAR(16)) - 1) * 2 + 1) = MKI$(PAR(13 + PAR(16))) 5705 LSET A1$ = FIC$: PUT #1, 34: CLOSE #1: RETURN 5715 POINTEUR = POINTEUR + 1: IF POINTEUR = 5 THEN POINTEUR = 1 5717 IF (PAR(36) AND 2 ^ (POINTEUR - 1 + (8 * (METCO - 1)))) = 0 THEN 5722 5718 POINTEUR = POINTEUR - 1: IF POINTEUR = 0 THEN POINTEUR = 4: GOTO 57㐞80 5722 IF PAR(37 + METCO) = PAR(9 + METCO) THEN PAR(9 + METCO) = POINTEUR: GOTO 5780 5724 IF PAR(37 + METCO) > PAR(9 + METCO) THEN 5730 5730 IF POINTEUR > PAR(9 + METCO) OR POINTEUR < PAR(37 + METCO) THEN PAR(9 + METCO) = POINTEUR 5780 RETURN 5782 U = 1: DEV% = 52 5783 cim% = &H10: GOSUB 5157: IF RET% = 0 THEN 5783 ELSE DAT% = ASC(MID$(QP$, U, 1)): cim% = 1 5784 GOSUB 5157: U = U + 1 5785 IF DAT% <> 10 THEN 5783 ELSE RETURN 5790 R$ = "": cim% = &HC: DAT% = 0: GOSUB 5157: cim% = 2: DAT% = 0 5791 G㐞OSUB 5157: IF RET% = -1 THEN 5791 5792 R$ = R$ + CHR$(RET%): IF RET% <> 10 THEN 5791 5793 cim% = &HC: DAT% = 1: GOSUB 5157: RETURN 5795 UA = 1: AP$ = " BLANK": L = 4: LOCATE L, 6: PRINT AP$: K$ = RIGHT$(STR$(1), LEN(STR$(1)) - 1): LOCATE L, 21: PRINT "D.C"; K$: GOTO 5887 5800 IF PL(K1(K)) = 254 THEN 5810 ELSE UA = K1(K) 5802 IF MULTI THEN 5805 5803 PL(UA) = 0: PLP(PLP(UA)) = 0: PLP(UA) = 0: GOTO 5810 5805 UB = PLP(UA): PLM(UB) = PLM(UB) OR PLM(UA): PLPM(UB) = PLPM(UB) - PLPM(UA) 5806 IF PLPM(UB) = 0㐞  THEN PLP(UB) = 0 5807 PL(UA) = 0: PLM(UA) = 0: PLP(UA) = 0: PLPM(UA) = 0 5810 IF MULTI THEN L = 3 + K1(K): C = 6 + ((IND - 1) * 9): GOTO 5820 5811 IF PRETR THEN GOSUB 5870: GOTO 5845 5812 L = 3 + K1(K): C = 6 5815 IF K = 76 OR K = 77 THEN 5820 5820 LOCATE L, C, 0 5825 IF K = 76 THEN IF CALB THEN 5860 ELSE GOSUB 5850: GOTO 5845 5828 IF K = 77 THEN IF CALB THEN 5860 ELSE GOSUB 5855: GOTO 5845 5830 IF CALB = 0 THEN IF (K1(K - 57) = 0) AND (K1(K) = 1) THEN PRINT "BLANK" ELSE PRINT USING "###.###"; K1(㐞K - 57) 5835 PL(K1(K)) = 254: IF MULTI THEN PLM(K1(K)) = PLM(K1(K)) OR 2 ^ (IND - 1) 5845 RETURN 5850 PRINT "CALC. 1": GOTO 5860 5855 PRINT "CALC. 2" 5860 PL(K1(K)) = 254: IF MULTI THEN PLM(K1(K)) = PLM(K1(K)) OR 2 ^ (IND - 1) 5865 RETURN 5870 UA = K1(K): IF K = 76 THEN IF CALB THEN 5887 ELSE AP$ = " CALC. 1": GOTO 5880 5871 IF K = 76 THEN IF CALB THEN 5887 ELSE AP$ = " CALC. 1": GOTO 5880 5875 IF K = 77 THEN IF CALB THEN 5887 ELSE AP$ = " CALC. 2": GOTO 5880 5876 IF CALB = 0 THEN IF (K1(K - 57) =㐞 0) AND (K1(K) = 1) THEN AP$ = " BLANK" ELSE AP$ = " Std" + STR$(K1(K - 57)) 5880 L = 3 + K1(K): LOCATE L, 6: PRINT AP$ 5885 IF CALB = 0 THEN K$ = RIGHT$(STR$(K1(K)), LEN(STR$(K1(K))) - 1): LOCATE L, 21: PRINT "D.C"; K$ 5887 PL(UA) = 255: PLP(UA) = UA + 16: PL(UA + 16) = 254: PLP(UA + 16) = 255: RETURN 5890 FOR IN = 1 TO 8: PRED(IN) = 0: NEXT IN: RETURN 5960 POINTEUR = POINTEUR - 1: IF POINTEUR = 0 THEN POINTEUR = 4 5965 IF (PAR(36) AND 2 ^ (POINTEUR - 1 + (8 * (METCO - 1)))) THEN 5970 5966 IF (PAR(3㐞5) AND 2 ^ (POINTEUR - 1 + (8 * (METCO - 1)))) THEN RETURN 5970 POINTEUR = POINTEUR + 1: IF POINTEUR = 5 THEN POINTEUR = 1 5975 RETURN 5976 IF AFST THEN IF COMPT = 1000 THEN COMPT = 0: GOSUB 9175: LOCATE L, C, 1: PRINT " "; : GOTO 5978 ELSE COMPT = COMPT + 1: GOTO 5978 5977 IF COMP = 500 THEN COMP = 0: GOSUB 9160: LOCATE L, C, 1: PRINT " "; ELSE COMP = COMP + 1 5978 RETURN 5980 IF PAR(36) >= 256 THEN POIN = 2 ELSE POIN = 1 5982 METP% = PAR(7 + POIN): DEMET = PAR(40): MULTI = METP%: METI = VAL(MID$(N㐞MLI$(METP%), (DEMET * 3 - 1), 2)): IF METP% THEN M% = METP% ELSE M% = METI 5984 PAR(22) = METI + (32 * METP%) + (1024 * PAR(40)) 5986 IF POIN = 2 THEN PAR(23) = PAR(36) / 256 ELSE PAR(23) = PAR(36) 5988 ID = 0 5990 IF PAR(23) AND (2 ^ ID) THEN PAR(23) = (POIN - 1) * 4 + ID + 1 ELSE ID = ID + 1: GOTO 5990 5991 TANC = PAR(23): PAR(23) = PAR(23) + (16 * (PAR(41 + TANC) AND 511)) 5992 RETURN 6093 IF PAR(16) = METCO THEN UR = METCO: GOTO 6096 ELSE RETURN 6095 IF PAR(16) THEN UR = PAR(16) ELSE UR = METCO 㐞 6096 GOSUB 8990: RETURN 6100 IF PAR(37) THEN RETURN 6115 IF (K1(20) = 1) OR (K1(20) = 2) THEN 6120 ELSE RETURN 6120 'GOSUB 2192: QP$ = "HEAT:": ON K1(20) GOTO 6130, 6135 6130 'QP$ = QP$ + "1": GOTO 6140 6135 'QP$ = QP$ + "2" 6140 'Q$ = QP$: GOSUB 2023 6145 RETURN 'GOSUB 2193: RETURN 6205 'partie interrogation 6210 IF I <> 0 THEN 6222 6215 IF A$ = CHR$(130) THEN 6232 ELSE LOCATE L, C + I + 1 6220 PRINT SPACE$(MAX) 6221 LOCATE L, C + I 6222 RETURN 6225 NOMU = 1 6226 ME = MUL(NOMU): IF ME = 0 T㐞HEN LSET MR1$ = MKI$(ME1): LSET MR2$ = MKI$(ME2): GOTO 6239 6227 IF (APLM AND 2 ^ (NOMU - 1)) = 0 THEN 6230 6228 IF ME < 11 THEN ME1 = ME1 OR 2 ^ (ME - 1) 6229 IF ME > 10 THEN ME2 = ME2 OR 2 ^ (ME - 11) 6230 NOMU = NOMU + 1: GOTO 6226 6231 FOR IN = 17 TO 48: IF (PL(IN) > 0) AND (PL(IN) < 251) THEN APLM = PLM(IN): NPAT = PL(IN): GOSUB 6235 6232 IF (PLP(IN) > 0) AND (PLP(IN) < 251) THEN APLM = PLPM(IN): NPAT = PLP(IN): GOSUB 6235 6234 NEXT IN: RETURN 6235 ENR = ASC(MID$(CHA$, NPAT, 1)): GET #2, ENR: M㐞E1 = CVI(MR1$): ME2 = CVI(MR2$): IF MULTI THEN 6225 6237 IF M% > 10 THEN LSET MR2$ = MKI$(ME2 OR 2 ^ (M% - 11)) 6238 IF M% < 11 THEN LSET MR1$ = MKI$(ME1 OR 2 ^ (M% - 1)) 6239 PUT #2, ENR: RETURN 6240 PAVA = 0: TLU = 0 6241 IF POINTEUR <> PAR(9 + METCO) THEN 6248 6242 FOR IN = 2 TO 48: IF PL(IN) = 0 THEN NEXT IN ELSE IF PRETR <> 0 THEN 6248 ELSE FOR NI = 2 TO 49: IF PLM(NI) <> 0 THEN 6248 ELSE NEXT NI 6243 PAVA = 1: IF K1(6) = 3 THEN PL(1) = 254 6244 GOTO 6255 6248 GOSUB 2600 6255 IF REPORT = 0 TH㐞EN 6314 6271 PAR(19) = 1: GOSUB 2020 6272 FOR VPA = 17 TO 48: NEL = PLB(VPA) 6274 ABSENT = 0: IF NEL = 0 OR NEL > 250 THEN 6277 6275 NPAT = PLB(VPA): AVLM = PLMB(VPA): IF NEL <> PL(VPA) THEN ABSENT = 1: GOSUB 6285: GOTO 6277 ELSE APLM = PLM(VPA) 6276 IF PLMB(VPA) <> APLM THEN GOSUB 6285 6277 ABSENT = 0: IF (PLPB(VPA) = 0) OR (PLPB(VPA) > 250) THEN 6280 6278 AVLM = PLPMB(VPA): NPAT = PLPB(VPA): IF PLPB(VPA) <> PLP(VPA) THEN ABSENT = 1: GOSUB 6285: GOTO 6280 ELSE APLM = PLPM(VPA) 6279 IF PLPMB(VPA) <>㐞  APLM THEN GOSUB 6285 6280 ABSENT = 0 6283 NEXT VPA: IF PAVA = 0 THEN GOSUB 6231 6284 CLOSE #1: CLOSE #2: GOTO 6314 6285 ENR = ASC(MID$(CHA$, NPAT, 1)) 6286 GET #2, ENR: NOM$ = NM$: DE1$ = M1$: DE2$ = M2$: PO$ = P$: M2PI$ = M2P$: P2PI$ = P2P$: RPI$ = RP$ 6287 ME1 = CVI(MR1$): ME2 = CVI(MR2$) 6288 IF MULTI THEN 6291 6289 IF M% > 10 THEN LSET MR1$ = MKI$(ME1): LSET MR2$ = MKI$(ME2 XOR 2 ^ (M% - 11)): GOTO 6299 6290 LSET MR1$ = MKI$(ME1 XOR 2 ^ (M% - 1)): LSET MR2$ = MKI$(ME2): GOTO 6299 6291 IF ABSE㐞NT THEN APLM = 0 6292 NOMU = 1 6293 ME = MUL(NOMU): IF ME = 0 THEN LSET MR1$ = MKI$(ME1): LSET MR2$ = MKI$(ME2): GOTO 6299 6294 IF (AVLM AND 2 ^ (NOMU - 1)) = 0 THEN 6298 6295 IF (APLM AND 2 ^ (NOMU - 1)) THEN 6298 6296 IF ME > 10 THEN ME2 = ME2 XOR 2 ^ (ME - 11) ELSE ME1 = ME1 XOR 2 ^ (ME - 1) 6298 NOMU = NOMU + 1: GOTO 6293 6299 PUT #2, ENR: RETURN 6314 PAR(35) = PAR(35) OR 2 ^ ((POINTEUR - 1) + (8 * (METCO - 1))): RETURN 6430 LON = 0: NBR = 0 6465 IF MULTI THEN ME = MULTI ELSE ME = M% 6466 IF 㐞PLM(49) THEN SS$ = "Std" ELSE SS$ = " " 6467 IF VER% < 16 OR VER% = 512 OR VER% = 1024 THEN GOSUB 1659 ELSE WTY = (PAR(23) AND 2032) / 16: GOSUB 1652: GOSUB 1654 6480 GOSUB 1665: IF NOUV THEN AFF$ = NOM$ + SPACE$(16) ELSE GOSUB 1670 6482 GOTO 240 6500 IF MULTI THEN VER% = VER% OR (256 * IND) 6501 RETURN 6510 IF (K1(6) = 1 OR K1(6) = 5 OR K1(6) = 6 OR K1(6) = 10) AND (K1(30) = 0 OR (K1(30) < K1(28)) OR (K1(29) <> 0 AND K1(30) < K1(29))) THEN BLACOR = 1 6511 RETURN 6516 NOUV = 0: IF MULTI THEN MEL =㐞 MULTI ELSE MEL = M% 6517 IF (VER% >= 16) THEN PASSAG = 1: GOTO 6522 6518 IF MEL = PAR(7 + PAR(16)) AND POINTEUR = PAR(37 + PAR(16)) AND PAR(57) = 0 THEN PASSAG = 1 ELSE 6522 6519 IF PAR(37) = 4 THEN 6523 6520 IF PAR(40) AND VER% < 16 THEN 6523 6522 RETURN 6523 PASSAG = 0: RETURN 6524 SCREEN 2: GOSUB 9240 6525 DEMET = 0: NOCALI = 0: FRECU = 0: TXT = 0: GOSUB 4110: CAL = 0: FI = 0: NBREA = 0: SEC = 0: SEC1 = 0: SEC3 = 0: LECTURE = 0: TOT = 0: WL = 0: NOUV = 0: PREDIL = 0: DILMA = 0 6526 IF VER% = 51㐞2 OR VER% = 1024 THEN LOCATE 12, 32, 0: PRINT "AUTOMATIC RERUN" 6528 GOSUB 5230: MULTI = 0: GOSUB 5270: GOSUB 34: MAX = 2 6530 GOSUB 600: GOSUB 1090: GOSUB 593 6535 IF VER% THEN 6625 6537 IF PAR(37) THEN GOSUB 1250 ELSE 6565 6540 IF VIR THEN 6625 6565 RESTORE 5070: GOSUB 120: IF STAT = 0 THEN COLOR 5, 0: LOCATE 20, 72: PRINT "EXIT": LOCATE 21, 73: PRINT "F7": COLOR 1, 2 6566 GOSUB 230: GOSUB 1135 6575 GOSUB 999 6580 GOTO 900 6595 M% = VAL(R$): GOSUB 6798 6596 IF STAT = 0 THEN LOCATE 25, 29, 0: PR㐞INT SPACE$(25); : LOCATE 19, 1, 0: GOTO 6625 6597 IF M% = INTMETH THEN L = 25: BI$ = " INTERRUPTED METHOD ": GOSUB 2021: GOSUB 929: GOSUB 930: GOTO 900 6625 KN = 0: EFF = 0: RIV = 0: NREA = 0: BNRS = 0: BCIS = 0: NBREA = 0: NBRST = 0: NR = 0: NRS = 0: CONRF = 0: CIS = 0: APRET = 0: PRETR = 0: RED = 0: SEC = 0: SEC1 = 0: SEC3 = 0: IF VER% = 0 THEN 6635 6626 IF VER% < 32 OR VER% = 512 OR VER% = 1024 THEN 6630 6627 DEMET = (PAR(22) AND 15360) / 1024: METI = PAR(22) AND 31: METP% = (PAR(22) AND 992) / 32:㐞 IF METP% THEN M% = METP% ELSE M% = METI 6628 IF M% = 0 THEN GOSUB 5980 6629 GOTO 6635 6630 IF VER% <> 16 THEN 6633 ELSE DEMET = PAR(40): GOSUB 5980: GOTO 6635 6631 IF METP% THEN 6635 6633 IF VER% THEN M% = METH% 6635 GOSUB 5475: IF M% = 0 THEN GOSUB 1300: GOSUB 970: IF BOU < 11 THEN HH = 1: DD = BOU - 1: GOSUB 929: GOSUB 930: GOTO 6580 ELSE IF BOU < 21 THEN HH = 2: DD = BOU - 11: GOSUB 929: GOSUB 930: GOTO 6580 ELSE HH = 0: DD = BOU - 21: GOSUB 929: GOSUB _ 930: GOTO 6580 6636 IF M% > 20 THEN MULT㐞I = M% 6645 IF VER% <= 8 THEN VER% = 0 6655 LECTURE = 0 6660 GOSUB 2560 6661 TOT = 0: GOSUB 1505 6662 IF VER% = 9 THEN GOSUB 5262: VER% = 0: GOTO 6985 ELSE IF VER% >= 512 OR (VER% = 10 AND RSTART = 0) THEN GOSUB 11210: IF VER% = 10 THEN GOSUB 4110 6663 IF (VER% >= 16 AND VER% < 512) OR VIR = 2 THEN 6664 ELSE IF (VER% = 10 OR VER% >= 512) THEN IF (VER% < 512 AND VER% > 16) THEN 6664 ELSE IF CALB = 0 THEN 6664 ELSE IF VER% >= 512 THEN VER% = 0: REDIL = 0: GOTO 6665 ELSE GOTO 6665 ELSE GOTO 6665 6664 GO㐞SUB 5262: GOSUB 1240: GOTO 7200 6665 GOSUB 8768: GOSUB 8765 6689 TOT = 0: GOSUB 1001: GOSUB 120: GOSUB 6465: IND = 1 6691 IF PAR(16) = 1 THEN T = 8 ELSE T = 9 6692 IF PAR(T) < 21 THEN PAP = PAR(T): GOTO 6694 ELSE GOSUB 5135: GET #1, PAR(T): PAP$ = A2$ 6693 PAP = VAL(MID$(PAP$, 2, 2)): CLOSE #1 6694 GOSUB 5130: GET #1, (PAP - 1) * 100 + 20: K1(20) = CVS(A1$): CLOSE #1 6695 GOSUB 6100 6700 M% = MUL(IND): GOSUB 5160: GOSUB 10000: GOSUB 5220: IF MULTI THEN 6708 6701 IF (K1(6) = 5 OR K1(6) = 6 OR K1(6) 㐞 = 10) AND (K1(58) <> 0) THEN PRETR = 1 ELSE GOTO 6708 6705 IF (K1(59) AND 240) = 0 THEN VER% = 6: GOSUB 6500: GOTO 7950 ELSE 6709 6708 IF K1(58) THEN PRED(IND) = 1 6709 GOSUB 5466: IF VER% <> 10 AND VER% <> 0 THEN 7950 6710 IF K1(6) <> 4 THEN IF (UN1$ = SPACE$(6)) AND (UN2$ = SPACE$(6)) THEN VER% = 3: GOSUB 6500: GOTO 7950 6711 IF (K1(6) = 3) OR (K1(6) = 4) THEN 6718 6716 IF K1(33) THEN 6718 6717 IF K1(65) = 0 THEN VER% = 1: GOSUB 6500: GOTO 7950 6718 IF IND = 1 THEN GOSUB 5200 6720 GOSUB 5405 672㐞1 IF K1(33) THEN 6725 6722 IF (K1(6) = 3) OR (K1(6) = 4) OR (K1(6) = 12) THEN 6725 ELSE TOT = TOT + 1 6725 GOSUB 11100: IF SEC AND SEC1 AND SEC3 THEN 6726 ELSE 8850 6726 IF MULTI THEN IND = IND + 1: GOSUB 5245: IF MUL(IND) THEN 6700 6740 IF MULTI THEN A$ = "MULTITEST" ELSE A$ = "METHOD" 6741 IF TOT = 0 THEN 6745 6742 COLOR 5, 0: LOCATE 20, 2: PRINT "Standards": LOCATE 21, 5: PRINT "F1": COLOR 1, 2 6745 COLOR 5, 0: LON = 1: GOSUB 105: LOCATE 1, 39 - N: GOSUB 110: COLOR 1, 2 6746 IF RSTART = 0 THEN CO㐞LOR 5, 0: LOCATE 20, 60: PRINT "Delete": LOCATE 21, 61: PRINT "S F6": GOSUB 10051 6755 LOCATE 8, 1: PRINT STRING$(80, 45) 6760 IF (SEC OR SEC1 OR SEC3 OR CAL) AND FI = 0 THEN GOTO 10100 ELSE GOSUB 5002 6762 GOSUB 601 6765 FI = 0: IF TOT THEN REPO = 1 ELSE REPO = 3 6767 IF RSTART = 0 THEN 6770 ELSE GOSUB 5008 6769 ON REPO + 1 GOTO 6765, 6771, 6775, 6780, 6765, 6765, 6765, 6765, 6765, 6765 6770 ON REPO + 1 GOTO 6765, 6771, 6775, 6780, 6765, 6765, 6790, 6772, 6765, 6765 6771 GOSUB 5240: GOTO 6985 6772㐞 GOSUB 5240: GOTO 6524 6775 IF NOCALI = 1 AND PRETR AND RSTART = 0 THEN RERUN = 0: GOTO 6985 6776 IF (NEWT = 0) AND (PARTF <> 0) THEN 6765 ELSE RERUN = 0: GOTO 6970 6780 IF PARTF = 0 THEN 6765 ELSE IF NOCALI AND PRETR AND RSTART = 0 THEN 6985 ELSE PART = PARTF: REPORT = 1: GOTO 6970 6790 PA$ = "RDCP": GOTO 35 6798 L = 25 6799 BI$ = SPACE$(28): GOSUB 2021: RETURN 6951 IF PRETR THEN NO = 1: APRET = 0: GOTO 6989 ELSE 6989 6970 'quest facu. method comment 6975 LECTURE = 0: GOSUB 4050: GOTO 7200 6985 G㐞OSUB 5007: PST = 1: IF CG AND PAR(34) <> 64 THEN 6987 6986 IF (VER% >= 16 AND VER% <> 512 AND VER% <> 1024) OR ((PAR(34) = 64) AND (PAR(37) = 0)) THEN CUST = 1: AUTOCHG = 1: GOTO 8500 6987 IF TOT = 0 THEN 6765 6989 NOCALI = 0: CALB = 0: GOSUB 1480: IF PLM(49) = 0 THEN IF NEWT = 0 THEN GOSUB 4365: IF NOPLACE THEN 7200 6990 IF NOSAMP THEN RESTORE 5021: GOTO 7011 ELSE IF PARTF = 0 OR PRETR THEN RESTORE 5020: GOTO 7011 6992 IF NEWT THEN RESTORE 5015 ELSE RESTORE 5025 7011 IND = 1: GOSUB 120: GOSUB 8770: L㐞ECTURE = 3: IF NEWT = 0 THEN TRL = 1: GOSUB 6465: TRL = 0 7012 GOSUB 9160: IF PASSAG = 1 AND AFST = 0 THEN GOSUB 9152 7013 IF MULTI THEN 7016 7015 IF (APRET = 0) AND (PRETR = 1) THEN GOSUB 5197: GOTO 7022 7016 GOSUB 5190 7022 ME = MUL(IND): IF ME = 0 THEN 7101 7023 IF MULTI THEN M% = ME 7024 IF MULTI THEN GOSUB 5160: GOSUB 5255: GOSUB 5395 7025 IF RSTART AND VER% = 10 THEN 7026 ELSE 7028 7026 IF (PLM(49) AND 2 ^ (IND - 1)) = 0 THEN 7100 7028 IF K1(33) THEN L = 4: C = 6 + ((IND - 1) * 9): LOCATE L,㐞 C, 0: PRINT "BLANK": GOTO 7100 ELSE IF PRETR THEN GOSUB 5795 7029 FOR K = 64 TO 77: IF K1(K) THEN GOSUB 5800 7030 NEXT K 7100 IND = IND + 1: GOTO 7022 7101 GOSUB 601 7102 L = 3: C = 1: REPO = 3: GOSUB 5976: LOCATE L, C, 0: IF NOSAMP = 0 THEN 7111 7110 ON REPO + 1 GOTO 7102, 7102, 7102, 7102, 7102, 7102, 7102, 7102, 7162 7111 ON REPO + 1 GOTO 7102, 7112, 7130, 7135, 7102, 7150, 7102, 7165, 7162 7112 IF TOT = 0 THEN 7102 7113 KN = 0: BLACOR = 0: GOSUB 6510 7114 KN = KN + 1: IF MUL(KN) = 0 THEN 6989㐞 ELSE FOR T = 1 TO 8: IF MUL(KN) = TCAL(T) THEN 7114 ELSE NEXT T 7115 IF MULTI THEN RESTORE 5128 ELSE RESTORE 5126 7116 IF PRETR THEN NO = 1 7118 GOSUB 120: COLOR 5, 0: LOCATE 24, 1: PRINT SPACE$(11): LOCATE 25, 1: PRINT SPACE$(11); : COLOR 1, 2: IF MULTI = 0 THEN 7121 7119 M% = MUL(KN): GOSUB 5160: IF K1(33) <> 0 OR K1(6) = 3 OR K1(6) = 4 OR K1(6) = 12 THEN 7114 7120 LOCATE 4, 38: PRINT B$(MUL(KN)) 7121 IF K1(6) = 5 OR K1(6) = 6 THEN LOCATE 6, 10: PRINT "PARAMETERS OF CALIBRATION CURVE :": LOCATE 8, 㐞37: PRINT "R0 ="; USING "##.####"; K1(84): LOCATE 9, 37: PRINT "G0 ="; USING "##.####"; K1(85) ELSE 7123 7122 LOCATE 10, 38: PRINT "A ="; USING "##.####"; K1(86): LOCATE 11, 38: PRINT "B ="; USING "##.####"; K1(87): IF K1(6) = 6 THEN LOCATE 12, 38: PRINT "C ="; USING "##.####"; K1(88): GOTO 7127 ELSE 7127 7123 FOR T = 1 TO K1(1) + BLACOR: IF ((K1(19) AND 2 ^ (T - 1)) <> 0 OR (T = 1 AND BLACOR = 1)) THEN LOCATE 4 + T, 3: PRINT "Dabs ,Calibration Point"; T; ELSE 7125 7124 IF T = 7 AND K1(6) = 10 THEN PRIN㐞 T USING "##.####"; K1(78) ELSE PRINT USING "##.####"; K1(42 + T) 7125 NEXT T: IF K1(6) = 10 THEN 7127 7126 LOCATE 5, 40: PRINT "Slope : "; : PRINT USING "##.#####"; K1(78): LOCATE 6, 40: PRINT "Intercept : "; : PRINT USING "##.#####"; K1(79) 7127 GOSUB 601: IF MULTI THEN ENTREE = 1 + 2 ^ 6 ELSE ENTREE = 2 ^ 6 7128 GOSUB 740 7129 ON REPO + 1 GOTO 7128, 7114, 7128, 7128, 7128, 7128, 7128, 6951 7130 IF REPORT THEN 7102 7131 IF (NEWT = 0) AND (PARTF <> 0) THEN 7102 ELSE 7140 7135 IF PARTF = 0 THEN 7㐞102 7136 IF REPORT = 0 THEN LECTURE = LECTURE XOR 2 7137 PART = PARTF: REPORT = 1: GOSUB 1185 7140 GOSUB 2720: GOTO 7200 7150 IF TOT = 0 THEN 7102 7154 VER% = 9: GOTO 7950 7162 IF (VER% <> 0) THEN 7163 ELSE GOSUB 2720 7163 IF PASSAG THEN 7670 ELSE 7102 7165 PASSAG = 0: GOSUB 5270: GOSUB 5230: GOSUB 5890 7167 IF VER% = 10 THEN VER% = 0 7170 LECTURE = 0: ECRALPHA = 1: GOTO 6625 7185 GOTO 7102 7200 GOSUB 5007: PST = 0: VIR = 0: IF CG AND PAR(34) <> 64 THEN 7202 7201 IF (VER% >= 16 AND VER% <> 512 㐞AND VER% <> 1024) OR ((PAR(34) = 64) AND (PAR(37) = 0)) THEN AUTOCHG = 1: GOTO 8500 7202 PAGE = 0: GOSUB 1480: IF RSTART THEN GOSUB 2570 'ELSE IF AUTOCHG THEN AUTOCHG=0:GOSUB 2571 7203 IF FLSTD THEN FLSTD = 0: GOTO 6985 7210 IF VER% = 512 AND NOSAMP = 0 AND REDIL = 0 THEN VER% = 0: GOTO 7671 ELSE GOSUB 8770: IF (REDIL <> 0 AND RERUN <> 0 AND VER% >= 512) THEN NOSAMP = 2 ELSE IF RSTART <> 0 THEN NOSAMP = 1 7230 LOCATE 1, 65: PRINT B$ 7236 IF NOSAMP <> 0 THEN RESTORE 5091 ELSE IF TOT = 0 THEN RESTORE 5㐞066 ELSE RESTORE 5065 7237 GOSUB 120: GOSUB 9160: IF PASSAG = 1 AND AFST = 0 THEN GOSUB 9152 7238 IF (PAR(37) = 0 OR VER% >= 32) AND NOSAMP = 0 THEN COLOR 5, 0: LOCATE 20, 38: PRINT "Change"; : LOCATE 21, 40: PRINT "F4"; : COLOR 1, 2 7239 TRL = 1: GOSUB 6465: TRL = 0: IF MULTI THEN 7240 ELSE IF (APRET = 0) AND PRETR THEN GOSUB 5197 7240 READ X$: READ Z$: READ W$: READ WD$ 7245 COLOR 5, 0: IF REPORT THEN BI$ = "report" ELSE BI$ = "manual" 7255 L = 2: GOSUB 2021: COLOR 1, 2 7260 IF PRETR = 0 THEN 7321 㐞 7300 L = 2: C = 5: LOCATE L, C 7321 IF PRETR OR CHPAG THEN 7326 7323 FOR I = 33 TO 48: IF PRETR THEN 7326 7324 IF PL(I) THEN PAGE = 16: GOTO 7326 7325 NEXT I 7326 IBAK = 16: IF CHPAG = 0 THEN 7328 7327 IF PAGE = 16 THEN IBAK = 32 7328 IF PRETR THEN GOSUB 5795: GOTO 7330 7329 FOR T = 1 TO 16: LOCATE 3 + T, 1: PRINT T + PAGE: NEXT T 7330 FOR I = 17 TO 48 7331 IF (PRETR = 1) AND (I = 33) THEN 7397 7332 IF PRETR THEN AA$ = "": GOTO 8150 7335 IF PAGE = 0 AND I > 32 THEN 7396 7340 IF PAGE = 16 AND I㐞 < 33 THEN 7396 7345 IF PL(I) = 0 THEN 7396 7347 AA$ = "": GOTO 7355 7348 FOR KE = 1 TO 16: IF PLP(KE) = I THEN AA$ = AA$ + STR$(KE): GOTO 7355 7349 NEXT KE 7355 IF PL(I) < 251 THEN V$ = " " + PAT$(I - 16) + AA$: GOTO 7380 7360 IF PL(I) = 251 THEN V$ = X$ + SPACE$(5) + AA$: GOTO 7380 7365 IF PL(I) = 253 THEN V$ = Z$ + SPACE$(5) + AA$: GOTO 7380 7370 IF PL(I) = 252 THEN V$ = W$ + SPACE$(5) + AA$: GOTO 7380 7380 IF (PRETR = 1) AND (PL(I)) THEN LOCATE I - 13, 6: PRINT V$: LOCATE I - 13, 21: K$ = RIGHT㐞$(STR$(I - 16), LEN(STR$(I - 16)) - 1): PRINT "D.C"; K$: GOTO 7395 7381 IF PRETR THEN 7396 7384 LOCATE I - PAGE - 13, 5: PRINT V$ 7395 IBAK = I 7396 NEXT I 7397 IF PRETR THEN GOSUB 8190: GOTO 7450 7398 IF IBAK <> 48 AND IBAK <> 32 THEN IBAK = IBAK + 1 7400 IND = 1: M% = MUL(IND) 7410 L = 4: C = 20 + (IND - 1) * 7: GOSUB 5260: GOSUB 5400 7415 FOR ESS = 17 + PAGE TO 32 + PAGE 7417 IF PLM(ESS) AND (2 ^ (IND - 1)) THEN LOCATE ESS - PAGE - 13, 17 + (IND * 7): PRINT "*" 7420 IF PRED(IND) = 0 THEN 7428 㐞 7421 IF (PLPM(ESS) AND (2 ^ (IND - 1))) = 0 THEN 7428 ELSE LOCATE ESS - PAGE - 13, 14 + (IND * 7) 7422 FOR KE = 1 TO 16: IF PLP(KE) <> ESS THEN 7427 7423 IF MULTI THEN 7425 7424 IF PLP(KE) THEN 7426 ELSE 7427 7425 IF (PLPM(KE) AND (2 ^ (IND - 1))) = 0 THEN 7427 7426 K$ = RIGHT$(STR$(KE), LEN(STR$(KE)) - 1): PRINT "D.C"; K$: GOTO 7428 7427 NEXT KE 7428 NEXT ESS: IND = IND + 1: M% = MUL(IND) 7435 IF M% THEN 7410 ELSE IF MULTI = 0 THEN NBM = 1: M% = MUL(1) ELSE NBM = IND - 1 7438 LIEU = 0: IF IBAK <=㐞 PAGE + 16 THEN IBAK = 17 + PAGE 7440 IF VER% = 10 AND RSTART = 0 THEN GOSUB 5156 7441 IF (VER% = 1024 AND REDIL <> 0 AND RERUN <> 0) THEN GOSUB 5154 ELSE IF VER% = 1024 THEN GOSUB 5155 ELSE IF (REDIL <> 0 AND RERUN <> 0) THEN GOSUB 5154 7442 IF DILMA <> 0 THEN GOSUB 5153 7445 L = IBAK - 13 - PAGE: C = 4 7450 IF CHPAG THEN CHPAG = 0: I = 17 + PAGE: L = 4 ELSE I = IBAK 7455 LOCATE L, C, 1: PRINT " "; 7480 COMP = 100 7485 GOSUB 601 7486 IF NOSAMP <> 2 THEN 7488 ELSE IF PAGE = 0 THEN COLOR 5, 0: LOCAT㐞 E 20, 16, 0: PRINT "Next": LOCATE 21, 17, 0: PRINT "F2": COLOR 1, 2 ELSE IF PAGE = 16 THEN COLOR 5, 0: LOCATE 20, 25, 0: PRINT "Previous": LOCATE 21, 28, 0: PRINT "F3": COLOR 1, 2 7488 IF CHPAG THEN 7236 7490 GOTO 7669 'IF NOSAMP=0 THEN ENTREE=1+2+4+8+16+32+64+128:GOTO 7492 7491 'IF NOSAMP=1 THEN ENTREE=128:LOCATE L,C,0 ELSE ENTREE=2+4+128:LOCATE L,C,0 7492 'GOSUB 740 7493 'ON REPO+1 GOTO 7494,7545,7582,7601,5158,7650,7490,7665,7669,7685 7494 IF NOSAMP <> 0 THEN 7490 ELSE GOSUB 5976 7499 IF F$ = "㐞" THEN 7488 7500 IF F$ = "+" THEN 7695 7505 IF F$ = "-" THEN 7740 7506 IF F$ = "." THEN 9100 7510 IF F$ = "/" THEN 7840 7512 IF F$ = "*" THEN 7870 7513 IF F$ = "%" THEN 8710 7515 IF F$ = CHR$(139) THEN GOTO 7830 7516 IF F$ = CHR$(140) THEN GOTO 7785 7517 IF F$ = CHR$(141) THEN GOTO 7775 7518 IF F$ = CHR$(142) THEN GOTO 7795 7520 GOTO 7488 7545 GOSUB 5006: GOSUB 6240: IF PAVA THEN 7945 ELSE GOSUB 5665 7555 IF STATUS <> 9 THEN STATUS = 8 7570 IF VER% = 10 OR VER% = 1024 THEN VER% = 0: GOTO 7945 㐞ELSE GOTO 7945 7582 IF NOSAMP = 2 AND PAGE = 16 THEN 7490 ELSE IF PRETR THEN PAGE = 16: CHPAG = 1 7583 IF PAGE = 0 THEN PAGE = 16: CHPAG = 1: LIEU = 0: GOTO 7236 7585 GOSUB 5004: GOSUB 6240: IF PAVA THEN PAVA = 0: IBAK = 17: GOSUB 5007: GOTO 7400 7590 GOSUB 5665: GOSUB 5715: IF REPORT THEN REPT = 1 7591 GOSUB 1700 7592 IF (REPT = 0 AND REPORT = 1) OR (REPT = 1 AND REPORT = 0) THEN GOSUB 5960: GOSUB 5007: GOTO 7400 7593 IF STATUS <> 9 THEN STATUS = 8 7595 GOTO 7620 7601 IF NOSAMP = 2 AND PAGE = 0 TH㐞EN 7490 ELSE IF PAGE = 16 THEN PAGE = 0: CHPAG = 1: LIEU = 0: GOTO 7236 7605 GOSUB 5005: GOSUB 6240 7606 IF PAVA = 0 THEN 7610 7607 IF PAR(9 + METCO) = PAR(37 + METCO) THEN PAVA = 0: IBAK = 17: GOTO 7400 7608 IF PAVA THEN PAR(9 + METCO) = PAR(9 + METCO) - 1: PAR(41 + POINTEUR + (METCO - 1) * 4) = 0: PAR(35) = PAR(35) XOR 2 ^ ((POINTEUR - 1) + (8 * (METCO - 1))) 7609 IF PAR(9 + METCO) = 0 THEN PAR(9 + METCO) = 4 7610 GOSUB 5665: GOSUB 5960 7611 IF PAVA THEN PAVA = 0: GOTO 7615 7612 IF PAR(9 + METCO) 㐞= PAR(37 + METCO) THEN GOSUB 5007: GOTO 7455 7615 IF STATUS <> 9 THEN STATUS = 8 7616 GOSUB 1730 7620 LECTURE = 0: GOSUB 5230: PASSAG = 0: APRET = 0: GOSUB 5007: GOTO 7200 7650 IF TOT = 0 THEN 7485 7651 GOSUB 4365: IF NOPLACE THEN 7442 ELSE APRET = 0: GOTO 6771 7652 FOR K = 1 TO K1(1): IF PL(K1(63 + K)) THEN 7654 7653 NEXT K 7654 IF K = K1(1) + 1 THEN 7485 ELSE 6771 7665 WL = 0: TLU = 0: PREDIL = 0: PASSAG = 0: GOSUB 5270: GOSUB 5230 7666 APRET = 0: IF VER% = 10 OR VER% = 1024 THEN VER% = 0: L = 2㐞4: GOSUB 6799 7667 GOTO 7170 7669 IF (AFST = 0) OR (TXT = 1) OR (NOCALI = 1) OR (PAR(17) = 1) THEN 7400 7670 GOSUB 5199: IF PAR(37) THEN 8700 7671 IF VER% < 16 OR VER% = 512 OR VER% = 1024 THEN GOSUB 6240: IF PAVA THEN PAVA = 0: GOTO 8754 7672 IF VER% = 512 THEN 7674 ELSE IF PAR(37) = 4 THEN BI$ = "4 RUN ANALYSIS": GOTO 8753 ELSE IF PAR(40) AND VER% < 16 THEN BI$ = "MULTI RUNNING": GOTO 8753 7673 GOSUB 1170: IF NBMO THEN LOCATE 25, 29, 0: PRINT " F1 TO VALID "; : FOR T! = 1 TO 20000: NEXT T!:㐞 GOTO 8754 7674 GOSUB 8600: IF FAUX THEN 8754 ELSE 8649 7683 VER% = 0: STATUS = 9: IF F8MEMO THEN 625 ELSE BUT = 0: GOTO 625 7684 IF VER% = 16 THEN 7490 ELSE 8755 7685 GOTO 7485 7695 IF REPORT AND LIEU = 0 THEN 7485 7696 IF PL(I) < 250 AND PL(I) <> 0 AND LIEU THEN 7485 ELSE LOCATE , , 0 7710 GOSUB 9050: CURLIEU = 0: GOTO 7980 7740 CPPRED = 0: IF (LIEU = 0 AND PL(I) < 250 AND PL(I) <> 0 AND MULTI) THEN 7485 7741 IF (PLM(I) AND 2 ^ (LIEU - 1)) <> 0 THEN 7743 7742 IF LIEU <> 0 AND PL(I) < 250 AND PL(㐞I) <> 0 THEN 7485 7743 IF PL(I) < 250 AND PL(I) <> 0 AND PLP(I) <> 255 THEN 7485 ELSE LOCATE , , 0 7744 IF PRETR THEN IF PL(I) = 254 THEN 7980 ELSE PL(I) = 0: PL(I - 16) = 0: PLP(I) = 0: PLP(I - 16) = 0: LOCATE I - 13, 5: PRINT SPACE$(14): LOCATE I - 13, 21: PRINT SPACE$(6): I = I + 1: GOTO 7980 7745 IF PL(I) < 250 AND PLP(I) = 255 THEN CPPRED = 1 7754 IF LIEU THEN 7765 7755 FOR T = 1 TO NBM: C = 14 + (T * 7): LOCATE L, C, 0: PRINT SPACE$(6): NEXT T 7756 FOR K = 1 TO 16: IF PLP(K) = I THEN PL(K) = 0: 㐞PLM(K) = 0: PLP(K) = 0: PLPM(K) = 0 7757 NEXT K 7758 PLM(I) = 0: PLP(I) = 0: PLPM(I) = 0: IF CPPRED = 0 THEN PL(I) = 0 7760 C = 4: IF CPPRED = 0 THEN LOCATE L, C, 0: PRINT SPACE$(14): LOCATE L, C + 20: PRINT " ": I = I + 1: GOTO 7980 7762 PLM(I) = PLM(I) OR 2 ^ 0: LOCATE L, C + 20: PRINT "*": I = I + 1: GOTO 7980 7765 PLM(I) = PLM(I) AND (255 - (2 ^ (LIEU - 1))): LOCATE L, C - 2: PRINT SPACE$(6): IF PRED(LIEU) = 0 THEN 7772 7766 FOR K = 1 TO 16: IF PLP(K) <> I THEN 7769 7767 IF (PLPM(K) AND 2 ^ (LIEU㐞  - 1)) THEN PL(K) = 0: PLM(K) = 0: PLP(K) = 0: PLPM(K) = 0: GOTO 7771 7769 NEXT K 7771 PLPM(I) = PLPM(I) AND (255 - (2 ^ (LIEU - 1))) 7772 IF CPPRED <> 0 THEN LOCATE L, C + 1: PRINT "*"; : PLM(I) = PLM(I) OR 2 ^ (LIEU - 1) 7773 LIEU = LIEU + 1: GOTO 7980 7775 I = I - 1 7776 IF PRETR THEN 7786 7780 GOTO 7984 7785 IF MULTI THEN LIEU = LIEU + 1: GOTO 7984 ELSE 7485 7786 IF I = 33 THEN I = 32 7787 IF I = 16 THEN I = 17 7788 L = I - 13: LOCATE L, 5, 1: PRINT " "; : GOTO 7485 7795 I = I + 1 7796 IF P㐞RETR THEN 7786 7800 GOTO 7984 7830 IF MULTI THEN LIEU = LIEU - 1: GOTO 7984 ELSE 7485 7840 LOCATE , , 0: T = 253: T$ = Z$: GOTO 7891 7870 LOCATE , , 0: T = 252: T$ = W$ 7891 IF LIEU THEN LOCATE L, C, 1: PRINT " "; : GOTO 7485 ELSE IF PRETR AND PL(I) = 0 THEN PL(I) = T: PLP(I) = 255: PL(I - 16) = 255: PLP(I - 16) = I: PRINT T$: K$ = RIGHT$(STR$(I - 16), LEN(STR$(I - 16)) - 1): LOCATE I - 13, 21: PRINT "D.C"; K$: I _ = I + 1: GOTO 7980 7892 IF PL(I) THEN LOCATE L, C, 1: PRINT " "; : GOTO 7485 ELSE PL(㐞I) = T: PRINT T$: IF MULTI = 0 THEN LOCATE L, C + 20: PRINT "*": PLM(I) = PLM(I) OR 1: I = I + 1: GOTO 7980 ELSE LIEU = LIEU + 1: GOTO 7980 7945 IF AIG1 THEN 625 ELSE 610 7950 IF MULTI THEN M% = MULTI 7951 METH% = M%: GOTO 680 7980 IF PRETR = 1 AND MULTI = 0 THEN 7981 ELSE 7983 7981 IF I = 33 THEN I = 32 ELSE IF I = 16 THEN I = 17 7982 GOTO 8015 7983 IF LIEU < 1 AND CURLIEU = 1 THEN LOCATE L, C - 1, 1: PRINT " "; 7984 IF LIEU > NBM THEN I = I + 1: LIEU = 0 7985 IF LIEU < 0 THEN I = I - 1: LIEU = 0 㐞 7990 IF I < 17 THEN I = 17 7995 IF I > 48 THEN I = 48 8000 IF PAGE = 0 AND I > 32 THEN CHPAG = 1: PAGE = 16: LIEU = 0: GOTO 8016 8005 IF PAGE = 16 AND I < 33 THEN CHPAG = 1: PAGE = 0: LIEU = 0: GOTO 8016 8010 IF LIEU = 0 THEN C = 4 ELSE C = 16 + (LIEU * 7): CURMULT = 1 8015 L = I - PAGE - 13: IF CURMULT = 1 AND CURLIEU = 1 THEN LOCATE L, C - 1, 1: PRINT " "; : CURMULT = 0: CURLIEU = 0: GOTO 7485 ELSE LOCATE L, C, 1: PRINT " "; : GOTO 7485 8016 IF ASC(F$) > 138 AND ASC(F$) < 143 THEN 7485 ELSE 7236 8㐞150 IF PL(I) <> 254 THEN 7355 8155 FOR K = 64 TO 77: IF K1(K) = I - 16 THEN 8160 8157 NEXT K 8160 IF K = 76 THEN V$ = " CALC. 1": GOTO 8180 8162 IF K = 77 THEN V$ = " CALC. 2": GOTO 8180 8164 IF K = 64 THEN V$ = " BLANK" ELSE V$ = " Std" + STR$(K1(K - 57)) 8180 IF IMPSTD THEN RETURN ELSE GOTO 7380 8190 IF IBAK < 32 THEN IBAK = IBAK + 1 8195 L = IBAK - 13: C = 5: RETURN 8500 IF PAR(37) = 0 THEN 8503 8502 IF PAR(37) > 1 THEN 7485 8503 IF PAR(37) = 0 AND VER% < 16 THEN NOSAMP = 0 ELSE IF PAR(34) = 6㐞4 OR VER% >= 16 THEN NOSAMP = 1 ELSE NOSAMP = 0 8504 IF AIG1 THEN SOUND 2500, 160 8510 'GOSUB 2192: Q$ = "HALT1": GOSUB 2023: GOSUB 2193 8512 PASBAK = PASSAG: PASSAG = 0: IF NOSAMP OR ABORTE OR AUTOCHG OR PASEXI THEN RESTORE 5106: GOSUB 120 ELSE RESTORE 5108: GOSUB 120: GOSUB 602 8513 PASSAG = PASBAK 8514 LOCATE 4, 28, 0: PRINT "Remaining free cuvettes "; 64 - PAR(34) 8515 IF PAR(34) THEN LOCATE 6, 31: PRINT "Used cuvettes ": PRINT ELSE 8522 8516 JCM = 8: FOR T = 1 TO 64: IF P64(T) > 0 AND P64(T) < 㐞255 THEN GOSUB 8519 ELSE GOSUB 8521 8517 NEXT T: YAM = 0: JCM = 15: LOCATE 13, 31: PRINT "Rejected cuvettes": PRINT : FOR T = 1 TO 64: IF P64(T) = 255 THEN GOSUB 8519 ELSE GOSUB 8521 8518 NEXT T: YAM = 0: GOTO 8522 8519 YAM = YAM + 1: KAWA = LEN(STR$(T)): IF YAM = 8 THEN IF KAWA < 3 THEN YAM$ = " " + STR$(T) + " **" ELSE YAM$ = STR$(T) + " **" ELSE IF YAM = 16 THEN YAM$ = STR$(T) ELSE IF KAWA > 2 THEN YAM$ = STR$(T) + " -" ELSE YAM$ = " " + STR$(T) + " -" 8520 IF YAM = 17 THEN YAM = 1: JCM = JCM + 1: LO㐞CATE JCM, 1: PRINT YAM$; : RETURN ELSE PRINT YAM$; : RETURN 8521 YAM = YAM + 1: IF YAM = 8 THEN YAM$ = " **": GOSUB 8520: RETURN ELSE IF YAM = 16 THEN YAM$ = " ": GOSUB 8520: RETURN ELSE YAM$ = " -": GOSUB 8520: RETURN 8522 GOTO 8530 'IF NOSAMP OR ABORTE OR AUTOCHG OR PASEXI=0 THEN ABORTE=0:GOTO 8524 ELSE 8526 8524 ENTREE = 8: GOSUB 740 8525 ON REPO + 1 GOTO 8524, 8524, 8524, 8524, 8530, 8524, 8524, 8524, 8524, 8524 8526 ENTREE = 8 + 64: GOSUB 740 8527 ON REPO + 1 GOTO 8526, 8526, 8526, 8526,㐞 8530, 8526, 8526, 8531, 8526, 8526 8530 GOSUB 8980: FOR ES = 1 TO 64: P64(ES) = 0: NEXT ES: PAR(34) = 0: FAUX = 0 8531 IF CUST = 1 THEN CUST = 0: CG = 1: CHOIX = 34: GOSUB 1310: GOTO 6985 ELSE CG = 1: CHOIX = 34: GOSUB 1310: IF PRETR THEN NO = 1: APRET = 0: GOTO 7200 ELSE GOTO 7200 8600 MET = M%: IND = 1: FAUX = 0: BLACOR = 0: ETAL = 0: DISPO = 64 - PAR(34): IF DISPO < 2 THEN 8640 8601 IF MULTI = 0 THEN 8604 8602 IF VER% < 32 THEN M% = MUL(1): GOTO 8604 ELSE LIMI% = (PAR(24) AND 16128) / 256 + 1 8603㐞  IF LIMI% > 1 THEN M% = MUL((DEMET AND 255)) ELSE M% = MUL((DEMET AND 255) + 1) 8604 GOSUB 5160 8610 IF K1(6) <> 4 THEN 8616 8615 IF DISPO < 2 THEN 8640 8616 IF PLM(49) = 0 OR PRETR <> 0 THEN 8622 8617 IF LIMI% > 1 THEN 8645 8618 'IF (K1(30)=0 OR (K1(30)0 AND K1(30) LIMI1 THEN 8655 8652 IF PAR(37) = 0 THEN 8655 8653 GOSUB 6095: GOTO 8695 8655 IF PAR(37) = 0 THEN LIMI% = 1: GOTO 8660 8656 IF LIMI1 = 0 THEN LIMI1 = 1 8657 IF LIMI1 <> 49 THEN LIMI% = LIMI1: GOSUB 6093: GOTO 8697 ELSE LIMI% = 1 8660 IF MULTI = 0 THEN 8670 8661 IF 㐞PAR(40) = 0 THEN PAR(40) = 1 8670 IF PAR(11 + PAR(16)) = 0 THEN PAR(11 + PAR(16)) = PAR(37 + PAR(16)) 8671 IF VER% <> 16 THEN IF PAR(40) > 1 THEN PRIM = 1 8672 UR = PAR(16): GOSUB 8990 8680 PAR(36) = PAR(36) OR 2 ^ (ANC - 1 + (8 * (PAR(16) - 1))) 8682 PAR(37) = PAR(37) + 1: IF VER% = 16 THEN 8688 8684 IF MULTI THEN GOSUB 1180: MONO = MUL(PAR(40)) ELSE MONO = M% 8685 PAR(19 + (3 * PAR(37))) = MONO + (32 * MULTI) + (1024 * PAR(40)) 8686 TANC = ANC + ((PAR(16) - 1) * 4): PAR(20 + (3 * PAR(37))) = TANC 㐞+ (16 * (PAR(41 + TANC) AND 511)) 8687 IF PRIM = 1 THEN 8695 8688 IF PAR(37 + PAR(16)) = 0 THEN PAR(9 + PAR(16)) = 0 8689 GOSUB 8760 8690 IF PAR(37 + PAR(16)) THEN 8695 8692 IF PAR(40 - PAR(16)) THEN PAR(16) = 3 - PAR(16) ELSE PAR(16) = 0 8695 GOSUB 8796 8697 PAR(21 + (3 * PAR(37))) = LIMI%: GOSUB 2970 8698 IF VER% = 64 THEN IF (PAR(40) <> 0) THEN GOSUB 8796 8699 GOSUB 4500: GOSUB 5665: GOSUB 8750: GOTO 7683 8700 IF (VER% >= 16) THEN 7671 8701 IF PRETR THEN BI$ = "No Pre-treatment in continue": G㐞OTO 8704 ELSE GOSUB 5198 8702 IF MID$(R$, 6, 1) <> "1" THEN BI$ = " Add running ": GOTO 8704 8703 GOSUB 1950: IF COL THEN COL = 0: GOTO 7671 ELSE F8MEMO = 1: GOTO 7671 8704 L = 25: IBAK = 17: GOSUB 2021: IF PST THEN 6985 ELSE 7400 8710 IF MULTI THEN 8730 8711 IF PRETR THEN 7980 8714 IF PRED(1) = 0 THEN 7980 8715 IF PLP(I) THEN 7980 8716 IF PL(I) = 0 AND REPORT THEN 7485 ELSE IF PL(I) = 0 THEN PL(I) = 251: LIEU = 1: GOTO 8735 ELSE LIEU = 1: GOTO 8735 8730 IF PL(I) < 250 AND PL(I) <> 0 AND L㐞IEU AND (PLM(I) AND 2 ^ (LIEU - 1)) = 0 THEN 7485 ELSE IF PRED(LIEU) = 0 THEN CURLIEU = 0: GOTO 7980 8731 IF LIEU = 0 THEN CURLIEU = 0: GOTO 7980 8733 IF PL(I) = 0 THEN 7980 8734 IF (PLPM(I) AND 2 ^ (LIEU - 1)) THEN 7980 8735 FOR K = 2 TO 16: IF PL(K) THEN 8743 ELSE IF REDIL THEN 8737 8736 PLM(I) = PLM(I) OR 2 ^ (LIEU - 1) 8737 PL(K) = 255: PLM(K) = 2 ^ (LIEU - 1): PLP(K) = I: PLPM(K) = 2 ^ (LIEU - 1) 8738 PLP(I) = 255: PLPM(I) = PLPM(I) OR 2 ^ (LIEU - 1): IF REDIL THEN K = 16: GOTO 8743 ELSE K$ = RI㐞GHT$(STR$(K), LEN(STR$(K)) - 1) 8739 IF (MULTI = 0) AND (PL(I) = 251) THEN PRINT X$ 8740 IF MULTI = 0 THEN LOCATE L, 21: PRINT "D.C"; K$: GOTO 8746 ELSE LOCATE L, C - 2: PRINT "D.C"; K$ 8741 GOTO 8746 8743 NEXT K: IF REDIL THEN RETURN 8744 IF K > 16 THEN FOR LIE = 1 TO NBM: IF (PLM(I) AND 2 ^ (LIE - 1)) = 0 THEN NEXT LIE: PL(I) = 0 8745 IF MULTI = 0 THEN LIEU = 0: GOTO 7980 ELSE GOTO 7980 8746 IF MULTI = 0 THEN LIEU = 0: I = I + 1: GOTO 7980 ELSE LIEU = LIEU + 1: GOTO 7980 8750 GOSUB 6798: RETURN 8㐞753 L = 25: GOSUB 2021 8754 F8MEMO = 0: IBAK = 17 8755 GOSUB 5665: GOSUB 8750 8756 IF FAUX THEN IF PAR(37) = 0 THEN 8500 8757 IF PST THEN 7102 ELSE 7400 8760 IF VER% = 16 THEN 8763 8761 IF (PAR(20 + (3 * PAR(37))) AND 2 ^ 12) THEN 8763 8762 PAR(13 + PAR(16)) = PAR(13 + PAR(16)) + 1: GOSUB 5700 8763 RETURN 8765 IF PARTF = 0 OR PRETR THEN RESTORE 5080: GOTO 8767 8766 IF NEWT THEN RESTORE 5085 ELSE RESTORE 5082 8767 SUP% = F9 + 2 ^ 5: RETURN 8768 IF MULTI = 0 THEN GOSUB 5130: GET #1, (M% - 1) * 100㐞  + 6: T = CVS(A1$): GET #1, (M% - 1) * 100 + 58: TT = CVS(A1$): CLOSE #1: IF (T = 5 OR T = 6 OR T = 10) AND TT <> 0 THEN PRETR = 1 8769 RETURN 8770 LOCATE 24, 13, 0: PRINT "Free cuvet.": LOCATE 25, 16: PRINT 64 - PAR(34); : FRECU = 1: RETURN 8796 IF MULTI THEN PAR(40) = PAR(40) + 1 8797 RETURN 8800 RETURN 8850 IF MULTI = 0 THEN 6726 8851 IF SEC = 0 THEN 8852 ELSE GOTO 8856 8852 IF NR = 0 THEN NR = K1(26): GOTO 8860 8854 IF NR <> K1(26) THEN NRS = 1: GOSUB 11020 8856 IF SEC4 = 0 THEN 8860 ELSE GOT㐞O 11000 8860 ATE = K1(59): MAS = 240: GOSUB 8890: IF CIS THEN 11030 8862 ATE = K1(59): MAS = 15: GOSUB 8890: IF CIS THEN 11030 8864 ATE = K1(60): MAS = 240: GOSUB 8890: IF CIS THEN 11030 8866 ATE = K1(60): MAS = 15: GOSUB 8890: IF CIS THEN 11030 ELSE 11000 8890 RF = ATE AND MAS: IF RF = 0 THEN 8900 8891 IF MAS = 240 THEN RF = RF / 16 8892 IF (CONRF AND 2 ^ RF) THEN CIS = 1 ELSE CONRF = CONRF OR 2 ^ RF 8900 RETURN 8980 RETURN 8990 PROCH = PAR(37 + UR) + 1: IF PROCH = 5 THEN PROCH = 1 8991 IF (PAR(㐞35) AND 2 ^ (PROCH - 1 + (8 * (UR - 1)))) = 0 THEN PROCH = 0: GOTO 8993 8992 IF (PAR(36) AND 2 ^ (PROCH - 1 + (8 * (UR - 1)))) THEN PROCH = 0 8993 ANC = PAR(37 + UR): PAR(37 + UR) = PROCH: RETURN 9000 IF VER% >= 32 THEN GOSUB 2960 ELSE POINTEUR = PAR(11 + METCO) 9005 PAR(37 + METCO) = POINTEUR: RETURN 9050 IF LIEU THEN GOTO 9065 9055 IF PL(I) THEN I = I + 1: RETURN 9057 IF PRETR THEN PL(I) = 251: PL(I - 16) = 255: PRINT X$: K$ = RIGHT$(STR$(I - 16), LEN(STR$(I - 16)) - 1): LOCATE I - 13, 21: PRINT "D㐞.C"; K$: PLP(I) = 255: PLP(I - 16) = I: I = I + 1: RETURN 9060 PL(I) = 251: PRINT X$: IF MULTI = 0 THEN LOCATE L, C + 20: PRINT "*": PLM(I) = PLM(I) OR 2 ^ 0: I = I + 1: RETURN ELSE LIEU = LIEU + 1: RETURN 9065 IF PL(I) = 0 THEN IB = 0: RETURN 9070 IF (PLPM(I) AND 2 ^ (LIEU - 1)) THEN LIEU = LIEU + 1: RETURN 9075 PLM(I) = PLM(I) OR 2 ^ (LIEU - 1): LOCATE L, C + 1: PRINT "*"; : LIEU = LIEU + 1: RETURN 9100 IF REPORT AND LIEU = 0 THEN 7485 9102 IF PL(I) < 250 AND PL(I) <> 0 AND LIEU THEN 7485 ELSE IF PR㐞ETR THEN GOSUB 9050: GOTO 7980 9105 IB = I: GOSUB 9050: IF IB <> I THEN 7980 9106 IF LIEU > NBM THEN 7980 ELSE L = I - PAGE - 13: C = 16 + (LIEU * 7): LOCATE L, C - 1, 1: PRINT " "; : GOTO 9105 9150 IF TXT = 1 OR NOCALI THEN GOSUB 9152: RETURN ELSE A1$ = "Start": A2$ = "F8": GOSUB 9155: RETURN 9152 A1$ = SPACE$(6): A2$ = " ": GOSUB 9155: RETURN 9155 COLOR 5, 0: LOCATE 24, 4, 0: PRINT A1$: LOCATE 25, 6, 0: PRINT A2$; : COLOR 1, 2: RETURN 9160 IF PASSAG = 0 THEN 9172 9161 IF (VER% >= 16) AND (PAR(34) 㐞= 0) THEN 9173 9162 IF PAR(40) AND (VER% < 32) THEN 9172 9163 IF PAR(37) = 4 THEN 9172 9164 IF PAR(34) = 64 THEN RETURN 9165 IF PAR(37) = 0 THEN 9173 9170 GOSUB 9180: IF MID$(R$, 6, 1) = "1" THEN 9173 9172 AFST = 0: RETURN 9173 AFST = 1: GOSUB 9150: RETURN 9175 GOSUB 9180: IF VAL(MID$(R$, 11, 2)) > 50 THEN PLUS = .1 ELSE PLUS = 0 9176 LOCATE 23, 64, 0: TEMPER! = VAL(MID$(STR$(VAL(MID$(R$, 8, 4)) + PLUS), 2, 4)): IF TEMPER! > 0 THEN PRINT USING "##.#"; TEMPER!: TEMPER$ = MID$(STR$(TEMPER!), 2, 4): R㐞ETURN ELSE RETURN 9180 RETURN 'Q$ = "DST": GOSUB 2023: RETURN 9190 IF PAR(37) = 0 THEN RETURN ELSE IF PAR(50) = 0 AND PAR(51) = 0 THEN RETURN 9191 IF PASSAG = 0 THEN RETURN 9197 GOSUB 5130: FOR T = 20 TO 21: GET #1, (MUL(COL) - 1) * 100 + T: RDX(T - 19) = CVS(A1$): NEXT T: CLOSE #1 9198 IF PAR(50) <> RDX(1) OR PAR(51) <> RDX(2) THEN COL = 0 9199 RETURN 9240 COLOR 5, 0: VIEW PRINT 1 TO 21: CLS : VIEW PRINT 9250 COLOR 1, 2: VIEW PRINT 3 TO 19: CLS : VIEW PRINT 9260 VIEW PRINT 22 TO 25: CLS : VIEW PRI㐞NT 9270 COLOR 5, 0: FOR T = 23 TO 25: LOCATE T, 1: PRINT SPACE$(11); : LOCATE T, 70: PRINT SPACE$(11); : NEXT T: COLOR 1, 2 9310 LOCATE 23, 32: PRINT "Instrument Status TC :" 9320 LOCATE 23, 64: PRINT USING "##.#"; VAL(TEMPER$) 9330 LOCATE 1, 1, 0: RETURN 10000 FOR T = 23 TO 25: IF K1(T) THEN NBREA = NBREA + 1 10001 NEXT T: RETURN 10050 IF RSTART <> 0 THEN RETURN 10051 COLOR 5, 0: LOCATE 20, 72: PRINT "EXIT": LOCATE 21, 73: PRINT "F7": COLOR 1, 2: RETURN 10100 L = 8: NON = 1: IF MULTI = 0 㐞THEN RESTORE 5092: GOSUB 120: GOSUB 10050: GOTO 10142 10102 IF SEC = 0 AND SEC3 = 0 AND (SEC1 <> 0 AND CAL = 1) THEN RESTORE 5092 ELSE RESTORE 5112 10105 GOSUB 120: GOSUB 10050: GOSUB 6465 10110 IF BNRS = 1 THEN L = L + 1: EFF = EFF + 1: LOCATE L, 1: PRINT "Warning : Reagent tray numbers conflict ( F1 )" 10120 IF BCIS = 1 THEN L = L + 1: EFF = EFF + 1: LOCATE L, 1: PRINT "Warning : Reagent positions conflict ( F1 )" 10130 IF NREA = 1 THEN L = L + 1: EFF = EFF + 1: LOCATE L, 1: PRINT "Warni㐞 ng : Reagent numbers " 10142 IF CAL = 1 THEN NOCALI = 1: L = L + 1: LOCATE L, 1: PRINT "Warning : No calib. in memory" ELSE 10150 10145 IF MULTI = 0 THEN 10150 ELSE CO = 32: LOCATE L, 38: PRINT "(method:"; : FOR T = 1 TO KN: IF T > 6 THEN CO = CO + 7: LOCATE L + 1, CO 10146 PRINT LEFT$(B$(TCAL(T)), 6); : IF T <> KN THEN PRINT ","; 10147 NEXT T: PRINT ")" 10150 L = L + 2: LOCATE L, 5: IF MULTI = 0 OR ((CAL = 1 OR SEC1 <> 0) AND SEC = 0 AND SEC3 = 0) THEN IF (CAL = 1 OR SEC1 <> 0㐞) THEN PRINT "Press enter" ELSE FI = 1: GOTO 6740 ELSE PRINT "Press enter to ignore" 10155 LOCATE , , 0: GN = L: GOSUB 601 10160 ENTREE = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128: GOSUB 740: IF F$ = CHR$(13) THEN 10190 10170 ON REPO + 1 GOTO 10160, 10180, 10160, 10160, 10160, 10160, 10160, 11205, 10160, 10160, 10190 10180 IF MULTI = 0 THEN 10160 ELSE VER% = 7: IND = 1: GOSUB 6500: GOTO 7950 10190 L = 8: FOR T = 1 TO EFF: L = L + 1: LOCATE L, 46: PRINT SPACE$(6): NEXT T: LOCATE GN, 5: PRINT SPACE$(35): GOSUB 㐞11200: FI = 1: GOSUB 8765: NON = 1: GOSUB 120: GOTO 6740 10192 GOSUB 8765: RETURN 11000 IF NBREA > 8 THEN NREA = 1: SEC1 = 1: GOTO 6726 ELSE 6726 11020 BNRS = 1: SEC = 1: GOTO 11000 11030 BCIS = 1: SEC3 = 1: GOTO 11000 11100 IF K1(33) THEN RETURN 11110 IF (K1(6) = 3) OR (K1(6) = 4) THEN RETURN 11120 GOSUB 5132 11130 GET #1, 33: DAT$ = A1$: DATTE$ = MID$(DAT$, 1 + (M% - 1) * 4, 4) 11140 MJ = CVI(LEFT$(DATTE$, 2)) 11150 IF MJ <> 0 THEN CLOSE #1: RETURN ELSE CAL = 1: CALB = 1: KN = KN + 1: TCAL(KN) =㐞 M%: CLOSE #1: RETURN 11200 IF CAL = 1 THEN LOCATE GN, 1, 0: PRINT "F1:All Calib F2 or F3:Samples + Standards of meth. without historical calib.": RETURN ELSE RETURN 11205 IF RSTART = 0 THEN GOSUB 5240: GOTO 6524 ELSE 10160 11210 IF MULTI = 0 THEN GOSUB 11100: RETURN ELSE FOR T = 1 TO 8: IF MUL(T) <> 0 THEN M% = MUL(T): GOSUB 5164: GOSUB 11100: NEXT T 11215 M% = MUL(1): GOSUB 5160: M% = MULTI: RETURN 30000 OPEN "r", #1, "NAMETH", 105 30010 FIELD #1, 6 AS A1$, 6 AS D$, 32 AS A2$, 32 AS A3$, 6 AS U1$,㐞 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$ 30020 FOR I = 1 TO 32 30030 GET #1, I 30040 B$(I) = A1$: MTT$(I) = A3$ 30050 NEXT I: CLOSE #1: RETURN : IF CIS THEN 11030 8866 ATE = K1(60): MAS = 15: GOSUB 8890: IF CIS THEN 11030 ELSE 11000 8890 RF = ATE AND MAS: IF RF = 0 THEN 8900 8891 IF MAS = 240 THEN RF = RF / 16 8892 IF (CONRF AND 2 ^ RF) THEN CIS = 1 ELSE CONRF = CONRF OR 2 ^ RF 8900 RETURN 8980 RETURN 8990 PROCH = PAR(37 + UR) + 1: IF PROCH = 5 THEN PROCH = 1 8991 IF (PAR(㐞1 ' ******************************************************** 2 ' * MAINCP VERSION 2.4 + 3.0 * 3 ' * Descp + Maincp + chang disq + validation 25/10/88 * 4 ' * redil en rem * 5 ' * nouvelle gestion de l'absorb 16 ou 64 methodes * 6 ' * securisation des touche delete/abort etc... * 7 ' * Mise en service du handcheck avec up0 * 8 ' ******************************************㐞************** 10 DEFINT A-J, L-P, R-U, W-Z 11 DIM L(5), C(5), ENR$(4) 15 DIM P64(64), LE(48), PLACE(48), PAR(60), B$(32), MTT$(32), PL(50), PLP(48), PLM(48), PLPM(48), NMLI$(32), NAMET$(34), METO1$(64) 20 DIM K1(100), P2(48), P3!(48), PRES(48), PLS(50), PLA(48), NOM$(128) 25 COMMON STATUS, METH, P64(), LE(), PLACE(), O1!, C1!, O2, C2, AIG1, AIG3, PAR(), M, M1, RE, VER%, BUT, PAS, PA$, LIGNE, METP, DEMET, LIMI, NONL$, TEMPER$, DATEF$ 30 LPRINT "in maincp": GOSUB 30000: GOSUB 375: F9% = 2 ^ 8: IF BUT =㐞 100 THEN GOSUB 4010: GOTO 6000 31 FONCT = 254: GOSUB 400: GET #1, 52: PAR(52) = CVI(P1$): GET #1, 53: PAR(53) = CVI(P1$): CLOSE #1: IF PAR(52) = 0 THEN PAR(53) = 0 32 GOSUB 470: FOR ET% = 1 TO CINT((O2 / 16) + .05): GET #1, ET%: EN$ = A1$: FOR ER% = 0 TO 15 33 EN% = CVI(MID$(EN$, 1 + (6 * ER%), 2)) 34 IF (ER% + 16 * (ET% - 1) < PAR(53)) AND (EN% <> 0) THEN GOSUB 150: GOTO 50 35 'IF (ER% >= 16*(ET%-1)-PAR(53)) AND EN%=0 AND (16*(ET%-1)+ER%+1 < PAR(52)) THEN GOSUB 150 36 VIDE = 1: MEVALID = 0: PRIM% = 㐞(((ET% - 1) * 16 + ER%) * 48) + 5: FOR IN% = PRIM% TO PRIM% + 47 38 GET #1, IN% 39 IF PA$ = "" OR PA$ = "REBOOT" THEN 40 ELSE ECH = ASC(MID$(A1$, 1, 1)): IF VIDE = 0 THEN 40 ELSE IF ECH <> 0 THEN VIDE = 0 40 IF AVALID = 1 THEN 45 ELSE ASS = ASC(MID$(A1$, 2, 1)) 41 IF ASS > 0 AND ASS < 254 THEN AVALID = 1: MEVALID = 1 43 IF AVALID = 1 AND (PA$ = "" OR PA$ = "REBOOT") THEN IN% = PRIM% + 47: ER% = 15: ET% = CINT((O2 / 16) + .05) 45 NEXT IN% 48 'IF (VIDE=1 AND EN%<>0 AND (PA$<>"" AND PA$<>"REBOOT")) OR (㐞 VIDE=0 AND EN%=0 AND (PA$<>"" AND PA$<>"REBOOT")) THEN GOSUB 150 49 IF ((ET% - 1) * 16) + ER% + 1 > PAR(52) THEN ER% = 15: ET% = CINT((O2 / 16) + .05) 50 NEXT ER%: NEXT ET% 60 IF PAR(52) <> 0 AND AVALID <> 1 THEN GOSUB 160: LIGNE = 0 70 CLOSE : COLOR 1, 2: CLS : MA% = 0: IF (PA$ = "" OR PA$ = "REBOOT") THEN 80 72 TEXT = PAR(41 + (PAR(16) - 1) * 4 + PAR(37 + PAR(16))) AND 255 75 IF (PAR(52) <> 0 AND AVALID = 1) THEN 7300 76 GOTO 3040 80 GOSUB 4010 85 GOTO 2000 150 PRIM% = (((ET% - 1) * 16 + ER%) * 㐞48) + 5: A$ = CHR$(0) + CHR$(0) + SPACE$(96) + MKI$(0) + MKS$(0) + MKI$(0) 152 FOR IN% = PRIM% TO PRIM% + 47: LSET A1$ = A$: PUT #1, IN%: NEXT IN% 154 MID$(EN$, 1 + (ER% * 6), 6) = MKI$(0) + MKI$(0) + MKI$(0): LSET A1$ = EN$: PUT #1, ET%: RETURN 160 NBCHAM% = INT((PAR(52) + PAR(53)) / 16.0001) + 1: FOR ET% = 1 TO NBCHAM%: FOR ER% = 0 TO 15 162 IF ((ET% - 1) * 16) + ER% > (PAR(52) + PAR(53)) THEN ER% = 15: ET% = NBCHAM%: GOTO 164 163 GOSUB 150 164 NEXT ER%: NEXT ET% 165 PAR(52) = 0: PAR(53) = 0: CLOSE㐞 #1: GOSUB 8830: GOSUB 470: RETURN 168 SPA$ = "": FOR IN% = 1 TO 128: SPA$ = SPA$ + CHR$(0): NEXT IN%: GOSUB 1997 170 GOSUB 300: GOTO 195 'IF PAR(21) AND CHANGEDATE=1 THEN GOSUB 430:LSET CHAMP$=SPA$:PUT#3,1:PUT#3,2:CLOSE#3 ELSE IF PAR(21) THEN 225 ELSE GOSUB 300:GOTO 195 172 'GOSUB 173:GOTO 178 173 KL$ = "": FOR IN% = 1 TO 20: KL$ = KL$ + MKI$(0) + MKS$(0): NEXT IN% 174 CV$ = SPACE$(42): BN$ = MKI$(0): FG$ = MKI$(0) + MKI$(0) + MKI$(0) 176 WE$ = "": FOR IN% = 1 TO 3: WE$ = WE$ + MKI$(0) + MKS$(0): NEX㐞T IN%: RETURN 178 'TOTAL$=SPACE$(12)+BN$+BN$+BN$+BN$+KL$+FG$+WE$+CV$ 182 'GOSUB 440:FOR IN%=1 TO PAR(21):LSET TT$=TOTAL$:PUT#2,IN%:NEXT IN%:CLOSE#2 195 MN$ = "": FOR IN% = 1 TO 28: MN$ = MN$ + MKI$(0): NEXT IN% 200 GOSUB 420: LSET DAT$ = MN$ + MKI$(0): PUT #1, 34: CLOSE #1'NUM UTIL 205 GOSUB 1590 225 SPA$ = "": FOR IN% = 1 TO 48: SPA$ = SPA$ + MKI$(0): NEXT IN%: GOSUB 460: GOSUB 500 235 'IF CHANGEDATE=0 OR PAR(20)<>0 THEN 255 240 'GOSUB 470:GOSUB 160:CLOSE#1 255 GOSUB 480 260 GOSUB 500 265 GOSUB 㐞485: FOR IN% = 21 TO 53: LSET T1$ = MKS$(0): PUT #1, IN%: NEXT IN%: CLOSE #1 280 GOSUB 400: FOR IN% = 4 TO 60: IF IN% = 34 AND CHANGEDATE = 0 AND O2 <> 64 THEN LSET P1$ = MKI$(64): PUT #1, 34: PAR(34) = 64: GOTO 290 282 IF IN% = 20 OR IN% = 19 OR IN% = 18 OR IN% = 58 OR IN% = 59 OR IN% = 52 OR IN% = 53 THEN 290 283 'IF IN%=21 AND CHANGEDATE=0 THEN 290 285 LSET P1$ = MKI$(0): PUT #1, IN%: PAR(IN%) = 0 290 NEXT IN%: CLOSE #1: RETURN 300 IF PAR(35) = 0 AND PAR(36) = 0 AND PAR(52) = 0 THEN RETURN'RAJ si c㐞ahier de paillasse , rien de charge au moment de la coupure 301 FOR EN% = 1 TO 128: NOM$(EN%) = MKI$(0) + MKI$(0): NEXT EN%: IF PAR(52) = 0 THEN 310 302 GOSUB 470: FOR ET% = 1 TO CINT((O2 / 16) + .05): GET #1, ET%: EN$ = A1$ 303 FOR ER% = 0 TO 15: EN% = CVI(MID$(EN$, 1 + (6 * ER%), 2)): MEM = ABS(EN%) AND 31: PRIM% = (((ET% - 1) * 16 + ER%) * 48) + 5: IF (EN% = 0 AND ER% >= (PAR(53) - (16 * (ET% - 1) - 1))) THEN ER% = 15: ET% = CINT((O2 / 16) + .05): GOTO 309 ELSE IF _ EN% = 0 THEN 309 304 IF MEM > 10㐞 THEN PART% = 1 ELSE PART% = 0 305 FOR IN% = PRIM% TO PRIM% + 47 306 GET #1, IN%: IND = ASC(MID$(A1$, 2, 1)): IF IND > 250 THEN 308 ELSE IF IND = 0 THEN 308 307 LL = CVI(MID$(NOM$(IND), 1 + (2 * PART%), 2)): LL = LL OR 2 ^ (MEM - ((10 * PART%) + 1)): MID$(NOM$(IND), 1 + (2 * PART%), 2) = MKI$(LL) 308 NEXT IN% 309 NEXT ER%: NEXT ET%: CLOSE #1 310 GOSUB 430: GET #3, 1: DECRI$ = CHAMP$: CLOSE #3: GOSUB 440'sauve cahier de paill. 312 FOR IN% = 1 TO PAR(20): ENR = ASC(MID$(DECRI$, IN%, 1)): IF ENR = 0 THE㐞N PAR(20) = IN% - 1: GOTO 351 ELSE GET #2, ENR 313 GET #2, ENR: TOU$ = TT$: LAN1 = CVI(MID$(TOU$, 17, 2)): LAN2 = CVI(MID$(TOU$, 19, 2)): P2$ = MID$(TOU$, 21, 120): IF LAN1 = 0 AND LAN2 = 0 THEN 350 ELSE IF LAN1 = 0 THEN 330 315 FOR ER% = 0 TO 9: IF (LAN1 AND 2 ^ ER%) = 0 THEN 325 320 P2 = CVI(MID$(P2$, (1 + (6 * ER%)))): LL = CVI(MID$(NOM$(IN%), 1, 2)): IF (P2 AND 1) = 0 AND (LL AND 2 ^ ER%) = 0 THEN LAN1 = LAN1 XOR 2 ^ ER%'remis non en cours si pas de result et pas ds absorb 325 NEXT ER%: IF LAN2 = 0 㐞THEN 345 330 FOR ER% = 0 TO 9: IF (LAN2 AND 2 ^ ER%) = 0 THEN 340 335 P2 = CVI(MID$(P2$, (1 + (6 * (ER% + 10))))): LL = CVI(MID$(NOM$(IN%), 3, 2)): IF (P2 AND 1) = 0 AND (LL AND 2 ^ ER%) = 0 THEN LAN2 = LAN2 XOR 2 ^ ER% 340 NEXT ER% 345 MID$(TOU$, 17, 2) = MKI$(LAN1): MID$(TOU$, 19, 2) = MKI$(LAN2): LSET TT$ = TOU$: PUT #2, ENR 350 NEXT IN% 351 CLOSE #2: GOSUB 400: LSET P1$ = MKI$(PAR(20)): PUT #1, 20: CLOSE #1: RETURN 355 GOSUB 410: FOR IN% = 1 TO 32: GET #1, IN%: IF IN% > 20 AND IN% < 29 THEN 365 㐞 360 B$(IN%) = A1$: GOTO 370 365 MTT$(IN%) = A3$ 370 NEXT IN%: CLOSE #1: RETURN 372 GOSUB 400: FOR IN% = 1 TO 60: LSET P1$ = MKI$(PAR(IN%)): PUT #1, IN%: NEXT IN%: CLOSE #1: RETURN 375 GOSUB 405 380 GET #1, 1: IF NM$ = "A" OR NM$ = "B" THEN O2 = 16 ELSE IF NM$ = "C" OR NM$ = "D" THEN O2 = 8 ELSE IF NM$ = "H" OR NM$ = "J" OR NM$ = "K" THEN O2 = 64 385 CLOSE #1: RETURN 390 IF PAR(1) = 0 THEN PAR(1) = 550 391 IF PAR(2) = 0 THEN PAR(2) = 575 392 IF PAR(3) = 0 THEN PAR(3) = 630 393 GOSUB 372 395 IF PAR㐞(16) THEN METH = PAR(7 + PAR(16)): STATUS = 8'IF PAR(16)=1 THEN METH=PAR(8):STATUS=8 'recherche de STATUS 396 'IF PAR(16)=2 THEN METH=PAR(9):STATUS=8 397 GOSUB 482: LSET E$ = MKI$(0) + SPACE$(21): PUT #1, 1: CLOSE #1 398 RETURN 400 OPEN "r", #1, "pargen", 2: FIELD #1, 2 AS P1$: RETURN 405 OPEN "r", #1, "id", 1: FIELD #1, 1 AS NM$: RETURN 406 OPEN "r", #1, "B:id", 1: FIELD #1, 1 AS NM$: RETURN 410 OPEN "r", #1, "nameth", 105 415 FIELD #1, 6 AS A1$, 6 AS D$, 32 AS A2$, 32 AS A3$, 6 AS U1$, 6 AS U2$, 㐞1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$: RETURN 420 OPEN "r", #1, "nameth", 105: FIELD #1, 105 AS DAT$: RETURN 430 OPEN "r", #3, "descpai", 128: FIELD #3, 128 AS CHAMP$: RETURN 440 OPEN "r", #2, "paille", 206: FIELD #2, 206 AS TT$: RETURN 450 OPEN "r", #1, FIL$, 14: FIELD #1, 14 AS F1$: RETURN 455 OPEN "r", #1, FIL$, 14: FIELD #1, 2 AS F1$, 2 AS F2$, 2 AS F3$, 2 AS F4$, 2 AS F5$, 2 AS F6$, 2 AS F7$: RETURN 460 OPEN "r", #1, "cyclec", 96: FIELD #1, 96 AS FF$: RETURN 470 OPEN "r", #1, "absorb㐞", 106: FIELD #1, 106 AS A1$: RETURN 480 OPEN "r", #1, "plac", 96: FIELD #1, 96 AS FF$: RETURN 482 OPEN "r", #1, "erreur", 23: FIELD #1, 23 AS E$: RETURN 485 OPEN "r", #1, "temper", 4: FIELD #1, 4 AS T1$: RETURN 487 OPEN "R", #1, "PRINTER", 2: FIELD #1, 2 AS E$: RETURN 490 DATA tray11,tray12,tray13,tray14,tray21,tray22,tray23,tray24 495 OPEN "R", #2, "CONFIG.HAR", 9: FIELD #2, 9 AS X$: RETURN 500 FOR IN% = 1 TO 4: LSET FF$ = SPA$: PUT #1, IN%: NEXT IN%: CLOSE #1: RETURN 510 IF INP(&H22) AND 32 THEN 㐞CLS : LOCATE 12, 33, 0: PRINT "PRINTER FAULT": A$ = "" ELSE 515 512 A$ = INKEY$: IF A$ = "" THEN 515 515 GOSUB 487: GET #1, 1: IF EOF(1) THEN 516 ELSE PRN% = CVI(E$): GOTO 520 516 A$ = "": CLS : LOCATE 12, 15, 1: PRINT "PRINTER 1 = EPSON 2=SEIKO "; 517 A$ = INKEY$: IF A$ = CHR$(49) OR A$ = CHR$(50) THEN PRINT A$: PRN% = VAL(A$) - 1 ELSE IF A$ = "" THEN 517 ELSE 516 518 LOCATE , , 0: LSET E$ = MKI$(PRN%): PUT #1, 1 520 CLOSE #1: CALL COP(PRN%): RETURN 525 RETURN 'QP$ = "RTE": GOSUB 1470: RETURN 㐞550 DAT% = 1: CIM% = 8: DEV% = 52: RET% = 0: GOSUB 575'1 stop bit 560 DAT% = 2: CIM% = 9: GOSUB 575 'parite paire 565 CIM% = 3: GOSUB 575: CIM% = &H1C: GOSUB 575: CIM% = &H1D: GOSUB 575: RETURN'sio+flush 575 RETURN 'CALL IO(DEV%, CIM%, DAT%, RET%): RETURN 580 RETURN 'CALL IO(DOV%, CIM%, DAT%, RET%): RETURN 800 IF RIGHT$(DATE$, 4) = "1980" THEN LOCATE 12, 29, 0: PRINT "PLEASE PRESS TIME/DATE": GOTO 800 ELSE RETURN 810 LOCATE 12, 20: PRINT SPACE$(50): RETURN 850 IN% = 1 'w i/o 852 CIM㐞% = &H10: GOSUB 575 ': IF RET% = 0 THEN 852 855 ' = ASC(MID$(QP$, IN%, 1)): CIM% = 1: DAT% = CHAR: GOSUB 575 860 'IN% = IN% + 1: IF CHAR <> 10 THEN 855 ELSE RETURN 870 CPT = 0: R$ = "": DEV% = 52: CIM% = &HC: DAT% = 0: GOSUB 575: CIM% = 2: DAT% = 0'r i/o 875 'GOSUB 575: CHAR = RET%: IF CHAR = -1 THEN 875 ELSE R$ = R$ + CHR$(CHAR) 880 'IF CHAR <> 10 THEN 875 ELSE IF LEFT$(QP$, 3) <> LEFT$(R$, 3) AND CPT < 6000 AND CPTI = 0 THEN CPT = CPT + 1: R$ = "": GOTO 875 ELSE DEV% = 52: CIM% = &HC: DAT% = 1: GOSUB㐞 575: RETURN 885 RETURN 'QUIN = VAL(MID$(R$, 5, 5)): RETURN 890 PO = 1: RETURN 900 DATA DEP0,1,STO,1,IND,1,HALT1,2,HALT2,2,HALT3,2,OUD,1,VER,7,IND,1,UP1S,8,UP2S,8,UP3S,8,INIT2,3,INIT1,3,INIT3,3,"AMOR:4",3,SECU,5,OUD,1,R5V,4,R15,4,M15,4,R24,4,R35,4,RTE,6 910 RESTORE 900 960 TEST = TEST + 1: READ T$: READ W$ 965 DE = DE + 1 970 FOR K = 1 TO 1000: NEXT K: QP$ = T$: GOSUB 1470 980 ON VAL(W$) GOTO 990, 1000, 1020, 1200, 1000, 990, 990, 1000 985 REP$ = LEFT$(T$, 3): GOSUB 987: RETURN 986 REP$ = "@" + LE㐞FT$(T$, NB): GOSUB 987: RETURN 987 IF LEFT$(R$, NBR) <> REP$ THEN ER = 1: RETURN ELSE ER = 0: RETURN 990 NBR = 3: GOSUB 985: IF ER AND DE = 2 THEN GOSUB 1130: GOTO 995 ELSE IF ER THEN 1110 ELSE IF W$ = "6" THEN GOSUB 1290: GOTO 1120 ELSE IF W$ = "7" THEN 1300 ELSE 1120 995 IF W$ = "7" THEN 1300 ELSE 1120 1000 NB = 3: NBR = 4: GOSUB 986: IF ER AND DE = 2 THEN GOSUB 1130: GOTO 1010 ELSE IF ER THEN 1110 ELSE IF W$ = "5" THEN SEC$ = RIGHT$(R$, 8): GOSUB 1270: GOTO 1120 1010 IF W$ = "8" THEN 1320 ELSE 1120 㐞  1020 NB = 2: NBR = 3: GOSUB 986: IF ER AND DE = 2 THEN GOSUB 1130: GOTO 1120 ELSE IF ER THEN 1110 1030 GOSUB 870: GOSUB 985: IF ER THEN 1110 ELSE 1120 1110 IF DE = 1 THEN 965 1120 IF TEST = 24 THEN 1396 ELSE ER = 0: DE = 0: GOTO 960 1130 IF PU THEN RETURN ELSE PU = 1: RETURN 1140 IF MID$(T$, 5) <> "" THEN PO = 1: RETURN ELSE RETURN 1200 NBR = 3: GOSUB 985: IF ER AND DE = 2 THEN GOSUB 1130: TR = TR + 1: GOTO 1120 ELSE IF ER THEN 1110 ELSE TR = TR + 1 1210 ON TR GOTO 1220, 1230, 1240, 1250, 1260 1220㐞 GOSUB 885: IF QUIN < 4.5 OR QUIN > 5.5 THEN GOSUB 890: GOTO 1120 ELSE 1120 1230 GOSUB 885: IF QUIN < 13.5 OR QUIN > 16.5 THEN GOSUB 890: GOTO 1120 ELSE 1120 1240 GOSUB 885: IF QUIN < 13.5 OR QUIN > 16.5 THEN PO = 1: GOTO 1120 ELSE 1120 1250 GOSUB 885: IF QUIN < 23 THEN GOSUB 890: GOTO 1120 ELSE 1120 1260 GOSUB 885: IF QUIN < 21.6 OR QUIN > 26.4 THEN GOSUB 890: GOTO 1120 ELSE 1120 1270 FOR SEC = 1 TO 6: IF MID$(SEC$, SEC, 1) = "1" THEN 1272 1271 NEXT SEC: RETURN 1272 ON SEC GOTO 1271, 1276, 1278, 128㐞0, 1282, 1284 1274 PO = 1: GOTO 1271 1276 TY = 40: GOTO 1288 'Over Heat Lamp 1278 TY = 17: GOTO 1288 'Full Waste 1280 TY = 18: GOTO 1288 'Low Pre-Fill 1282 TY = 31: GOTO 1288 'Main Cover 1284 TY = 16 'Dilutor Cover 1288 GOSUB 482: GET #1, TY: CLOSE #1: PO = 1: GOTO 1271 1290 TEM! = VAL(MID$(R$, 5, 5)): IF TEM! < 20 THEN PO = 1: RETURN ELSE RETURN 1300 LL = 1: IF ER AND DE = 2 THEN VER$ = "---" ELSE VER$ = MID$(R$, 4, LEN(R$) - 5) 1315 LOCATE 1, 60, 0: PRINT "Version " + CHR$(230) + "P 㐞0 : " + "SOAK": ER = 0: DE = 0: GOTO 960 1320 IF ER AND DE = 2 THEN VER$ = "---" ELSE D$ = LEFT$(R$, (LEN(R$) - 2)): VER$ = MID$(D$, 6) 1325 LL = LL + 1: LOCATE LL, 69: PRINT CHR$(230) + "P"; LL - 1; ": "; "TEST" 1326 IF TEST = 12 THEN 1328 ELSE ER = 0: DE = 0: GOTO 960 1328 LOCATE 5, 69: PRINT "Disk : "; : ER = 0: DE = 0 1330 GOSUB 405: FOR ER% = 4 TO 8: GET #1, ER%: PRINT NM$; : NEXT ER%: CLOSE #1: GOTO 960 1380 RETURN ' QP$ = "STO": GOSUB 1470: RETURN 1390 RETURN 'QP$ = "IND": GOSUB 1470: RETURN 㐞1395 RETURN 'QP$ = "OUD": GOSUB 1470: RETURN 1396 IF PO OR PU THEN GOSUB 9990: LOCATE 12, 27: PRINT "STRIKE ANY KEY TO CONTINUE" ELSE RETURN 1397 IF INKEY$ <> "" THEN RETURN ELSE GOTO 1397 1400 LOCATE 12, 24, 0: PRINT "TEMPERATURE 30C (Press enter) "; 1405 FOR K = 1 TO 1400: C$ = INKEY$: IF C$ <> "" THEN 1410 ELSE NEXT K: GOTO 1430 1410 IF C$ = CHR$(13) THEN RETURN 1430 RETURN 'GOSUB 1390: QP$ = "HEAT:" 1440 'QP$ = QP$ + "2" 1450 'GOSUB 1470 1460 'GOSUB 1390: RETURN 1470 RETURN 'QP$ = QP$ + 㐞CHR$(13) + CHR$(10): GOSUB 850: GOSUB 870: RETURN 1500 GOSUB 420: GET #1, 33: ENREG$ = DAT$: ANCDAT$ = MID$(ENREG$, 81, 10): CLOSE #1 1510 IF DATE$ <> ANCDAT$ THEN CHANGEDATE = 1'GOSUB 168:GOTO 1515 1512 'GOSUB 1997 1513 GOSUB 168 1515 GOSUB 420: GET #1, 33: ENREG$ = DAT$ 1520 MID$(ENREG$, 81, 10) = DATE$: LSET DAT$ = ENREG$: PUT #1, 33: ' mise a date du jour 1522 GET #1, 34: ENT$ = DAT$: MID$(ENT$, 57, 2) = MKI$(0): LSET DAT$ = ENT$: PUT #1, 34 1525 CLOSE #1: RETURN 1550 PAR(35) = PAR(35) XOR PAR(㐞36) 1552 FOR IN% = 22 TO 33: PAR(IN%) = 0: NEXT IN%: PAR(36) = 0: PAR(37) = 0 1553 FOR IN% = 40 TO 51: PAR(IN%) = 0: NEXT IN%: PAR(55) = 0: PAR(56) = 0: PAR(57) = 0: PAR(17) = 0 1554 FOR METCO = 1 TO 2 1555 IF METCO = 1 THEN OCC = 255 ELSE OCC = 32512 1557 IF (PAR(35) AND OCC) THEN 1570 1559 PAR(7 + METCO) = 0: PAR(9 + METCO) = 0: PAR(11 + METCO) = 0: PAR(13 + METCO) = 0 1560 PAR(17 + METCO) = 0 1570 NEXT METCO 1575 METCO = PAR(16): IF (PAR(METCO)) AND (METCO <> 0) THEN 1580 1577 IF PAR(7 + (3 - M㐞ETCO)) THEN PAR(16) = PAR(7 + (3 - METCO)) ELSE PAR(16) = 0 1580 GOSUB 1590: RETURN 1590 'PAR(21)=0:GOSUB 400:LSET P1$=MKI$(0):PUT#1,21:CLOSE#1 'mise a 0 de par(21) 1591 RESTORE 490: F$ = MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) 1592 FOR I = 1 TO 8: READ FIL$: GOSUB 450 1593 FOR IN% = 1 TO 50: LSET F1$ = F$: PUT #1, IN%: NEXT IN%: CLOSE #1: NEXT I: RETURN 1700 GOSUB 400: FOR IN% = 1 TO 60: GET #1, IN%: PAR(IN%) = CVI(P1$): NEXT IN%: CLOSE #1 1710 GOSUB 410: FOR IN% = 1 TO 3㐞2: GET #1, IN%: B$(IN%) = A1$: MTT$(IN%) = A3$: IF IN% > 20 AND IN% < 29 THEN 1711 ELSE 1712 1711 NMLI$(IN%) = A2$ 1712 NEXT IN%: CLOSE #1: RETURN 1800 IF PAR(34) AND O2 <> 64 THEN GOSUB 1820 1810 RETURN 1820 CLS : GOSUB 3990: LOCATE 12, 22, 0: PRINT "VERIFY CUVETTES . THEN PRESS ENTER" 1821 'QP$ = "IND": GOSUB 1470 1822 'QP$ = "HALT1": GOSUB 1470 1825 A$ = INKEY$: IF A$ <> CHR$(13) THEN 1825 1830 PAR(34) = 0: GOSUB 1997: RETURN 1997 CLS : LOCATE 12, 33, 0: PRINT " LOADING": RETURN 2000 GOSUB 5㐞 10 'test printer 2005 CLS : IF PA$ = "REBOOT" THEN CPTI = 1: GOSUB 550: GOTO 2075 ELSE GOSUB 550: LOCATE 1, 1, 0: PRINT "I/O Initialization"'**** pgm 2010 LOCATE 1, 36: PRINT "I/O Test" 2020 CPTI = 1: GOSUB 910'roms version 2030 GOSUB 1400: GOSUB 810 'demande temperature 2070 GOSUB 800 'test date ,eff. pour simulation 2075 GOSUB 15000 2080 GOSUB 1700 'lect pargen+nameth 2090 GOSUB 1500 'raz files si chg date+DATE 2100 GOSUB 1800 'chg cuves 2105 GOSUB 390 'RAJ PARGEN+STATUS 2107 GOSUB 355: CPTI㐞 = 0'lecture nom meth 3000 '******************************************************** 3010 '* MAINCP * 3020 '******************************************************** 3030 IF PAR(52) <> 0 THEN 7300 3040 GOSUB 5320 ' cadre 3045 GOTO 4830 'vers prog. 3050 LOCATE 24, 27: PRINT SPACE$(29): LOCATE 25, 27: PRINT SPACE$(29); : RETURN'eff. prog. 3060 C = 33 - INT(LEN(PA$) / 2): GOSUB 3990'temporaire,deblocage clavier 3070 GOSUB 3980: GOSUB 4040: CLOSE #1, #2, #3㐞 : VFREE = FRE(""): CHAIN PA$ 3080 READ A$ 'aff. 3090 IF LON = 0 THEN 3120 3100 IF A$ = "" THEN A$ = " " 3110 N = INT(LEN(A$) / 2): RETURN 3120 PRINT A$; : LON = 0: RETURN 3130 GOSUB 4010: COLOR 5, 0: LOCATE 1, 20, 0: PRINT SPACE$(40): LOCATE 2, 30: PRINT SPACE$(22): COLOR 1, 2 3140 GOSUB 4040: COLOR 5, 0: C1 = 5 3150 FOR I = 1 TO 7 3160 READ A$: CUR = 11 * (I - 1) + INT(.4 * I) 3170 IF I > 1 THEN LOCATE 20, 2 + CUR ELSE LOCATE 20, 1 + CUR 3180 A3$ = SPACE$(5 - LEN(A$) / 2) + A$: A$ =㐞 A3$ + SPACE$(10 - LEN(A3$)): PRINT A$ 3190 LOCATE 21, C1 - 2 3191 IF A$ = SPACE$(10) THEN PRINT " ": GOTO 3200 3192 IF (SUP% AND 2 ^ (I - 1)) = 2 ^ (I - 1) THEN PRINT " S F" + RIGHT$(STR$(I), 1): GOTO 3200 3193 PRINT " F" + RIGHT$(STR$(I), 1) + " " 3200 C1 = C1 + 11 + CINT(I / 2 - INT(I / 2)): NEXT I 3210 L(1) = 24: C(1) = 7: L(2) = 24: C(2) = 75: L(3) = 1: C(3) = 39: L(4) = 1: C(4) = 6: L(5) = 2: C(5) = 40 3220 FOR I = 8 TO 12: LON = 1: GOSUB 3080: LOCATE L(I - 7), C(I - 7) - N: GOSUB 3120: NE㐞 XT I 3225 IF BUT = 100 THEN A1$ = SPACE$(5): A2$ = SPACE$(11): GOTO 3240 3227 IF TEXT = 0 AND STATUS = 8 THEN STATUS = 0 3230 IF (STATUS <> 8) OR (PASSAG = 0) THEN A1$ = SPACE$(5): A2$ = SPACE$(11) ELSE A1$ = " Start ": A2$ = " F8 " 3240 LON = 1: A$ = A1$: GOSUB 3090: LOCATE 24, 1: GOSUB 3120: A$ = A2$: LOCATE 25, 1: GOSUB 3120 3250 IF STATUS <> 9 THEN A1$ = SPACE$(5): A2$ = SPACE$(11) ELSE A1$ = " Abort ": A2$ = " S F9 " 3260 LON = 1: A$ = A1$: GOSUB 3090: LOCATE 24, 70: GOSUB 312㐞 0: A$ = A2$: LOCATE 25, 70: GOSUB 3120 3270 LOCATE 2, 2: PRINT DATEF$; : LOCATE 2, 50: PRINT SPACE$(30): LOCATE 2, 50 3280 IF FILTRE = 0 OR STATUS = 0 THEN 3330 3290 'IF FILTRE=2 THEN PRINT " ";LEFT$(T$,6):GOTO 3330 'crest 3300 'IF STATUS=0 THEN PRINT SPACE$(30):GOTO 3330 3315 IF PAR(7 + PAR(16)) > 20 THEN ECR$ = "M" ELSE ECR$ = "S" 3317 IF (PAR(41 + (PAR(16) - 1) * 4 + PAR(37 + PAR(16))) AND 2 ^ 12) <> 0 THEN ECR$ = ECR$ + "R" ELSE ECR$ = ECR$ + " " 3320 PRINT ECR$; "-"; : IF PAR(7 + PAR(16)) > 20 T㐞 HEN PRINT LEFT$(MTT$(PAR(7 + PAR(16))), 6) + " Tray : " + STR$(TEXT) ELSE PRINT B$(PAR(7 + PAR(16))) + " Tray : " + STR$(TEXT) + " " 3330 COLOR 1, 2: LOCATE 3, 1 ':IF AFMETH=0 THEN 3360 3340 'IF MULTI<>0 THEN COLOR 5,0:LOCATE 2,53:PRINT B$(MULTI)+"/"+STR$(MUL(INDEX)):COLOR 1,2:GOTO 3360 3350 'COLOR 5,0:LOCATE 2,53:PRINT B$(M):COLOR 1,2 3360 SUP% = F9%: RETURN 3370 ' touches 3380 R$ = "": I = 0 3390 IF C = 81 THEN L = L + 1: C = 1 3400 LOCATE L, C 3405 GOSUB 3410: GOTO 3440 3410 COMPTEUR = 㐞 0 3420 A$ = INKEY$: IF A$ = "" THEN COMPTEUR = COMPTEUR + 1 ELSE COMPTEUR = 0 3430 IF COMPTEUR < 2 THEN 3420 ELSE RETURN 3440 A$ = INKEY$: IF A$ = "" THEN 3440 3460 IF A$ = CHR$(13) THEN J = 10: GOTO 3940 3470 IF A$ = CHR$(8) THEN 3920 3480 IF (MASK AND 1) = 0 THEN 3590 3490 IF A$ = CHR$(130) AND (FONCT AND 2 ^ 1) <> 0 THEN J = 1: IF I <> 0 THEN LOCATE L, C: PRINT SPACE$(MAX + 1): GOTO 3960 ELSE 3960 3500 IF A$ = CHR$(131) AND (FONCT AND 2 ^ 2) <> 0 THEN J = 2: GOTO 3960 3510 IF A$ = CHR$(132) AND 㐞 (FONCT AND 2 ^ 3) <> 0 THEN J = 3: GOTO 3960 3520 IF A$ = CHR$(133) AND (FONCT AND 2 ^ 4) <> 0 THEN J = 4: GOTO 3960 3530 IF A$ = CHR$(134) AND (FONCT AND 2 ^ 5) <> 0 THEN J = 5: GOTO 3960 3550 IF A$ = CHR$(135) AND (FONCT AND 2 ^ 6) <> 0 THEN J = 6: GOTO 3960 3560 IF A$ = CHR$(136) AND (FONCT AND 2 ^ 7) <> 0 THEN J = 7: GOTO 3960 3570 IF A$ = CHR$(137) AND STATUS = 8 THEN STATUS = 9: PAS = 1: GOTO 4100 3590 IF (MASK AND 2) = 0 THEN 3610 3600 IF A$ > CHR$(47) AND A$ < CHR$(58) THEN 3790 3610 IF (MAS㐞 K AND 4) = 0 THEN 3650 3620 IF I > 0 THEN 3650 3630 IF A$ = "-" THEN 3830 3640 IF A$ = "+" THEN 3830 3650 IF (MASK AND 8) = 0 THEN 3780 3660 IF ASD = 1 THEN 3780 3670 IF A$ = "." THEN ASD = ASD + 1: ROU = I: GOTO 3790 3780 LOCATE L, C + I: GOTO 3440 3790 IF I > (MAX - 1) THEN 3440 3800 IF VALMIN = 0 AND VALMAX = 0 THEN 3830 3810 Q$ = R$ + A$: IF (I + 1 = MAX AND VAL(Q$) < VALMIN) OR (MAX = 1 AND VAL(A$) < VALMIN) THEN 3440 3820 IF VAL(Q$) > VALMAX THEN 3440 ELSE 3880 3830 IF MIN$ = "" AND MAX$ =㐞 "" THEN 3880 3840 IF A$ >= MIN$ AND A$ <= MAX$ THEN 3880 ELSE 3440 3870 'IF I=0 AND FO=1 THEN LOCATE L,C:PRINT SPACE$(MAX):PRINT SPACE$(80):LOCATE L,C ELSE IF I=0 THEN LOCATE L,C:PRINT SPACE$(MAX+1):LOCATE L,C 3880 IF I = 0 THEN LOCATE L, C: PRINT SPACE$(MAX + 1): LOCATE L, C 3890 I = I + 1: R$ = R$ + A$: PRINT A$; 3900 IF (C + I) = 81 THEN C = 1: I = 1: L = L + 1 3910 LOCATE L, C + I: GOTO 3440 3920 IF I <> 0 THEN I = I - 1: R$ = LEFT$(R$, I): LOCATE L, C + I: PRINT " "; : LOCATE L, C + I: IF I = R㐞 OU THEN ASD = 0 3930 GOTO 3440 3940 IF I <> 0 AND (VALMIN <> 0 OR VALMAX <> 0) AND VAL(R$) < VALMIN THEN 3440 3950 Q = VAL(R$)'IF ((NU>27 AND NU<33) OR NU=45 OR NU=48 OR NU=54) AND R$="" THEN 3960 ELSE Q=VAL(R$) 3960 IF R$ = "+" OR R$ = "-" OR R$ = "." THEN 3440 ELSE MASK = 65: VALMIN = 0: VALMAX = 0: MIN$ = "": MAX$ = "": MAX = 6: ASD = 0 3970 RETURN 3980 DOV% = &H32: CIM% = &HF: DAT% = &HFF40: GOSUB 580: RETURN'clavier out 3990 DOV% = &H32: CIM% = &HF: DAT% = &HBF00: GOSUB 580: RETURN'clavier in 4㐞 000 CALL HAR: RETURN 'hardcopy 4010 CALL CLA(MA%, SUP%) 4020 RETURN 4030 DOV% = &H32: CIM% = 5: RET% = 0: GOSUB 580: RETURN'clavier vide 4035 'cALL ABC:RETURN 'vidage clavier 4040 VIEW PRINT 3 TO 19: CLS : VIEW PRINT: RETURN'effacement 4050 'chain 4060 PA$ = "workcp": GOTO 3060'cahier paillasse 4070 PA$ = "mathcp": GOTO 3060'mathematiques 4080 GOTO 5040 ' temporaire PA$="urgst":GOTO 35 'stat 4085 PA$ = "checkcp": GOTO 3060'check abs depuis validation 4090 GOSUB 3980㐞 : BUT = 100: PA$ = "ecrmtcp": GOTO 6010'PA$="ecrmtcp":GOTO 3060 'vers creation 4100 PA$ = "ltcp": GOTO 3060 'plateau 4110 PA$ = "parcp": GOTO 3060'config. 4120 PA$ = "selvacp": GOTO 3060'validation 4125 PA$ = "CNTDATA": GOTO 3060'CONTROL FICHIER 4130 PA$ = "diagcp": GOTO 3060'diagnostic 4131 PA$ = "CONFIG": GOTO 3060'CONFIG ENVIRONNEMENT 4133 PA$ = "calc1cp": GOTO 3060 4136 PA$ = "calc2cp": GOTO 3060 4139 PA$ = "calc3cp": GOTO 3060 4142 PA$ = "calc4cp": GOTO 3060 4145 PA$ = "calc5cp": GOTO 3060 㐞 4148 PA$ = "calc6cp": GOTO 3060 4170 RETURN 4325 LOCATE 24, 20: PRINT SPACE$(40): LOCATE 24, 33: PRINT "ABORT REQUESTED": COLOR 5, 0: LOCATE 25, 70: PRINT SPACE$(11); : LOCATE 24, 70: PRINT SPACE$(11): COLOR 1, 2: PAR(17) = 1: STATUS = 0: DEV% = 52:RETURN ' QP$ = "STO": GOSUB 1470: RETURN 4330 GOSUB 525: RETURN 4440 DATA 81,87,69,82,84,89,85,73,79,80,65,83,68,70,71,72,74,75,76,59,49,50,51,52,53,54,55,56,130,131,132,133,134,135,136,137,138,139 4450 DATA ,,,,,,,,,< CPA >,, 4455 DATA ,,,,,Config,,,,< CPA㐞 >,, 4460 A$ = " SET UP AND START ": RETURN 4470 A$ = " SAMPLE PROGRAMMING AND REPORTING ": RETURN 4480 A$ = " INSTRUMENT PROTOCOL AND QC ": RETURN 4490 A$ = " CREATION AND METHOD REVISION ": RETURN 4500 A$ = " PATIENT FILE REVIEW ": RETURN 4510 A$ = " MATH FUNCTIONS ": RETURN 4520 A$ = " MAINTENANCE ": RETURN 4530 A$ = " CHECK ABSORBANCES ": RETURN 4570 GOTO 3980 'KEY(9)OFF:KEY(10)OFF:KEY(12)OFF:RETURN 4580 GOTO 3990 'KEY(9)ON:KEY(10)ON:KEY(12)ON:RETURN 4590 'affichage video normale e㐞 t inverse 4600 ON LIGNEB + 1 GOSUB 4460, 4470, 4480, 4490, 4500, 4510, 4520, 4530 4610 COLOR 1, 2: LOCATE 5 + LIGNEB, 9: PRINT " ": LOCATE 5 + LIGNEB, 10: PRINT A$: LOCATE 5 + LIGNEB, LEN(A$) + 10: PRINT " " 4620 ON LIGNE + 1 GOSUB 4460, 4470, 4480, 4490, 4500, 4510, 4520, 4530 4630 COLOR 5, 0: LOCATE 5 + LIGNE, 9: PRINT "[": LOCATE 5 + LIGNE, 10: PRINT A$: LOCATE 5 + LIGNE, LEN(A$) + 10: PRINT "]" 4640 LIGNEB = LIGNE: LOCATE , , 0: COLOR 1, 2 4650 RETURN 4660 'routine fleche vers le haut 4670 GOSUB㐞 4570: IF LIGNE = BUTEH THEN LIGNEB = LIGNE: LIGNE = BUTEB - 1: GOTO 4690 4680 LIGNE = LIGNE - 1 4690 GOSUB 4600 4700 GOSUB 4580: RETURN 4710 'routine fleche vers le bas 4720 GOSUB 4570: IF LIGNE = BUTEB - 1 THEN LIGNEB = LIGNE: LIGNE = BUTEH: GOTO 4740 4730 LIGNE = LIGNE + 1 4740 GOSUB 4600 4750 GOSUB 4580: RETURN 4760 'routine fleche vers la gauche 4770 IF LIGNE <> BUTEB THEN AIGUILLAGE = 1 ELSE RETURN 4780 COLOR 1, 2 4790 ON LIGNE + 1 GOSUB 4460, 4470, 4480, 4490, 4500, 4510, 4520, 4530 4800㐞 IF LEN(A$) / 2 <> INT(LEN(A$) / 2) THEN C = 41.5 - LEN(A$) / 2 ELSE C = 41 - LEN(A$) / 2 4810 LOCATE 24, C: PRINT A$: RETURN 4820 'debut du programme 4830 DEV% = 52: GOSUB 3050: FILTRE = 1 4840 PASSAG = 1 4850 GOSUB 4010 4860 GOSUB 7220 4870 'masque de presentation 4880 AFFICH = (2 ^ 7) - 1 4885 GOSUB 4890: GOTO 4960 4890 FOR IND = 0 TO 7 4900 LOCATE 5 + IND, 10 4910 ON IND + 1 GOSUB 4460, 4470, 4480, 4490, 4500, 4510, 4520, 4530 4920 IF (AFFICH AND 2 ^ IND) THEN PRINT A$ 4930 NEXT IND: RETUR㐞!N 4935 OPEN "r", #2, "config.har", 9: FIELD #2, 9 AS X$: C1 = 5: PRESEN = 0: NBENV = 0 4936 GET #2, 1: IF CVI(MID$(X$, 1, 2)) = 1 THEN NBENV = 1: COURANT = CVI(MID$(X$, 3, 2)): GOTO 4945 ELSE COURANT = CVI(MID$(X$, 3, 2)) 4937 FOR IN% = 1 TO 5: GET #2, IN% + 1: IF MID$(X$, 1, 1) = " " OR IN% = COURANT THEN 4942 4938 PRESEN = PRESEN + (2 ^ IN%): NOMENV$ = MID$(X$, 2, 8): POSI = INSTR(NOMENV$, " "): IF POSI THEN NOMENV$ = MID$(NOMENV$, 1, POSI - 1) 4939 COLOR 5, 0: LOCATE 20, C1 + 1 - INT(LEN(NOMENV$) / 㐞!2)'CUR=11*(IN%-1)+INT(.4*IN%):COLOR 5,0:IF IN%>1 THEN LOCATE 20,2+CUR ELSE LOCATE 20,1+CUR 4940 PRINT NOMENV$ 'A3$=SPACE$(5-LEN(NOMENV$)/2)+NOMENV$:NOMENV$=A3$+SPACE$(10-LEN(A3$)):PRINT NOMENV$ 4941 LOCATE 21, C1: PRINT "F" + RIGHT$(STR$(IN%), 1) + " " 4942 C1 = C1 + 11 + CINT((IN% - 1) / 2 - INT((IN% - 1) / 2)): IF COURANT = IN% THEN GOSUB 4947 4943 NEXT IN%: COLOR 1, 2: CLOSE #2: RETURN 4945 GOSUB 4947 4946 CLOSE #2: RETURN 4947 GET #2, COURANT + 1: COURANT$ = MID$(X$, 2, 8): POSI = INSTR(COUR㐞!ANT$, " "): IF POSI THEN COURANT$ = MID$(COURANT$, 1, POSI - 1): RETURN ELSE RETURN 4950 'positionnement du curseur en attente de choix 4960 BUTEH = 0: BUTEB = 7 4970 AIGUILLAGE = 0: IF LIGNE > 6 THEN LIGNE = 6 4980 LIGNEB = LIGNE: GOSUB 4600: GOSUB 3990'inverse video sur cas depart 5030 GOSUB 4030 'touches non repetitives 5040 GOTO 5140 'F$=INKEY$:COLOR 1,2:IF O2=64 AND STATUS <>8 THEN LOCATE 3,54,0:PRINT "Present Config : ";COURANT$ 5050 'DECOMP=DECOMP+1:IF (DECOMP MOD(600))<>1 THEN 5080 㐞!ELSE DECOMP=1:GOSUB 5072:GOTO 5080 5060 GOSUB 3980: GOSUB 4330 ':IF VAL(MID$(R$,9,2))>50 THEN PLUS=.1 ELSE PLUS=0 'affich temper 5070 LOCATE 23, 64: TEMPER! = VAL(MID$(STR$(VAL(MID$(R$, 5, 4))), 2, 4)): PRINT USING "##.#"; TEMPER!: TEMPER$ = MID$(STR$(TEMPER!), 2, 4): GOSUB 3990: RETURN 5072 GOTO 5060 'QP$ = "DST": GOSUB 1470: GOTO 5060 5080 IF AIGUILLAGE THEN 5240 5090 IF F$ = "" THEN 5040 ELSE GOSUB 3980 5100 IF F$ = CHR$(13) THEN GOSUB 4770: GOTO 5040 5110 IF F$ = CHR$(141) THEN GOSUB 4670: GOTO 5㐞!040 5120 IF F$ = CHR$(142) THEN GOSUB 4720: GOTO 5040 5122 IF F$ = CHR$(130) AND (PRESEN AND 2 ^ 1) = 2 ^ 1 THEN GOSUB 5450: GOTO 4125 5123 IF F$ = CHR$(131) AND (PRESEN AND 2 ^ 2) = 2 ^ 2 THEN GOSUB 5450: GOTO 4125 5124 IF F$ = CHR$(132) AND (PRESEN AND 2 ^ 3) = 2 ^ 3 THEN GOSUB 5450: GOTO 4125 5125 IF F$ = CHR$(133) AND (PRESEN AND 2 ^ 4) = 2 ^ 4 THEN GOSUB 5450: GOTO 4125 5126 IF F$ = CHR$(134) AND (PRESEN AND 2 ^ 5) = 2 ^ 5 THEN GOSUB 5450: GOTO 4125 5127 IF F$ = CHR$(135) AND O2 = 64 AND STATUS 㐞!<> 8 THEN 4131 5130 RESTORE 4440: METX = 0 5140 OPEN "r", #1, "increm", 3: FIELD #1, 2 AS ME$, 1 AS FLG$ 5145 R$ = "1": GOSUB 11000'FOR BOU=1 TO 28 5150 'READ VA:IF F$=CHR$(VA) THEN METX=BOU:GOTO 5170 5160 'NEXT BOU 5170 'IF BOU<21 THEN IF METX=0 OR LEFT$(B$(BOU),6)=SPACE$(6) THEN 5190 ELSE GOTO 5175 5171 'IF METX=0 OR LEFT$(MTT$(BOU),6)=SPACE$(6) THEN 5190 5175 'IF PAR(8)=0 OR PAR(9)=0 THEN 5180 ELSE IF METX=PAR(8) OR METX=PAR(9) THEN 5180 ELSE 5190 5180 METH = METX: VER% = 8: GOTO 4100 5190 IF S㐞!TATUS = 8 AND F$ = CHR$(137) THEN 5200 ELSE 5220 5200 VER% = 10: IF PAR(16) = 1 THEN METH = PAR(8) ELSE METH = PAR(9) 5210 COLOR 5, 0: LOCATE 24, 1: PRINT SPACE$(11): COLOR 1, 2: GOTO 4100 5220 'IF STATUS=8 AND F$=CHR$(131) THEN 5280 5230 GOSUB 4580: GOTO 5030 5240 ON LIGNE + 1 GOTO 4100, 4060, 4110, 4090, 4060, 4070, 4130 5280 'IF METH=PAR(8) THEN PAR(10)=PAR(12) ELSE PAR(11)=PAR(13) 5290 'STATUS=10:GOTO 4100 5320 SCREEN 0: COLOR 5, 0: VIEW PRINT 1 TO 21: CLS : VIEW PRINT 5330 COLOR 1, 2: VIEW PRI㐞!NT 3 TO 19: CLS : VIEW PRINT 5340 VIEW PRINT 22 TO 25: CLS : VIEW PRINT 5350 COLOR 5, 0: LOCATE 23, 1: PRINT SPACE$(11): LOCATE 23, 70: PRINT SPACE$(11) 5360 LOCATE 24, 1: PRINT SPACE$(11): LOCATE 24, 70: PRINT SPACE$(11) 5370 LOCATE 25, 1: PRINT SPACE$(11); : LOCATE 25, 70: PRINT SPACE$(11); : COLOR 1, 2 5390 LOCATE 23, 32, 0: PRINT "Instrument Status TC :" 5395 IF VAL(TEMPER$) <> 0 THEN LOCATE 23, 64: PRINT USING "##.#"; VAL(TEMPER$) 5400 RETURN 5410 SCREEN 2: RETURN 5450 SHELL "CHGENV 0㐞 !0" + MID$(STR$(COURANT), 2, 1) + " 00" + MID$(STR$(ASC(F$) - 129), 2, 1) 5464 GOSUB 495 5466 GET #2, 1: A$ = X$ 5468 MID$(A$, 3, 2) = MKI$(ASC(F$) - 129) 5469 LSET X$ = A$ 5470 PUT #2, 1: CLOSE #2 5490 RETURN 5498 '******************************************************** 5500 ' INSERTION T . DEF DISK 5502 '******************************************************** 5550 DEV% = &H39: DAT% = 0: CIM% = &HC: GOSUB 575: RETURN 5600 DATA ,,,,,,,,,< CPA >,, 5990 DATA ,,,,,,EXIT,,,< CPA >,, 600㐞!0 GOSUB 5320: LOCATE 23, 64: PRINT USING "##.#"; VAL(TEMPER$)'changement de disquette :fond d'ecran 6010 RESTORE 5990: BUT = 100: GOSUB 3130 'texte ecran 6015 LOCATE 17, 30: PRINT " PLEASE WAIT " 6020 GOSUB 420 'nameth 6030 FOR QW% = 1 TO 34: GET #1, QW%: NAMET$(QW%) = DAT$: NEXT QW%: CLOSE #1 6040 OPEN "r", #1, "method", 200: FIELD #1, 200 AS RAT$ 6050 FOR QW% = 1 TO 64: GET #1, QW%: METO1$(QW%) = RAT$ 6060 NEXT QW%: CLOSE #1 6065 GOSUB 405: GET #1, 1: SOURCE$ = NM$: LSET NM$ = "S": PUT #1, 2: 㐞!CLOSE #1 6067 IF O2 = 64 THEN 6090 6070 GOSUB 3990: GOSUB 15100: LOCATE 17, 30: PRINT SPACE$(16): LOCATE 7, 5: PRINT "- REMOVE THE WORKDISK" 6080 A$ = INKEY$: IF A$ = CHR$(136) THEN 6210 ELSE IF A$ = CHR$(138) AND PAR(37) <> 0 AND PAR(17) = 0 THEN GOSUB 4325 6085 GOSUB 5550 ': IF (RET% AND 128) = 0 THEN FOR K = 1 TO 2000: NEXT K: GOTO 6080 6090 IF O2 = 64 THEN GOSUB 3990: RESTORE 5990 ELSE RESTORE 5600 6095 GOSUB 3130 6096 LOCATE 10, 5: IF O2 = 64 THEN GOSUB 495: GET #2, 1: CONF = CVI(MID$(X$, 3, 2))㐞!: CLOSE #2: PRINT "- INSERT THE BACK UP DISK"; CONF ELSE PRINT "- INSERT THE T. DEF. DISK" 6097 IF O2 = 64 THEN A$ = INKEY$: IF A$ = CHR$(136) THEN 6210 6100 GOSUB 5550 ': IF (RET% AND 128) <> 0 THEN FOR K = 1 TO 2000: NEXT K: GOTO 6097 6110 IF O2 = 64 THEN ESPER$ = CHR$(ASC(SOURCE$) - 7): GOSUB 406 ELSE ESPER$ = "Z": GOSUB 405 6133 GET #1, 1: DEST$ = NM$: CLOSE #1: IF DEST$ <> ESPER$ THEN 6136 ELSE IF O2 = 64 THEN RESTORE 5600: GOSUB 3130 6134 LOCATE 17, 30: PRINT " PLEASE WAIT ": LOCATE 10, 5: PR㐞!INT SPACE$(38): GOTO 6150 6136 GOSUB 15100: LOCATE 13, 5: PRINT SPACE$(33): LOCATE 17, 30: PRINT "REMOVE THIS DISK" 6140 GOSUB 5550 ': IF (RET% AND 128) = 0 THEN FOR K = 1 TO 2000: NEXT K: GOTO 6140 6145 LOCATE 17, 30: PRINT SPACE$(26): GOTO 6096 6150 OPEN "r", #1, "memname", 105: FIELD #1, 105 AS DAT$ 6160 FOR QW% = 1 TO 34: LSET DAT$ = NAMET$(QW%): PUT #1, QW%: NEXT QW%: CLOSE #1 6170 OPEN "r", #1, "memmeth", 200: FIELD #1, 200 AS RAT$ 6180 FOR QW% = 1 TO 64: LSET RAT$ = METO1$(QW%): PUT #1, QW% 6㐞!190 NEXT QW%: CLOSE #1: IF O2 = 64 THEN SOURCE$ = CHR$(ASC(SOURCE$) - 7) 6200 GOSUB 405: LSET NM$ = SOURCE$: PUT #1, 2: CLOSE #1: VFREE = FRE(""): CHAIN "ECRMTCP" 6210 IF AIG1 THEN BUT = 10 ELSE BUT = 0 6215 GOSUB 405: LSET NM$ = " ": PUT #1, 2: CLOSE #1 6220 AIGUILLAGE = 0: IF PAS = 8 THEN 7305 ELSE ON AIG1 + 1 GOTO 31, 4133, 4133, 4136, 4142, 4139, 4139, 4148, 4136, 4145, 4142, 4145, 4136 6495 '******************************************************** 6497 '* SELVACP 㐞! * 6499 '******************************************************** 6900 TES = PL(ECH): IF PASSAGE <> 2 OR TES = 251 THEN GOSUB 7217: GOTO 6930 6905 IF TES = 0 OR TES > 250 OR PLA(ECH) = 0 THEN 6930 6910 PTES = ASC(MID$(PARPAT$, TES, 1)): IF PTES = 0 THEN 6930 6915 GOSUB 7130: P2 = CVI(MID$(LP$, (MEM - 1) * 6 + 1, 2)) 6920 IF P2 = 0 THEN GOSUB 7217: GOTO 6930 6925 IF (P2 AND (2 ^ 10 + 2 ^ 12)) = 5120 AND K1(6) < 3 THEN PRINT "d"; ELSE IF (P2 AND (2 ^ 5 + 2 ^ 11)) = 2080 THEN PRINT "r"; 693㐞!0 RETURN 7000 LOCATE 24, 31, 0: PRINT "Result File Update": RETURN 7010 COLOR 5, 0: LOCATE 2, 44: PRINT SPACE$(36); : LOCATE 2, 53: IF MEMU THEN PRINT "M"; ELSE PRINT "S"; 7011 IF FWL THEN PRINT "R"; ELSE PRINT " "; 7012 PRINT "-"; : IF MEMU THEN PRINT LEFT$(MTT$(MEMU + 20), 6) + "/" + B$(MEM); ELSE PRINT B$(MEM) + SPACE$(6); 7015 LOCATE 2, 44: IF PASSAGE = 2 THEN REFAC = 1: PRINT "RUN 2 :"; ELSE IF PASSAGE = 3 THEN REFAC = 1: PRINT "RUN 1 :"; : LOCATE 20, 72: PRINT SPC(6); : LOCATE 21, 74: PRINT "㐞! " 7020 LOCATE 2, 70: PRINT "Tray :"; PLA; : COLOR 1, 2: RETURN 7040 DATA Tot. Rej.,,,"Valid. ",,,EXIT,,,Selective Validation,, 7045 DATA Unit 1,Unit 2,,,,,EXIT,,,Duplicate,, 7047 DATA ,,,,,,EXIT,,,Duplicate,, 7048 DATA ,,,,,,EXIT,,,Calibration Correction,, 7050 'lecture du fichier nameth 7060 GOSUB 7070: GOSUB 7080: RETURN 7070 OPEN "r", #1, "nameth", 105: FIELD #1, 6 AS T$, 6 AS T1$, 32 AS ST$, 32 AS TI$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$: RETURN 7080 FOR IN% 㐞 != 1 TO 32: GET #1, IN%: B$(IN%) = T$: MTT$(IN%) = TI$: NEXT IN%: CLOSE #1: RETURN 7090 GOSUB 7095: FOR K = 1 TO 100: GET #1, (MEM - 1) * 100 + K: K1(K) = CVS(A2$): NEXT K: CLOSE #1: RETURN 7095 OPEN "r", #1, "method", 4: FIELD #1, 4 AS A2$: RETURN 7100 OPEN "r", #1, "paille", 206'lecture fichier paille 7110 FIELD #1, 12 AS NM$, 2 AS M1$, 2 AS M2$, 2 AS MR1$, 2 AS MR2$, 120 AS P$, 6 AS M2P$, 18 AS P2P$, 42 AS RP$: RETURN 7120 OPEN "r", #2, "descpai", 128: FIELD #2, 128 AS CH$: RETURN'lecture descpai 71㐞"25 GOSUB 7100: GOSUB 7120: GET #2, 1: PARPAT$ = CH$: RETURN 7130 GET #1, PTES: NOM$ = NM$: LM1$ = M1$: LM2$ = M2$: LMR1$ = MR1$: LMR2$ = MR2$: LP$ = P$: LM2P$ = M2P$: LP2P$ = P2P$: LRP$ = RP$: RETURN 7135 OPEN "r", #1, "qualite", 408 7136 FIELD #1, 4 AS QL1$, 4 AS QL2$, 6 AS LL$, 4 AS QH1$, 4 AS QH2$, 6 AS LH$, 186 AS RL$, 186 AS RH$, 4 AS CL$, 4 AS CUH$: RETURN 7137 GOSUB 7135: GET #1, MEM: QCB = CVS(QL1$): TOLB! = CVS(QL2$): QCH = CVS(QH1$): TOLH! = CVS(QH2$): CLOSE #1: RETURN 7140 'GOTO 400 7150 'I㐞"F I<>0 THEN 7190 'effacement ligne 7160 'IF A$=CHR$(130) THEN 7190 ELSE LOCATE L,C+I 7170 'PRINT SPACE$(MAX+1) 7180 'LOCATE L,C+I 7190 'RETURN 7200 DATA "Tot.Rej.","Tot.Val.","Sel.Val.",,,Duplicate,,,,< CPA >,, 7202 DATA ,Next,,,,Duplicate,,,,< CPA >,, 7210 IF VER% = 10 THEN DEV% = 52: GOSUB 5060 ELSE 7212 7211 LOCATE 10, 29: IF PAR(20) = 0 THEN PRINT "MAIN MENU ACCESS" ELSE PRINT "VALIDATION IN PROGRESS" 7212 IF VER% = 12 THEN LOCATE 10, 29: PRINT "REJECTION IN PROGRESS" 7215 RETURN 721㐞"7 IF (P2(ECH) AND 2 ^ 10) <> 0 AND K1(6) < 3 THEN PRINT "d"; ELSE IF (P2(ECH) AND 2 ^ 5) <> 0 THEN PRINT "r"; 7218 RETURN 7220 IF PAR(16) AND TEXT <> 0 THEN STATUS = 8 7222 IF (PAR(52) = 0 AND STATUS <> 8 AND O2 = 64) THEN RESTORE 4455: GOSUB 3130: GOSUB 4935 ELSE RESTORE 4450: GOSUB 3130 7225 RETURN 7230 LOCATE 10, 5: PRINT "Unit 1"; TAB(18); ":"; TAB(23); "PRINTOUT IN UNIT 1" 7235 LOCATE 12, 5: PRINT "Unit 2"; TAB(18); ":"; TAB(23); "PRINTOUT IN UNIT 2": RETURN 7240 COLOR 5, 0: LOCATE 20, 48: PRIN㐞"T "Correction": LOCATE 21, 51: PRINT "F5": COLOR 1, 2: LOCATE 14, 5: PRINT "Correction"; TAB(18); ":"; TAB(23); "CALIBRATION CORRECTION": RETURN 7245 LOCATE 18, 20: IF CHOIX = 5 THEN PRINT "For Select the Method press ENTER": RETURN ELSE PRINT "For Printout press ENTER ": RETURN 7250 PRINT "TARGET VALUE ?"; : RETURN 7255 PRINT "ANALYSED VALUE ?"; : RETURN 7260 DEV% = &H35: CIM% = 1: DAT% = 0: RET% = 0: GOSUB 575 7262 IMPOUT=1 'IF RET% < 2000 THEN IMPOUT = 1 ELSE IMPOUT = 0'imprimante occupee 7265 DE㐞"V% = 52: RETURN 7270 DEV% = &H35: CIM% = 8: DAT% = 0: RET% = 0: GOSUB 575: FOR AB% = 1 TO 7500: NEXT AB%: DEV% = 52: RETURN'stop imprimante 7275 ' IF (P2(IND) AND 2^10)<>0 AND K1(58)<>0 AND K1(6)<3 THEN P2(IND)=P2(IND) OR 2^12:GOTO 7277 7276 ' IF (P2(IND) AND (2^6+2^8+2^10))<>0 THEN P2(IND)=P2(IND) OR 2^14 7277 ' MID$(LP$,(MEM-1)*6+1,2)=MKI$(P2(IND)):RETURN 7280 MID$(LP$, (MEM - 1) * 6 + 1, 6) = TER$ + TRES$: RETURN 7285 LSET NM$ = NOM$: LSET M1$ = LM1$: LSET M2$ = LM2$: LSET MR1$ = LMR1$: LSET MR2$ =㐞" LMR2$: LSET P$ = LP$: LSET M2P$ = LM2P$: LSET P2P$ = LP2P$: LSET RP$ = LRP$: RETURN 7290 ME = CVI(MID$(A1$, 1 + (NUME * 6), 2)): RETURN 7295 ' ecran principal + validation 7300 GOSUB 5320: GOSUB 4010 'ecran,clavier 7302 IF PAR(18) <> 0 AND VER% <> 15 THEN GOSUB 7380: ABORT = 0: AUTOMAT = 1: GOTO 7500 7305 COLOR 1, 2: IF PAR(20) THEN RESTORE 7200 ELSE RESTORE 7202 7306 SUP% = F9% + 2 ^ 0: GOSUB 3130: AFFICH = (2 ^ 8) - 1: BUTEB = 8: BUTEH = 1 7307 GOSUB 7260: IF IMPOUT THEN COLOR 5, 0: LOCATE 20,㐞" 50: PRINT "Stop": LOCATE 21, 51: PRINT "F5": COLOR 1, 2 7310 DEV% = 52: GOSUB 4890: LIGNE = 7: LIGNEB = 7: GOSUB 4600: GOSUB 3990 7320 GOSUB 3410: F$ = "" 7330 GOSUB 7380 'F$=INKEY$:IF AIGUILLAGE THEN 7340 ELSE IF F$="" THEN 7350 ELSE 7341 7340 'VER%=0:ON LIGNE+1 GOTO 4100,4060,4110,4090,4060,4070,4130,7430 7341 IF F$ = CHR$(13) THEN GOSUB 4770 '< 7342 IF F$ = CHR$(141) THEN GOSUB 4670 '^ 7343 IF F$ = CHR$(142) THEN GOSUB 4720 'v 7344 IF F$ = CHR$(130) THEN GOSUB 7370 7345 IF F$ = CHR$(131) TH㐞"EN GOSUB 7380 7346 IF F$ = CHR$(132) THEN GOSUB 7390 7348 IF F$ = CHR$(135) THEN GOSUB 7410 7349 IF F$ = CHR$(134) AND IMPOUT = 1 THEN GOSUB 7270 7350 REMET = REMET + 1: IF REMET MOD (150) = 1 AND IMPOUT = 1 THEN GOSUB 7260: IF IMPOUT = 0 THEN COLOR 5, 0: LOCATE 20, 50: PRINT SPACE$(4): LOCATE 21, 51: PRINT " ": COLOR 1, 2 7351 IF REMET MOD (900) = 1 THEN GOSUB 5060 7352 IF REMET >= 901 THEN REMET = 1 7355 IF ABORT THEN ABORT = 0: GOTO 7500 7360 CHOIX = 0: GOTO 7330 7370 IF PAR(20) = 0 THEN RETURN㐞 " ELSE VER% = 12: GOSUB 7220: GOSUB 7210: GOTO 7420 7380 VER% = 10: GOSUB 7220: GOSUB 7210: GOTO 7420 7390 IF PAR(20) = 0 THEN RETURN 7395 IF AVALID THEN VER% = 11: GOTO 7420 ELSE 7380 7410 VER% = 14 7420 COLOR 1, 2: ABORT = 1: RETURN 7430 BUT = 30: GOTO 4085 7480 ' validation 7490 'VER%=10:next , VER%=11:sel val , VER%=12:tot rej , VER%=14:duplicate , VER%=15 operation manuelle , retour duplicate ou exit selvalid 7500 IF VER% = 14 THEN GOSUB 9330: GOTO 8140 ELSE FILTRE = 1: MAX = 2: GOSUB 7060: GOS㐞"UB 8970'nameth,chaines nulles 7505 CHAM% = INT(PAR(52) / 16.0001) + 1: GOSUB 470: GET #1, CHAM%: NUME = (PAR(52) - 1) - ((CHAM% - 1) * 16) 7506 FARR = CVI(MID$(A1$, 5 + (NUME * 6), 2)): IF FARR THEN GOSUB 7290: FARR = ME 7507 CLOSE #1 7510 FOR ES = 1 TO 48: PLA(ES) = 0: PRES(ES) = 0: PL(ES) = 0: P2(ES) = 0: P3!(ES) = 0: NEXT ES'pres=1:refuse , pres=2:a valider , pres=3:impossible a valider 7520 GOSUB 8910: IF ME = 0 THEN 8100'recherche 1ere meth a valider 7660 IF REFAC THEN ON VER% - 9 GOSUB 7380, 742㐞"0, 7370 7670 ABORT = 0: REFAC = 0 7690 IF ME < 0 THEN PASSAGE = 2 7700 GOSUB 3990: IF VER% = 11 OR ME < 0 OR (FDEL = 1 AND AUTOMAT = 1) THEN 7730 7710 FOR IN% = 1 TO 48: PRES(IN%) = 2'IF VER%=12 OR ((P2(IN%) AND (2^3+2^4+2^5+2^6+2^8+2^9+2^10+2^14))<>0) OR P3!(IN%)<0 THEN PRES(IN%)=1 ELSE PRES(IN%)=2 7720 NEXT IN%: GOTO 8090 7730 IF ECRAN THEN GOSUB 4040: COLOR 5, 0: GOSUB 5370: GOSUB 3990 ELSE RESTORE 7040: SUP% = F9% + 2 ^ 0: GOSUB 3130: ECRAN = 1'affichage 7740 GOSUB 7010: DEV% = 52: GOSUB 5060 77㐞"50 LOCATE 5, 1: PRINT "VALIDATED SAMPLES :" 7760 L = 8: C = 2: IF PASSAGE = 2 AND PAR(20) <> 0 THEN GOSUB 7125 7850 FOR ECH = 17 TO 48: LOCATE L, C 7860 IF ECH < 26 THEN ESP$ = " " ELSE ESP$ = " " 7870 GOSUB 6900 7880 IF PL(ECH) = 252 THEN ECR$ = " QC2" ELSE IF PL(ECH) = 253 THEN ECR$ = " QC1" ELSE IF PLA(ECH) THEN ECR$ = STR$(ECH - 16) + ESP$ ELSE ECR$ = " --" 7890 IF PLA(ECH) = 0 THEN PRES(ECH) = 0: GOTO 7910 ELSE IF ((P2(ECH) AND (2 ^ 3 + 2 ^ 4 + 2 ^ 6 + 2 ^ 8 + 2 ^ 9 + 2 ^ 10 + 2 ^ 14)) <> 0) OR 㐞"P3!(ECH) < 0 THEN PRES(ECH) = 3: GOTO 7910 7895 IF (P2(ECH) AND (2 ^ 5)) <> 0 AND P2 = 0 AND PASSAGE <> 3 THEN PRES(ECH) = 1: GOTO 7910 7900 PRES(ECH) = 2 7910 IF PRES(ECH) = 2 THEN COLOR 5, 0 ELSE COLOR 1, 2 7915 PRINT ECR$: COLOR 1, 2: C = C + 9: IF C = 74 THEN C = 2: L = L + 1 7920 NEXT ECH 7930 LOCATE 17, 10: PRINT " Only Backlighted Samples Are Validated": LOCATE 15, 10: PRINT "CHANGE STATUS of No : ": IF PASSAGE = 3 THEN FONCT = 18 ELSE FONCT = 146 7940 LOCATE 15, 40: PRINT " ": L = 15: C = 4㐞"0: LOCATE L, C, 1: MASK = 3: MAX = 2: VALMAX = 32: GOSUB 3380'interrogation operateur 7980 ON J GOTO 7990, 7940, 7940, 8005, 7940, 7940, 7985, 7940, 7940, 8010 7985 IF PASSAGE = 2 AND PAR(20) <> 0 THEN CLOSE #1: CLOSE #2 7987 GOTO 8140 7990 FOR IN% = 17 TO 48: IF PLA(IN%) THEN PRES(IN%) = 1 8000 NEXT IN% 8005 IF PASSAGE = 2 AND PAR(20) <> 0 THEN CLOSE #1: CLOSE #2 8007 GOTO 8090 8010 IF Q < 1 OR Q > 32 THEN 7940 8020 ECH = Q + 16 8030 IF Q < 10 THEN ESP$ = STR$(Q) + " " ELSE ESP$ = STR$(Q) + " " 㐞" 8040 L = INT((Q - 1) / 8) + 8: C = ((Q - 1) MOD 8) * 9 + 2: LOCATE L, C 8050 GOSUB 6900 8060 IF PRES(ECH) = 2 AND PL(ECH) < 252 THEN PRES(ECH) = 1: COLOR 1, 2: PRINT ESP$: GOTO 7940 8070 IF PRES(ECH) = 1 THEN PRES(ECH) = 2: COLOR 5, 0: PRINT ESP$: COLOR 1, 2: GOTO 7940 ELSE 7940 8080 'end validation 8090 GOSUB 7000: GOSUB 3980: GOSUB 8150: LOCATE 24, 26: PRINT SPACE$(30): IF PASSAGE = 2 AND REPASSE <> 0 THEN PASSAGE = 3: GOTO 7730 ELSE GOSUB 8780: GOSUB 10101: GOSUB 8950: IF ME THEN ECRAN = 0: PASSAGE㐞" = 0: GOTO 7510 8095 GOSUB 470: FOR ET% = 1 TO CINT((O2 / 16) + .05): GET #1, ET%: EN$ = A1$: FOR ER% = 0 TO 15 8096 EN% = CVI(MID$(EN$, 1 + (6 * ER%), 2)): IF EN% <> 0 THEN GOSUB 150 8097 NEXT ER%: NEXT ET%: CLOSE #1 8099 IF PAR(18) = 0 OR FMEL <> 0 THEN 8107 8100 IF PAR(16) <> 0 AND PAR(41 + (PAR(16) - 1) * 4 + PAR(37 + PAR(16))) <> 0 AND MEBA <> 0 THEN IF MEBA = (PAR(60) AND (32767 - (2 ^ 8 + 2 ^ 9))) THEN VER% = 512 ELSE VER% = 1024 8105 PAR(60) = 0 8107 GOSUB 372 8110 AIG1 = 0: LIGNE = 1: PAS =㐞" 0: BUT = 0: IF VER% >= 512 THEN METH = (MEBA AND 31744) / 1024: STATUS = 8: GOTO 4100 8120 IF (VER% > 9 AND VER% < 13) AND PAR(16) <> 0 THEN VER% = 10: STATUS = 8: METH = PAR(7 + PAR(16)): GOTO 4100 8130 STATUS = 0: VER% = 0: GOTO 4830'vers main 8140 VER% = 15: PAS = 8: ECRAN = 0: GOTO 7305'exit vers main 8150 IF PASSAGE = 3 THEN 8160 ELSE FREL = 0: REPASSE = 0: REDIL = 0 8160 GOSUB 7125 8170 IF PAR(20) = 0 THEN 8350 'si collect. list 8190 FOR IND = 17 TO 48: TES = PL(IND) AND 255: IF TES = 0 THEN㐞 " 8330 8200 IF (TES = 252 OR TES = 253) AND PRES(IND) = 2 THEN GOSUB 9010: GOTO 8330' qc 8205 IF (TES = (PAR(58) AND 255) OR TES = (PAR(58) AND 32512) / 256) AND PRES(IND) = 2 THEN GOSUB 9010 8210 IF TES > 250 THEN 8330 'si w.l 8220 IF PLA(IND) = 0 THEN 8330 8230 PTES = ASC(MID$(PARPAT$, TES, 1)): IF PTES = 0 THEN 8330 8240 GOSUB 7130 8250 IF PRES(IND) = 2 AND ((P2(IND) AND 2 ^ 4) = 0) THEN 8290 8255 DMR1 = CVI(MR1$): DMR2 = CVI(MR2$): P2 = CVI(MID$(LP$, (MEM - 1) * 6 + 1, 2)): P3! = CVS(MID$(LP$㐞#, (MEM - 1) * 6 + 3, 4)) 8256 IF P2 = 0 AND FRER = 1 THEN FMEL = 1 8258 IF PASSAGE = 2 AND (P2 AND (2 ^ 5 + 2 ^ 11)) = 2080 AND PRES(IND) <> 2 THEN REPASSE = REPASSE + 1 8260 IF (P2 AND 2 ^ 11) <> 0 AND PASSAGE = 2 THEN 8262 ELSE FREL = 1 8261 ' IF PAR(18)=0 THEN GOSUB 7275:GOTO 8270 8262 IF P2 <> 0 AND (PASSAGE = 3 OR (PASSAGE = 2 AND (P2 AND (2 ^ 5 + 2 ^ 11)) <> (2 ^ 5 + 2 ^ 11))) THEN P2(IND) = 0: GOTO 8270 8263 IF VER% = 10 AND PASSAGE = 0 AND (P2(IND) AND 2 ^ 12) <> 0 AND (P2(IND) AND (2 ^ 6 + 2 㐞#^ 8 + 2 ^ 14)) <> 0 THEN REDIL = 1: P2(IND) = P2(IND) OR 2 ^ 11: GOTO 8270 8264 IF (P2(IND) AND (2 ^ 10 + 2 ^ 12)) = 2 ^ 12 THEN P2(IND) = P2(IND) XOR 2 ^ 12 8266 IF (P2(IND) AND 2 ^ 10) <> 0 AND K1(58) <> 0 AND K1(6) < 3 THEN P2(IND) = P2(IND) OR 2 ^ 12: REDIL = 1: GOTO 8270 ELSE P2(IND) = P2(IND) OR 2 ^ 11 8268 IF (P2(IND) AND (2 ^ 6 + 2 ^ 8 + 2 ^ 10)) <> 0 THEN P2(IND) = P2(IND) OR 2 ^ 14 8270 IF MEM > 10 THEN DMR2 = DMR2 XOR 2 ^ (MEM - 11) ELSE DMR1 = DMR1 XOR 2 ^ (MEM - 1) 8280 LMR1$ = MKI$(DMR1):㐞# LMR2$ = MKI$(DMR2): MID$(LP$, (MEM - 1) * 6 + 1, 2) = MKI$(P2(IND)): IF P2 = 0 AND (P2(IND) AND (2 ^ 5 + 2 ^ 11)) = 2080 THEN MID$(LP$, (MEM - 1) * 6 + 3, 4) = MKS$(P3!(IND)) 8285 IF (P2 AND (2 ^ 5 + 2 ^ 11)) = 2080 AND PASSAGE = 2 THEN P2(IND) = P2: P3!(IND) = P3!: GOTO 8330 ELSE 8305 8290 IF (P2(IND) AND 2 ^ 12) = 2 ^ 12 THEN P2(IND) = P2(IND) XOR 2 ^ 12 8292 IF (P2(IND) AND 2 ^ 11) = 2 ^ 11 AND PASSAGE = 3 THEN P2(IND) = P2(IND) XOR 2 ^ 11 8295 GOSUB 8690 8300 GOSUB 7280 8305 PLA(IND) = 0: PRES(IN㐞#D) = 0: PL(IND) = 0: P2(IND) = 0: P3!(IND) = 0 8310 GOSUB 7285 8320 PUT #1, PTES 8330 NEXT IND: CLOSE #1: CLOSE #2 8340 RETURN 8350 'GET#2,2:PARENR$=CH$:NUM=PLA ' collection list 8370 FOR IND = 17 TO 48: TES = PL(IND) AND 255: IF PL(IND) = 0 THEN 8640 8380 IF PRES(IND) <> 2 OR ((P2(IND) AND 2 ^ 4) <> 0) THEN 8640 8390 IF (TES = 252 OR TES = 253) AND PRES(IND) = 2 THEN GOSUB 9010: GOTO 8640' qc 8400 'IF TES<>251 THEN 8640 8410 'NUC=(NUM*256)+IND:DEJA=0:CHE=PAR(21)+1 8420 'FOR JIND=P㐞#AR(21) TO 1 STEP -1:IF DEJA THEN 8640 8430 'PJIND=ASC(MID$(PARPAT$,JIND,1)) 8440 'GET#1,PJIND:TY=CVI(M1$):IF TY<>NUC AND TYNUC THEN 8510 ELSE DEJA=1 8450 'NOM$=NM$:LM1$=M1$:LM2$=M2$:DMR1=CVI(MR1$):DMR2=CVI(MR2$):LP$=P$:LM2P$=M2P$:LP2P$=P2P$:LRP$=RP$ 8460 'IF MEM>10 THEN DMR2=DMR2 OR 2^(MEM-11) ELSE DMR1=DMR1 OR 2^(MEM-1) 8470 'GOSUB 8690 8480 'GOSUB 7280:LMR1$=MKI$(DMR1):LMR2$=MKI$(DMR2) 8490 'GOSUB 7285 8500 'PUT#1,PJIND 8510 'NEXT JIND 8520 'IF DEJA THE㐞#N 8640 ELSE CHE=1 8530 'IF PAR(21)=128 THEN CLOSE#1:CLOSE#2:LOCATE 24,30:PRINT "Full Collection List";:RETURN 8540 'LM2P$=DFG$:LP2P$=QWE$:IF MEM>10 THEN DMR2=2^(MEM-11):DMR1=0 ELSE DMR1=2^(MEM-1):DMR2=0 8550 'GOSUB 8690 8560 'KL$=JKL$:MID$(KL$,(MEM-1)*6+1,6)=TER$+TRES$:LM1$=MKI$(NUC):LMR1$=MKI$(DMR1):LMR2$=MKI$(DMR2) 8570 'LSET NM$=NOM$:LSET M1$=LM1$:LSET M2$=VBN$:LSET MR1$=LMR1$:LSET MR2$=LMR2$:LSET P$=KL$:LSET M2P$=LM2P$:LSET P2P$=LP2P$:LSET RP$=XCV$ 8580 'FOR IN%=1 TO PAR(21):IF ASC(MID$(PARENR$,IN㐞#%,1))=0 THEN BON=IN%:GOTO 8600 8590 'NEXT IN%:BON=IN% 8600 'PUT#1,BON:PAR(21)=PAR(21)+1 8610 'MID$(PARENR$,BON,1)=CHR$(CHE):MID$(PARPAT$,CHE,PAR(21)-CHE+1)=CHR$(BON)+MID$(PARPAT$,CHE,PAR(21)-CHE) 8620 'FOR IN%=1 TO 128:TY=ASC(MID$(PARENR$,IN%,1)):IF TY>=CHE AND IN%<>BON THEN MID$(PARENR$,IN%,1)=CHR$(TY+1) 8630 'NEXT IN% 8640 NEXT IND: CLOSE #1: CLOSE #2: RETURN'NEXT IND:CLOSE#1:LSET CH$=PARPAT$:PUT#2,1:LSET CH$=PARENR$:PUT#2,2:CLOSE#2:RETURN 8650 ' GOTO 470 8690 P2(IND) = P2(IND) OR 1: TER$ = MKI$(㐞#P2(IND)): TRES$ = MKS$(P3!(IND)) 8700 RETURN 8710 PRIM% = (PAR(53) * 48) + 5 8720 FOR ESSI = PRIM% TO PRIM% + 47 8740 GET #1, ESSI: ECH = ASC(LEFT$(A1$, 1)): IF CORRIG THEN AB1$ = A1$: MID$(AB1$, 101, 4) = MKS$(P3!(ECH)): MID$(AB1$, 99, 2) = MKI$(P2(ECH)): LSET A1$ = AB1$: PUT #1, ESSI: GOTO 8770 8750 PL(ECH) = ASC(MID$(A1$, 2, 1)): P2(ECH) = CVI(MID$(A1$, 99, 2)) 8760 P3!(ECH) = CVS(MID$(A1$, 101, 4)): PLA(ECH) = 1 8770 NEXT ESSI: CLOSE #1: RETURN 8780 GOSUB 470 'raj ABSORB effacement methode que㐞 # l'on vient de valider 8790 ' 8800 PRIM% = (PAR(53) * 48) + 5: BU$ = CHR$(0) + CHR$(0) + SPACE$(96) + MKI$(0) + MKS$(0) + MKI$(0): FOR IN% = PRIM% TO PRIM% + 47: LSET A1$ = BU$: PUT #1, IN%: NEXT IN% 8810 GOSUB 8990 8815 BU$ = A1$: MID$(BU$, 1 + (NUME * 6), 6) = MKI$(0) + MKI$(0) + MKI$(0): LSET A1$ = BU$: PUT #1, CHAM% 8820 CLOSE #1: PAR(52) = PAR(52) - 1: IF PAR(52) = 0 THEN PAR(53) = 0: GOSUB 8830 ELSE PAR(53) = PAR(53) + 1: GOSUB 8830 8825 RETURN 8830 GOSUB 400: LSET P1$ = MKI$(PAR(52)): PUT #1, 㐞#52: LSET P1$ = MKI$(PAR(53)): PUT #1, 53: CLOSE #1: RETURN 8910 GOSUB 470: GOSUB 8990: GOSUB 7290: IF ME = 0 THEN CLOSE #1: RETURN'1ere methode a valider 8920 MEM = ABS(ME) AND 31: MEMU = (ABS(ME) AND 480) / 32 8921 PLA = (ABS(ME) AND 15872) / 512 8922 FMEL = 0: IF ME < 0 THEN FRER = 1 ELSE FRER = 0 8923 IF (ABS(ME) AND 16384) THEN FWL = 1 ELSE FWL = 0 8925 IF MEMU = 0 THEN 8927 ELSE IF (FARR AND (480 + 15872 + 16384)) = (ABS(ME) AND (480 + 15872 + 16384)) THEN FDEL = 1 8926 GOTO 8930 8927 IF (FARR 㐞#AND (31 + 15872 + 16384)) = (ABS(ME) AND (31 + 15872 + 16384)) THEN FDEL = 1 8930 GOSUB 8710 'p2,p3,pl 8940 GOSUB 7090: RETURN 'lect method 8950 GOSUB 470: GOSUB 8990: MEMUBAK = MEMU: PLABAK = PLA'methode suivante a valider 8960 GOSUB 7290: CLOSE #1: RETURN 8970 GOSUB 173: JKL$ = KL$: XCV$ = CV$: VBN$ = BN$: DFG$ = FG$: NOM$ = SPACE$(12): QWE$ = WE$ 8980 RETURN 8990 CHAM% = INT((PAR(53) + 1) / 16.0001) + 1: GET #1, CHAM%: NUME = PAR(53) - ((CHAM% - 1) * 16): RETURN 8995 FMEL = 0: IF ME < 0 THEN FRER㐞# = 1 ELSE FRER = 0 9000 ME = ABS(ME): RETURN 9010 PLEINL = 0: PLEINH = 0: CLOSE #1: OPEN "r", #1, "qualite", 408: FIELD #1, 240 AS QC$ 9020 GET #1, 21: NOMBL = CVI(MID$(QC$, 1 + (MEM - 1) * 12, 2)): PREENL = CVI(MID$(QC$, 3 + (MEM - 1) * 12, 2)): DERENL = CVI(MID$(QC$, 5 + (MEM - 1) * 12, 2)) 9030 NOMBH = CVI(MID$(QC$, 7 + (MEM - 1) * 12, 2)): PREENH = CVI(MID$(QC$, 9 + (MEM - 1) * 12, 2)): DERENH = CVI(MID$(QC$, 11 + (MEM - 1) * 12, 2)): QCC$ = QC$ 9035 QC = 0: IF TES = (PAR(58) AND 255) THEN QC = 1 E㐞#LSE IF TES = (PAR(58) AND 32512) / 256 THEN QC = 2 9040 IF NOMBL > 31 THEN NOMBL = 0: PREENL = 0: DERENL = 0 9050 IF NOMBH > 31 THEN NOMBH = 0: PREENH = 0: DERENH = 0 9060 IF TES = 252 OR QC = 2 THEN 9120 9070 IF NOMBL < 31 THEN NOMBL = NOMBL + 1 ELSE PLEINL = 1 9080 DERENL = DERENL + 1: IF DERENL = 32 THEN DERENL = 1 9090 IF PLEINL THEN PREENL = PREENL + 1: IF PREENL = 32 THEN PREENL = 1 9100 IF PREENL = 0 THEN PREENL = 1 9110 GOTO 9170 9120 IF NOMBH < 31 THEN NOMBH = NOMBH + 1 ELSE PLEINH = 1 91㐞#30 DERENH = DERENH + 1: IF DERENH = 32 THEN DERENH = 1 9140 IF PLEINH THEN PREENH = PREENH + 1: IF PREENH = 32 THEN PREENH = 1 9150 IF PREENH = 0 THEN PREENH = 1 9160 DESCRI$ = MKI$(NOMBH) + MKI$(PREENH) + MKI$(DERENH): MID$(QCC$, 7 + (MEM - 1) * 12, 6) = DESCRI$: GOTO 9180 9170 DESCRI$ = MKI$(NOMBL) + MKI$(PREENL) + MKI$(DERENL): MID$(QCC$, 1 + (MEM - 1) * 12, 6) = DESCRI$ 9180 LSET QC$ = QCC$: PUT #1, 21: CLOSE #1 9190 GOSUB 7135 9210 GET #1, MEM 9220 SQL1$ = QL1$: SQL2$ = QL2$: SLL$ = LL$: SQH1$ 㐞#= QH1$: SQH2$ = QH2$: SLH$ = LH$: SRL$ = RL$: SRH$ = RH$: SCL$ = CL$: SCH$ = CUH$ 9230 DAEN$ = (LEFT$(DATE$, 2) + MID$(DATE$, 4, 2)): DAEN = VAL(DAEN$) 9240 IF TES = 252 OR QC = 2 THEN MID$(SRH$, 1 + (DERENH - 1) * 6, 6) = MKI$(DAEN) + MKS$(P3!(IND)) ELSE MID$(SRL$, 1 + (DERENL - 1) * 6, 6) = MKI$(DAEN) + MKS$(P3!(IND)) 9250 IF (TES = 253 OR QC = 1) AND NOMBL = 10 THEN 9260 ELSE 9270 9260 CUS! = 0: FOR YT = 1 TO 10: SOM! = CVS(MID$(SRL$, 3 + (YT - 1) * 6, 4)): CUS! = CUS! + SOM!: NEXT YT: SCL$ = MKS$(CU㐞#S! / 10): GOTO 9290 9270 IF (TES = 252 OR QC = 2) AND NOMBH = 10 THEN 9280 ELSE 9290 9280 CUS! = 0: FOR YT = 1 TO 10: SOM! = CVS(MID$(SRH$, 3 + (YT - 1) * 6, 4)): CUS! = CUS! + SOM!: NEXT YT: SCH$ = MKS$(CUS! / 10) 9290 LSET QL1$ = SQL1$: LSET QL2$ = SQL2$: LSET LL$ = SLL$: LSET QH1$ = SQH1$: LSET QH2$ = SQH2$: LSET LH$ = SLH$: LSET RL$ = SRL$: LSET RH$ = SRH$: LSET CL$ = SCL$: LSET CUH$ = SCH$ 9300 PUT #1, MEM: CLOSE #1 9310 GOSUB 7100: RETURN 9320 'routine de duplication et impression resultats plat㐞#eau & urgences & redilutions 9330 GOSUB 470: BAK = 1: PLUSIEUR = 0: FOR ET% = 1 TO CINT((O2 / 16) + .05): GET #1, ET%: ENR$(ET%) = A1$: NBCHAM% = ET% 9332 FOR AB% = 0 TO 15: ME = CVI(MID$(ENR$(ET%), 1 + (AB% * 6), 2)): GOSUB 8995: IF ME = 0 AND PAR(53) >= AB% + 1 + 16 * (ET% - 1) THEN BAK = BAK + 6: GOTO 9337 ELSE IF AB% = 0 THEN NOMB = ME: GOTO 9337'cherche si plusieur methodes a proposer 9333 IF ME = 0 THEN AB% = 15: ET% = CINT((O2 / 16) + .05): GOTO 9337 9334 MEM = ME AND 31: MEMU = (ME AND 480) / 32㐞 #: PLA = (ME AND 15872) / 512 9335 MEMUB = (NOMB AND 480) / 32: PLAB = (NOMB AND 15872) / 512 9336 IF MEMU <> MEMUB OR PLA <> PLAB OR (MEMU = 0 AND AB% > 0) THEN PLUSIEUR = 1':AB%=12 9337 NEXT AB%: NEXT ET%: CLOSE #1: IF MEMUB THEN MULTIT = 1 ELSE MULTIT = 0 9338 MEMU = 0: IF CHOIX <> 0 THEN RETURN 9340 RESTORE 7045: GOSUB 3130: GOSUB 7230: L = 4: C = 2: MASK = 1'ecran duplic 9345 FONCT = 134 + 2 ^ 5: GOSUB 7240 9350 GOSUB 3380: ON J GOTO 9355, 9357, 9350, 9350, 9360, 9350, 9359, 9350, 9350, 9350 935㐞$5 CHOIX = 1: GOSUB 9330: GOTO 9370 9357 CHOIX = 2: GOSUB 9330: GOTO 9370 9359 COIX = 0: RETURN 9360 CHOIX = 5: GOSUB 9330 9370 RESTORE 7047: GOSUB 3130 9372 CHAM% = 1: IF PLUSIEUR OR (MULTIT = 1 AND CHOIX = 5) THEN COLOR 5, 0: LOCATE 20, 2: PRINT "Previous": LOCATE 20, 16: PRINT "Next": LOCATE 21, 5: PRINT "F1": LOCATE 21, 17: PRINT "F2": COLOR 1, 2 9375 GOSUB 9377: LOCATE 10, 1: IF (ME AND 2 ^ 14) <> 0 THEN PRINT "REPORT "; ELSE PRINT SPC(7); 9376 GOSUB 9382: GOTO 9385 9377 ME = CVI(MID$(ENR$(CHAM㐞$%), BAK, 2)): GOSUB 8995'methode a proposer en ecran duplicate 9380 MEM = ME AND 31: MEMU = (ME AND 480) / 32: PLA = (ME AND 15872) / 512: RETURN'method 9382 IF CHOIX <> 5 THEN 9383 ELSE PRINT "METHOD : "; B$(MEM); : IF MEMU THEN PRINT " MULTIPLE TEST "; MEMU; : GOTO 9384 ELSE PRINT " SINGLE METHOD "; : GOTO 9384 9383 PRINT "METHOD : "; : IF MEMU THEN PRINT LEFT$(MTT$(MEMU + 20), 6); " MULTIPLE TEST "; MEMU; ELSE PRINT B$(MEM); " SINGLE METHOD"; 9384 PRINT " TRAY NUMBER : "; PLA; SPACE$㐞$(10): GOSUB 7245: RETURN 9385 IF PLUSIEUR OR (MULTIT = 1 AND CHOIX = 5) THEN FONCT = 134 ELSE FONCT = 128 9386 MASK = 1: GOSUB 3380: ON J GOTO 9390, 9395, 9385, 9385, 9385, 9385, 9340, 9385, 9385, 9400 9390 IF BAK = 1 THEN BAK = 97: CHAM% = CHAM% - 1: IF CHAM% = 0 THEN CHAM% = NBCHAM% ELSE CHAM% = CHAM% ELSE IF BAK > 7 THEN MEBB = CVI(MID$(ENR$(CHAM%), BAK - 12, 2)): MEBB = ABS(MEBB) 9391 BAK = BAK - 6: MEB = CVI(MID$(ENR$(CHAM%), BAK, 2)): MEB = ABS(MEB): IF MEB = 0 THEN 9390 ELSE IF CHOIX = 5 THEN 937㐞$5 9392 MEMU = (MEB AND 480) / 32: IF MEMU <> 0 AND MEMU = (MEBB AND 480) / 32 AND PLA = (MEB AND 15872) / 512 THEN 9390 ELSE 9375 9395 BAK = BAK + 6: IF BAK > 91 THEN BAK = 1: CHAM% = CHAM% + 1: IF CHAM% > NBCHAM% THEN CHAM% = 1 9396 MEB = CVI(MID$(ENR$(CHAM%), BAK, 2)): MEB = ABS(MEB): IF MEB = 0 THEN BAK = 1: CHAM% = CHAM% + 1: IF CHAM% > NBCHAM% THEN CHAM% = 1: GOTO 9375 ELSE 9375 ELSE IF CHOIX = 5 THEN 9375 9399 IF MEMU <> 0 AND MEMU = (MEB AND 480) / 32 AND PLA = (MEB AND 15872) / 512 THEN 9395 ELS㐞$E 9375 9400 GOSUB 9830: IF DAC = 1 THEN COLOR 5, 0: LOCATE 20, 2: PRINT SPACE$(9): LOCATE 20, 16: PRINT " ": LOCATE 21, 5: PRINT " ": LOCATE 21, 17: PRINT " ": COLOR 1, 2: LOCATE 18, 10: PRINT SPACE$(55) ELSE RETURN 9402 IF CHOIX = 5 THEN 9857 9405 COLOR 5, 0: LOCATE 20, 50: PRINT "Stop": LOCATE 21, 51: PRINT "F5": COLOR 1, 2 9407 PLAVID = 0: FOR AB% = 1 TO 48: PL(AB%) = 0: P2(AB%) = 0: NEXT AB% 9410 GOSUB 7070: GET #1, MEM: B$(MEM) = T$: MTI$ = ST$: STI$ = TI$: UNI1$ = U1$: UNI2$ = U2$: DECI1㐞$ = VAL(D1$): DECI2 = VAL(D2$): COEF! = VAL(COF$): VALEI = VAL(E1$): VALES = VAL(E2$): CLOSE #1 9411 GOSUB 7137: GOSUB 7090: IF K1(78) = 0 AND CHOIX = 5 AND K1(6) < 3 THEN 9359 9412 IF CHOIX = 2 THEN DECI = DECI2 ELSE DECI = DECI1 9415 IF CHOIX <> 2 OR COEF! = 0 THEN COEF! = 1 9420 GOSUB 470: GOSUB 9900 'p2,p3,pl 9422 FOR ER% = 2 TO 48: IF PL(ER%) > 0 AND PL(ER%) < 254 THEN 9425 9423 NEXT ER%: PLAVID = 1: IF CHOIX = 5 THEN 9490 ELSE RT = 48: GOTO 9690 9425 ' 9426 KFA = P2(ER%) AND 2 ^ 2: IF MEMU㐞$ THEN AR$ = B$(MEM) + " / " + LEFT$(MTT$(MEMU + 20), 6) + SPACE$(17) ELSE AR$ = B$(MEM) + SPACE$(26) 9427 GOSUB 9710: AR$ = STI$: GOSUB 9710: AR$ = MTI$: GOSUB 9710 9430 GOSUB 485: GET #1, MEM: TEMP$ = T1$: CLOSE #1 9440 GOSUB 9780 9442 IF CHOIX <> 5 THEN 9450 ELSE IF KFA <> 0 THEN 9447 9444 IF K1(6) = 5 OR K1(6) = 6 OR K1(6) = 10 THEN CORFAC! = SLOPE!: CORBLA! = INTERC! ELSE NSLOP! = K1(78) / SLOPE!: QUAT = K1(78) * VALANAL1: QUIN = NSLOP! * VALTHEO1: CORFAC! = (1 / NSLOP!): CORBLA! = (QUAT + K1(79) -㐞$ QUIN) / NSLOP! 9445 ' 9447 ' 9448 ' 9450 IF PAR(20) THEN GOSUB 7120: GET #2, 1: PARPAT$ = CH$: CLOSE #2: GOSUB 7100 ELSE 9490 9460 FOR IN% = 1 TO 128: IF ASC(MID$(PARPAT$, IN%, 1)) = 0 THEN IN% = 128: GOTO 9480 9470 GET #1, ASC(MID$(PARPAT$, IN%, 1)): NOM$(IN%) = NM$ 9480 NEXT IN%: CLOSE #1 9490 FOR RT = 1 TO 48: IF CHOIX = 5 AND (PL(RT) = 254 OR PL(RT) = 255) THEN 9555 ELSE IF (P2(RT) AND 2 ^ 2) <> 0 AND (PL(RT) = 254 OR PL(RT) = 255) THEN 9690 9495 A$ = INKEY$: IF A$ = CHR$(134) THEN GOSUB 7270:㐞 $ RT = 48: BAK = 99: GOTO 9690 9500 IF PL(RT) = 0 THEN 9690 9510 IF PL(RT) < 251 THEN IMPR$ = NOM$(PL(RT)) ELSE IF PL(RT) = 252 THEN IMPR$ = "QC 2" ELSE IF PL(RT) = 253 THEN IMPR$ = "QC 1" ELSE IMPR$ = "Sample X" 9520 IF PL(RT) = 254 THEN 9690 9540 ' 9550 ' 9555 IF CHOIX = 5 THEN P2(RT) = (P2(RT) OR 2 ^ 2): P3!(RT) = SLOPE! * P3!(RT) + INTERC!: IF PL(RT) = 254 OR PL(RT) = 255 THEN 9690 9557 IF (P2(RT) AND 2 ^ 4) <> 0 THEN 9690 9560 IF (P2(RT) AND 2 ^ 3) <> 0 THEN 9690 9570 IF (P2(RT) AND 2 ^ 14) <> 㐞$0 THEN 9690 9572 P3! = P3!(RT) * COEF!: IF K1(6) < 3 OR K1(6) = 5 OR K1(6) = 6 OR K1(6) = 10 THEN 9573 ELSE 9576 9573 IF CHOIX <> 5 THEN 9580 ELSE IF (P2(RT) AND 2 ^ 10) <> 0 THEN P2(RT) = P2(RT) XOR 2 ^ 10 9574 IF P3! * SGN(K1(39)) >= K1(39) THEN P2(RT) = P2(RT) OR 2 ^ 10 9576 IF CHOIX <> 5 OR RT < 17 OR PL(RT) > 251 OR PL(RT) = (PAR(58) AND 255) OR PL(RT) = (PAR(58) AND 32512) / 256 OR (P2(RT) AND 2 ^ 12) <> 0 THEN 9580 9577 IF (P2(RT) AND 2 ^ 5) <> 0 THEN P2(RT) = P2(RT) XOR 2 ^ 5 9578 IF (P3! < K1㐞$(34) OR P3! > K1(100)) AND (K1(34) <> 0 OR K1(100) <> 0) THEN P2(RT) = P2(RT) OR 2 ^ 5 9580 IF ((P2(RT) AND (2 ^ 6 + 2 ^ 8 + 2 ^ 9 + 2 ^ 10)) <> 0) OR ((P2(1) AND 2 ^ 5) <> 0 AND RT = 1) THEN 9620 9590 TA = 19: GOSUB 9730 9592 ' 9593 ' 9594 ' 9595 ' 9600 ' 9610 GOTO 9690 9620 IF ((P2(RT) AND 2 ^ 10) = 0) THEN 9625 9625 ' 9630 IF ((P2(RT) AND 2 ^ 9) = 0) THEN 9640 9640 RESTORE 9705: FOR YT = 8 TO 6 STEP -1: READ MA$ 9650 NEXT YT 9680 ' 9690 NEXT RT: IF PLAVID = 0 THEN GOSUB 9990 9692 IF CHOIX㐞$ = 5 THEN CORRIG = 1: GOSUB 470: GOSUB 9900: CHOIX = 0: CORRIG = 0: GOTO 9359 9695 IF MEMU = 0 OR BAK = 91 THEN RETURN ELSE BAK = BAK + 6: ER = BAK: ME = CVI(MID$(ENR$(CHAM%), ER, 2)): GOSUB 8995'ds 1 multi,methode simple suivante 9700 IF ME = 0 OR (ME AND 480) / 32 <> MEMU OR (ME AND 15872) / 512 <> PLA THEN RETURN ELSE GOSUB 9377: GOTO 9407 9705 DATA " FAL"," SIC"," IAL" 9710 IF AR$ = SPACE$(LEN(AR$)) THEN RETURN ELSE LON = 0: FOR TY = 32 TO 1 STEP -1: IF MID$(AR$, TY, 1) = CHR$(0) OR MID$(AR$, TY, 1)㐞$ = CHR$(32) THEN LON = TY - 1 ELSE TY = 1 9720 NEXT TY: RETURN 9730 DECIB = DECI 9735 IF ABS(P3!) / 10 ^ (6 - DECIB) < 1 THEN 9737 ELSE DECIB = DECIB - 1: GOTO 9735 9737 IF P3! < 0 AND DECIB > 0 THEN DECIB = DECIB - 1 9740 ' 9750 RETURN 9760 ' 9770 RETURN 9780 ' 9790 ' 9800 IF K1(6) = 4 THEN RETURN 9810 ' 9812 'GOSUB 9730: 9815 IF CHOIX = 2 THEN CHOIXB = 2: UNI$ = UNI2$ ELSE CHOIXB = 1: UNI$ = UNI1$ 9820 ' 9822 ' 9824 RETURN 9830 DAC = 0: GOSUB 7095: GET #1, (MEM - 1) * 100 + 6: K = CVS(A2㐞$$): CLOSE #1: IF K = 4 OR (CHOIX = 5 AND (K = 3 OR K = 12)) THEN RETURN 9835 DAC = 1: RETURN 9850 FONCT = 128: MASK = 15: VALMIN = -32500: VALMAX = 32500: RETURN 9857 LOCATE 10, 1: PRINT SPACE$(24); "CORRECTION CONTROL NUMBER ONE"; SPACE$(27): LOCATE 12, 5: GOSUB 7250 9860 GOSUB 9850: L = 12: C = 21: LOCATE L, C, 1: GOSUB 3380: IF J = 7 THEN 9359 ELSE VALTHEO1 = Q: LOCATE 12, 50: GOSUB 7255 9865 GOSUB 9850: C = 69: GOSUB 3380: IF J = 7 THEN 9359 ELSE VALANAL1 = Q 9867 LOCATE 16, 25: PRINT "CORRECTION 㐞$CONTROL NUMBER TWO": LOCATE 18, 5: GOSUB 7250 9870 GOSUB 9850: L = 18: C = 21: GOSUB 3380: IF J = 7 THEN 9359 ELSE VALTHEO2 = Q: LOCATE 18, 50: GOSUB 7255 9875 GOSUB 9850: C = 69: GOSUB 3380: IF J = 7 THEN 9359 ELSE VALANAL2 = Q: LOCATE 4, 2, 0 9877 IF (VALANAL1 = VALTHEO1 AND VALANAL2 = VALTHEO2) OR VALTHEO1 = VALTHEO2 OR VALANAL1 = VALANAL2 THEN 9359 9880 SLOPE! = (VALTHEO1 - VALTHEO2) / (VALANAL1 - VALANAL2): INTERC! = VALTHEO1 - (VALANAL1 * SLOPE!) 9890 GOTO 9405 'impressioN 9900 PRIM% = 5 + ((((㐞$CHAM% - 1)) * 16) + (BAK - 1) / 6) * 48 9910 FOR ES = PRIM% TO PRIM% + 47 9920 ESSI = ES 9930 GET #1, ESSI: ECH = ASC(LEFT$(A1$, 1)): IF CORRIG THEN AB1$ = A1$: MID$(AB1$, 101, 4) = MKS$(P3!(ECH)): MID$(AB1$, 99, 2) = MKI$(P2(ECH)): LSET A1$ = AB1$: PUT #1, ESSI: GOTO 9960 9940 PL(ECH) = ASC(MID$(A1$, 2, 1)): P2(ECH) = CVI(MID$(A1$, 99, 2)) 9950 P3!(ECH) = CVS(MID$(A1$, 101, 4)): PLA(ECH) = 1 9960 NEXT ES: CLOSE #1: RETURN 9990 FOR ER = 1 TO 7: NEXT ER: RETURN 10101 METC = 0: METIND = 0 10103 IF FR㐞$EL = 0 OR FDEL <> 0 THEN 10400'relance d'apres les P2 ou delete reste du plateau 10105 IF FRER = 1 AND FMEL = 0 THEN 10400'flag de rerun 10110 IF FWL = 0 THEN 10400'plateau avec wl 10115 IF MEMU THEN METC = MEMU + 20 ELSE METC = MEM'meth a reserver 10120 IF METC = PAR(8) THEN METIND = 1: GOTO 10145 10125 IF METC = PAR(9) THEN METIND = 2: GOTO 10145 10130 IF PAR(8) = 0 THEN METIND = 1: GOTO 10180 10132 IF PAR(9) = 0 THEN METIND = 2: GOTO 10180 10135 GOSUB 10500: GOTO 10400'deja 2 methodes 10137 GOSU㐞 $B 10500: GOTO 10400'deja 4 plateaux prememos 10145 FOR QW% = 1 TO 4: IF (PAR(41 + (METIND - 1) * 4 + QW%) AND 511) = 256 + PLA THEN 10400 10148 NEXT QW% 10150 IF METIND = 1 THEN MASQ = 15 ELSE MASQ = 3840 10155 IF (PAR(35) AND MASQ) = MASQ THEN 10137 10165 ANC = PAR(37 + METIND) - 1: IF ANC = 0 THEN ANC = 4 10167 GOTO 10184 10180 PAR(7 + METIND) = METC 10182 PAR(9 + METIND) = 1: ANC = 1 10184 GOSUB 10540 10200 IF MEMU THEN MEBA = PLA + ((MEMU + 20) * 1024) ELSE MEBA = PLA + (MEM * 1024) 10400 RET㐞%URN 10500 IF METC > 20 THEN GOSUB 10700: RETURN ELSE GOSUB 10600: RETURN 10540 PAR(37 + METIND) = ANC'raj ptrs pargen 10542 PAR(41 + (METIND - 1) * 4 + ANC) = 512 + 256 + PLA + (1024 * REDIL) 10544 PAR(35) = PAR(35) OR 2 ^ ((METIND - 1) * 8 + ANC - 1) 10545 PAR(16) = METIND 10546 RETURN 10600 GOSUB 10800: RETURN 10700 GOSUB 10800: RETURN 10800 RETURN 11000 FOR IC = 1 TO 4 11005 GET #1, IC 11010 IF FLG$ = "1" AND IC = 4 THEN CLOSE #1: GOTO 4060 ELSE IF FLG$ = "1" THEN 11020 ELSE METX = VAL(ME$): 㐞%GOTO 11500 11020 NEXT IC 11500 OPEN "r", #4, "ruse", 1: FIELD #4, 1 AS RU$ 11510 GET #4, IC: IF RU$ = "0" THEN LSET RU$ = R$: PUT #4, IC: CLOSE #4: RETURN ELSE GOTO 11600 11600 LSET FLG$ = R$: PUT #1, IC: CLOSE #1: RETURN 15000 DATEF$ = DATE$: RETURN 15100 FOR KT = 1 TO 4000: NEXT KT: RETURN 30000 OPEN "r", #1, "NAMETH", 105 30010 FIELD #1, 6 AS A1$, 6 AS D$, 32 AS A2$, 32 AS A3$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$ 30020 FOR I = 1 TO 32 30030 GET #1, I 30040 B$(㐞%I) = A1$: MTT$(I) = A3$ 30050 NEXT I: CLOSE #1: RETURN = 1 TO 4: IF (PAR(41 + (METIND - 1) * 4 + QW%) AND 511) = 256 + PLA THEN 10400 10148 NEXT QW% 10150 IF METIND = 1 THEN MASQ = 15 ELSE MASQ = 3840 10155 IF (PAR(35) AND MASQ) = MASQ THEN 10137 10165 ANC = PAR(37 + METIND) - 1: IF ANC = 0 THEN ANC = 4 10167 GOTO 10184 10180 PAR(7 + METIND) = METC 10182 PAR(9 + METIND) = 1: ANC = 1 10184 GOSUB 10540 10200 IF MEMU THEN MEBA = PLA + ((MEMU + 20) * 1024) ELSE MEBA = PLA + (MEM * 1024) 10400 RETZ>%㐞%1 ' 2 '************************************************************* 5 ' programme pret a etre compile RDCP 27.10.88 6 ' restart+delete 7 '************************************************************* 8 'charg. plat.,modif 2 rn part+tab m()+4 trays+cl in+a-g 10 DEFINT A-J, N-U, W-Z 15 DIM P64(64), LE%(48), PLACE(48), PAR(60), B$(32), MTT$(32) 16 DIM PL(50), PLP(50), PLS(50), PLM(50), PLPM(50), PRED(8) 17 DIM PLB(50), PLPB(50), PLMB(50), PLPMB(50) 20 DIM K1(100), NMLI$(32), MUL(9㐞%), L(5), C(5), TCAL(10) 30 COMMON STATUS, METH%, P64(), LE%(), PLACE(), O1!, C1!, O2, C2, AIG1, AIG3, PAR(), M%, M1%, RE, VER%, BUT, PAS, PA$, LIGNE%, METP%, DEMET, LIMI%, NONL$, TEMPER$, DATEF$, RSTART, STAT, INTMETH, CALB, METCO, MULTI 31 LPRINT "in rdcp": GOSUB 30000: F9% = 2 ^ 8: RIV = 1: MA% = 0: GOSUB 600: GOSUB 9240: IF ((PAR(22) AND 992) / 32) THEN INTMETH = (PAR(22) AND 992) / 32: GOTO 12000 ELSE INTMETH = (PAR(22) AND 31): GOTO 12000 34 LOCATE 24, 13: PRINT SPACE$(55): LOCATE 25, 16: PRINT SPAC㐞%E$(39); : RETURN 35 C = 33 - INT(LEN(PA$) / 2) 36 GOSUB 592: CLOSE : IF PA$ = "LTCP" THEN 40 38 RSTART = 0: STAT = 0: INTMETH = 0: CALB = 0: METCO = 0: MULTI = 0 40 VFREE = FRE(""): CHAIN PA$ 100 READ A$ 105 IF LON = 0 THEN 110 106 IF A$ = "" THEN A$ = " " 107 N = INT(LEN(A$) / 2): RETURN 110 PRINT A$; : LON = 0: RETURN 120 GOSUB 600: COLOR 5, 0: LOCATE 1, 20, 0: PRINT SPACE$(40): LOCATE 2, 30: PRINT SPACE$(20): COLOR 1, 2 121 IF (PRETR AND APRET) AND NO = 0 THEN 122 ELSE NO = 0: IF NON 㐞%= 0 THEN GOSUB 602 ELSE NON = 0 122 COLOR 5, 0: C12 = 5: FOR I = 1 TO 7: READ A$: CUR = 11 * (I - 1) + INT(.4 * I) 160 IF I > 1 THEN LOCATE 20, 2 + CUR ELSE LOCATE 20, 1 + CUR 162 A3$ = SPACE$(5 - LEN(A$) / 2) + A$: A$ = A3$ + SPACE$(10 - LEN(A3$)): PRINT A$ 164 LOCATE 21, C12 - 2 165 IF A$ = SPACE$(10) THEN PRINT " ": GOTO 168 166 IF (SUP% AND 2 ^ (I - 1)) = 2 ^ (I - 1) THEN PRINT " S F" + RIGHT$(STR$(I), 1): GOTO 168 167 PRINT " F" + RIGHT$(STR$(I), 1) + " " 168 C12 = C12 + 11 + CINT(I / 2 -㐞 % INT(I / 2)): NEXT I 169 L(1) = 24: C(1) = 7: L(2) = 24: C(2) = 75: L(3) = 1: C(3) = 39: L(4) = 1: C(4) = 6: L(5) = 2: C(5) = 40 170 FOR I = 8 TO 12: LON = 1: GOSUB 100: LOCATE L(I - 7), C(I - 7) - N: GOSUB 110: NEXT I 205 IF PASSAG AND PAR(34) <> 64 THEN A1$ = " Start ": A2$ = " F8 " ELSE A1$ = SPACE$(11): A2$ = SPACE$(11) 210 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 1: GOSUB 110: A$ = A2$: LOCATE 25, 1: GOSUB 110 220 IF STATUS <> 9 OR NOSAMP OR NOSAM THEN A1$ = SPACE$(11): A2$ = SPACE$(11)㐞% ELSE A1$ = " Abort ": A2$ = " S F9 " 225 LON = 1: A$ = A1$: GOSUB 105: LOCATE 24, 70: GOSUB 110: A$ = A2$: LOCATE 25, 70: GOSUB 110 226 COLOR 1, 2: SUP% = F9%: RETURN 592 DAT% = &HFF40: GOTO 594 593 DAT% = &HBF00 594 DOV% = &H32: cim% = &HF: CALL IO(DOV%, cim%, DAT%, RET%): RETURN 595 CALL HAR: RETURN 600 CALL CLA(MA%, SUP%): RETURN 601 DOV% = &H32: cim% = 5: RET% = 0: CALL IO(DOV%, cim%, DAT%, RET%): RETURN 602 VIEW PRINT 3 TO 19: CLS : VIEW PRINT: IF FRECU THEN LOCATE 25, 16: PRINT 64 -㐞% PAR(34); : RETURN ELSE RETURN 610 PA$ = "maincp": GOTO 35 625 IF AIG1 THEN T1 = AIG1 ELSE M% = PAR(22) AND 31: GOSUB 5130: GET #1, (M% - 1) * 100 + 6: T1 = CVS(A1$): CLOSE #1 627 ON T1 GOTO 630, 630, 640, 660, 650, 650, 640, 640, 640, 660, 640, 640 630 IF BUT <> 0 THEN PA$ = "CALC1CP": GOTO 35 640 IF BUT <> 0 THEN PA$ = "CALC2CP": GOTO 35 650 IF BUT <> 0 THEN PA$ = "CALC3CP": GOTO 35 660 IF BUT <> 0 THEN PA$ = "CALC4CP": GOTO 35 670 PA$ = "ANAST": GOTO 35 740 REPO = 0: F$ = INKEY$: IF F$ = "" THEN㐞% 790 745 REIT = 0: IF F$ = CHR$(138) AND PAR(37) AND PAR(17) = 0 AND NOSAMP = 0 THEN GOSUB 810 750 IF (ENTREE AND 2 ^ REIT) THEN 755 ELSE 785 755 IF F$ = CHR$(130 + REIT) THEN REPO = REIT + 1: GOTO 790 785 IF REIT < 7 THEN REIT = REIT + 1: GOTO 750 790 RETURN 810 LOCATE 24, 30: PRINT " ABORT REQUESTED " ': QP$ = "STO" + CHR$(13) + CHR$(10) 813 'I = 1: DEV% = 52 816 'cim% = &H10: GOSUB 5157: IF RET% = 0 THEN 816 ELSE CHAR = ASC(MID$(QP$, I, 1)): cim% = 1: DAT% = CHAR 819 'GOSUB 5157: I = I + 1: 㐞%IF CHAR <> 10 THEN 816 822 'R$ = "": cim% = &HC: DAT% = 0: GOSUB 5157 825 'cim% = 2: DAT% = 0 828 'GOSUB 5157: CHAR = RET% 831 'IF CHAR = -1 THEN 828 ELSE R$ = R$ + CHR$(CHAR) 834 'IF CHAR <> 10 THEN 828 ELSE cim% = &HC: DAT% = 1: GOSUB 5157 1090 GOSUB 5135 1110 FOR I = 1 TO 28: GET #1, I: IF I > 20 THEN 1120 1115 B$(I) = A1$ + SPACE$(6): GOTO 1125 1120 NMLI$(I) = A2$: MTT$(I) = A3$ 1125 NEXT I: CLOSE #1: RETURN 1200 PLM(50) = 0: FOR IX = 1 TO 8 1201 IF MUL(IX) THEN PLM(50) = PLM(50) OR 2 ^ (IX 㐞%- 1) ELSE 1218 1203 FOR IJ = 2 TO 48 1204 IF (PLM(50) AND 2 ^ (IX - 1)) = 0 THEN 1218 1205 IF (PLM(IJ) AND 2 ^ (IX - 1)) THEN PLM(50) = PLM(50) XOR 2 ^ (IX - 1) 1217 NEXT IJ 1218 NEXT IX: LSET F4$ = MKI$(PLM(50)): PUT #3, 50: RETURN 1220 IF (PAR(35) AND 255) = 0 THEN PAR(8) = 0 1221 IF (PAR(35) AND 3840) = 0 THEN PAR(9) = 0 1222 FOR IN = 1 TO 2 1223 IF PAR(7 + IN) THEN 1225 1224 PAR(9 + IN) = 0: PAR(13 + IN) = 0: PAR(37 + IN) = 0 1225 NEXT IN: RETURN 1371 IX = 0 1372 IF IX > 3 THEN PIX = IX +㐞% 4 ELSE PIX = IX 1373 IF (PAR(35) AND 2 ^ PIX) = 0 THEN PAR(42 + IX) = 0 1374 IX = IX + 1: IF IX < 8 THEN 1372 1375 RETURN 2000 GOSUB 5145 2005 FOR IND = 1 TO 50: GET #3, IND 2006 IF STP THEN 2010 2007 IF REPORT THEN 2015 2010 GOSUB 4350 2015 PLB(IND) = CVI(F1$): PLMB(IND) = CVI(F4$): PLPB(IND) = CVI(F2$): PLPMB(IND) = CVI(F5$) 2017 IF MULTI = 0 AND PLB(IND) THEN PLMB(IND) = 1 2018 NEXT IND: CLOSE #3: PLM(49) = PLM(49) OR PLMB(49): IF PLM(49) THEN LECTURE = 3 ELSE LECTURE = 2 2019 RETURN 2020 G㐞%OSUB 5150: GOSUB 5152: GET #1, 1: RETURN 2021 C = 40: C = C - (LEN(BI$) / 2): LOCATE L, C, 0: PRINT BI$; : RETURN 2023 QP$ = Q$ + CHR$(13) + CHR$(10): GOSUB 5782: GOSUB 5790: RETURN 2040 ENR = ASC(MID$(CHA$, TES, 1)): GET #2, ENR 2045 DMR1 = CVI(MR1$): DMR2 = CVI(MR2$): RETURN 2050 IF BTS THEN RETURN ELSE GOSUB 2040: GOSUB 6960: GOSUB 2060: RETURN 2060 LSET MR1$ = MKI$(DMR1): LSET MR2$ = MKI$(DMR2): PUT #2, ENR: RETURN 2070 RESTORE 5095: FOR T = 1 TO OG: READ FIL$: NEXT T: RETURN 2080 RAZ$ = MKI$(0)㐞% + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) + MKI$(0) 2085 GOSUB 5147: FOR T = 1 TO 50: LSET FL1$ = RAZ$: PUT #3, T: NEXT T: CLOSE #3: RETURN 2100 BUTE = PAR(11 + METCO) 2105 IF BUTE = 0 THEN 2190 2110 IND = PAR(11 + METCO) 2115 TEL = 2 ^ ((IND - 1) + (8 * (METCO - 1))) 2120 IF (PAR(36) AND TEL) THEN PAR(11 + METCO) = IND: GOTO 2190 2125 IND = IND + 1: IF IND = 5 THEN IND = 1 2130 IF IND = BUTE THEN PAR(11 + METCO) = 0 ELSE 2115 2190 RETURN 2191 RETURN 'IF ERE% = 26 THEN RETURN ELSE GOSUB 2㐞 %192: Q$ = "INIT2": GOSUB 2023: GOSUB 5790: GOSUB 2193: RETURN 2192 RETURN 'Q$ = "IND": GOSUB 2023: RETURN 2193 RETURN 'Q$ = "OUD": GOSUB 2023: RETURN 2200 PAR(17) = 0: PAR(55) = 0 2203 IF METCO = 1 THEN TEL = 255 ELSE TEL = 3840 2205 IF (PAR(35) AND TEL) = 0 THEN PAR(7 + METCO) = 0 ELSE 2220 2210 IF PAR(16) <> METCO THEN 2220 2215 GOSUB 2260 2220 IF PAR(35) = PAR(36) THEN PAR(16) = 0 2230 GOSUB 2300: GOSUB 5665 2250 RETURN 2260 IF PAR(10 - METCO) THEN PAR(16) = 3 - METCO ELSE PAR(16) = 0 2265 RE㐞&TURN 2300 PAR(37) = 0 2305 FOR IND = 22 TO 31 STEP 3 2310 IF PAR(IND) <> 0 THEN PAR(37) = PAR(37) + 1 2315 NEXT IND 2320 RETURN 2335 OG = PAR(23) AND 15: GOSUB 2070: GOSUB 4000: RETURN 2350 IF (PAR(22) AND 992) = 0 THEN 2375 2355 TEBU = (PAR(22) AND 15360) / 1024: IF TEBU = 1 THEN 2375 2360 ALLM = 0: FOR T = 1 TO TEBU - 1: ALLM = ALLM + (2 ^ (T - 1)): NEXT T 2365 MULTI = (PAR(22) AND 992) / 32: PTD = 1: PTF = 48 2370 GOSUB 2335 2375 RETURN 2380 IF MULTI THEN ALLM = 2 ^ (((PAR(22) AND 15360) / 1㐞&024) - 1) ELSE ALLM = 0 2382 IF MULTI = 0 THEN TMA = 1 ELSE TMA = ALLM 2385 PLM(49) = PLM(49) AND (256 - TMA): IF TMA > 1 THEN GOSUB 5145: LSET F4$ = MKI$(PLM(49)): PUT #3, 49: CLOSE #3 2387 IF PAR(54) = 1 THEN 2420 2390 PTD = 1: PTF = PAR(54) - 1: IF PAR(54) > 49 THEN PTF = 48 2395 GOSUB 2335 2397 IF PAR(54) > 16 THEN PLM(49) = PLM(49) AND (255 - TMA) 2420 RETURN 2460 IF PAR(9 + METCO) THEN 2475 ELSE PAR(9 + METCO) = (PAR(23) AND 15) - ((METCO - 1) * 4) 2462 IF PAR(37) = 1 THEN 2475 2465 FOR IN =㐞& 2 TO PAR(37) 2467 IF MULTI = 0 THEN 2471 2468 IF M% <> (PAR(19 + (3 * IN)) AND 31) THEN 2473 2469 PAR(9 + METCO) = (PAR(20 + (3 * IN)) AND 15) - ((METCO - 1) * 4): GOTO 2473 2471 IF M% = (PAR(19 + (3 * IN)) AND 992) / 32 THEN 2469 2473 NEXT IN 2475 RETURN 2480 FOR IN = 0 TO PAR(37) - 1 2485 FOR T = 22 TO 24: PAR(T + (3 * IN)) = PAR(T + ((3 * (IN + 1)))): NEXT T 2487 NEXT IN 2490 FOR T = 1 TO 3: PAR(21 + T + (3 * PAR(37))) = 0: NEXT T: RETURN 2500 M% = (PAR(22) AND 992) / 32: MULTI = M%: IF 㐞&M% = 0 THEN M% = PAR(22) AND 31 2505 IF M% = PAR(8) THEN METCO = 1 ELSE METCO = 2 2510 IF (PAR(54) <> 0) OR (PAR(9 + METCO) = 0) THEN GOSUB 2460: PAR(13 + METCO) = (PAR(23) AND 2032) / 16: PAR(37 + METCO) = (PAR(23) AND 15) - ((METCO - 1) * 4) 2512 IF FINI THEN GOSUB 2260: PAR(54) = 0 ELSE IF PAR(54) <> 0 THEN PAR(16) = METCO: PAR(54) = 0 2515 PAR(11 + METCO) = 0 2525 PAR(17) = 0: PAR(36) = 0 2540 PAR(40) = 0: PAR(50) = 0: PAR(51) = 0: PAR(55) = 0 2545 GOSUB 2480 2550 RETURN 2560 IF MULTI THEN FOR 㐞&IND = 1 TO 8: MUL(IND) = VAL(MID$(NMLI$(MULTI), (IND * 3 - 1), 2)): NEXT IND: MUL(9) = 0 ELSE MUL(1) = M%: MUL(2) = 0 2565 RETURN 2600 GOSUB 5145: PL(50) = 0: AW = 50: BW = 1 2605 FOR IN = BW TO AW: IF IN > 48 THEN 2680 2610 IF IN > 16 THEN 2625 2615 IF PL(IN) THEN PL(50) = PL(50) + 256 2625 IF MULTI = 0 THEN 2650 2630 IF PLPM(IN) = 0 THEN PLP(IN) = 0 2640 IF (PLM(IN) OR PLP(IN)) = 0 THEN PL(IN) = 0 2645 IF IN < 17 THEN 2655 2650 IF PL(IN) THEN PL(50) = PL(50) + 1 2655 LSET F2$ = MKI$(PLP(IN)): L㐞&SET F5$ = MKI$(PLPM(IN)) 2670 IF K1(6) = 3 OR K1(6) = 12 OR ((K1(6) = 1 OR K1(6) = 2) AND K1(33) <> 0) AND IN = 1 THEN PL(1) = 254 ELSE IF K1(6) = 4 THEN PL(1) = 254: PL(2) = 254 2680 LSET F1$ = MKI$(PL(IN)): IF MULTI <> 0 OR (PLM(49) <> 0 AND IN = 49) THEN LSET F4$ = MKI$(PLM(IN)) 2685 PUT 3, IN: NEXT IN: GOSUB 1200: CLOSE 3: RETURN 2690 GOSUB 2600: GOSUB 2695: RETURN 2695 IF (PL(50) AND 255) THEN 2699 2696 IF (PL(50) AND 3840) > 1 THEN 2699 2697 HB = 0: IF OG > 4 THEN HB = 8 2698 PAR(35) = PAR(35)㐞& XOR 2 ^ (HB + OG - 1) 2699 RETURN 2700 GOSUB 2350: IF OG = 0 THEN 2705 2702 IF (MULTI <> 0) AND (TEBU > 1) THEN GOSUB 2690 2705 GOSUB 2380: IF OG = 0 THEN 2715 2710 GOSUB 2690 2715 RETURN 2800 STP = 1: GOSUB 3230: IF CALCONT = 1 THEN GOSUB 3240 ELSE LOCATE 15, 5: PRINT SPACE$(70): PRINT SPACE$(80): GOSUB 3220: IF STAT = 0 THEN RSTART = 1: IF FINI = 0 THEN L = 25: BI$ = "RESTART REQUEST": GOSUB 2021: GOSUB 4100 2801 BTS = 1: IF PAR(37) = 0 THEN 2870 2805 IF PAR(54) THEN GOSUB 2700 2810 GOSUB 2500 㐞& 2815 PAR(37) = PAR(37) - 1: GOTO 2801 2870 GOSUB 1220: IF FINI = 1 THEN GOSUB 1371 2871 BTS = 0: IF STAT <> 0 OR FINI = 1 THEN RSTART = 0: GOTO 2873 ELSE VER% = 10: STATUS = 8: PREMI = 1 2872 METH% = MULTI: IF MULTI = 0 THEN M% = MUL(1): METH% = M% 2873 PAR(57) = 0: GOSUB 5665: PAS = 0: STP = 0: FINI = 0: GOSUB 6798: GOTO 13000 2900 PA$ = "diagcp": GOTO 35 2995 IF MULTI = 0 THEN RMONO = 1 ELSE RMONO = (PAR(22) AND 15360) / 1024 2996 RETURN 3000 STP = 0: GOSUB 3220: DELE = 1: GOSUB 6797 3005 MULTIB㐞 & = 0: NTB = 0: MONOB = 0 3010 FOR IN = 1 TO PAR(37) 3011 PDEL = 1: IF IN = 1 THEN GOSUB 2995 ELSE PDEL = 0 3015 MULTI = (PAR(19 + (3 * IN)) AND 992) / 32 3020 IF MULTI = 0 THEN MONO = PAR(19 + (3 * IN)) AND 31 3025 NT = PAR(20 + (3 * IN)) AND 15 3030 IF MULTI = 0 THEN IF MONO = MONOB THEN 3040 ELSE 3050 3035 IF MULTI <> MULTIB THEN 3050 3040 IF NT = NTB THEN 3060 3050 NTB = NT: MULTIB = MULTI: MONOB = MONO 3055 OG = NT: GOSUB 2070: PTD = 1: PTF = 48: ALLM = 0: GOSUB 4000: GOSUB 2080 3060 㐞&NEXT IN 3065 PAR(35) = PAR(35) XOR PAR(36): PAR(36) = 0 3070 GOSUB 1220 3097 FOR IN = 22 TO 33: PAR(IN) = 0: NEXT IN 3100 PAR(12) = 0: PAR(13) = 0 3105 PAR(17) = 0: PAR(37) = 0 3110 PAR(40) = 0: PAR(50) = 0: PAR(51) = 0: PAR(54) = 0: PAR(55) = 0 3112 GOSUB 1371 3115 IF PAR(7 + PAR(16)) THEN 3125 3120 IF PAR(10 - PAR(16)) THEN PAR(16) = 3 - PAR(16) ELSE PAR(16) = 0 3125 IF PAR(16) THEN STATUS = 8 3126 GOSUB 4515: GOSUB 5665: PAS = 0: STP = 0: GOSUB 6799: GOTO 610 3150 GOSUB 3220: L = 25: BI$ = "S㐞&TAT REQUEST": GOSUB 2021: STAT = 1: GOTO 2800 3200 PAR(34) = 64: AIG1 = 0: AIG3 = 0: GOSUB 3215: MULTI = (PAR(22) AND 992) / 32: M% = PAR(22) AND 31: GOSUB 2560: ABORTE = 1: CALCONT = 0: IF (PAR(54) = 50 OR PAR(54) = 51) AND PAR(40) = 0 THEN FINI = 1 3201 IF PAS = 16 OR FINI = 1 THEN RESTORE 5011 ELSE RESTORE 5010: SUP% = F9% + 2 ^ 2 + 2 ^ 5: GOSUB 600 3202 GOSUB 120: IF ERE% = 0 THEN 3204 ELSE L = 25: IF ERE% = 29 THEN BI$ = SPACE$(8) + ZI$ ELSE BI$ = "ERROR : " + ZI$ 3203 GOSUB 2021 3204 L = 7: BI$ =㐞& "Method Aborted": GOSUB 2021 3205 IF PAS = 16 THEN 3000 ELSE IF FINI = 1 THEN L = 10: BI$ = "Method Ended": GOSUB 2021: GOTO 2800 3206 ENTREE = 1 + 2 + 4 + 32: GOSUB 740 3210 GOTO 2800 'IF REPO=0 THEN 3205 ELSE ON REPO GOTO 2800,2900,3150,3205,3205,3000,3205,3205,3205 3215 GOSUB 5142: GET #1, 1: ERE% = CVI(LEFT$(E$, 2)): GET #1, ERE%: ZI$ = E$: CLOSE #1: RETURN 3220 L = 25: BI$ = SPACE$(32): GOSUB 2021: GOSUB 5142: LSET E$ = MKI$(0) + SPACE$(21): PUT #1, 1: CLOSE #1: ERE% = 0: RETURN 3230 IF PAR(54) 㐞&= 50 THEN CALCONT = CALCONT + 1 3235 RETURN 3240 L = 15: BI$ = "Calibration Controls will be not Re-Analysed": GOSUB 2021: RETURN 3300 IF DELE = 0 THEN 3308 3304 IF (PDEL = 0) THEN 3308 3305 IF NJ < RMONO THEN 3315 3306 IF NJ > RMONO THEN 3308 3307 IF ECH < PAR(54) THEN 3315 3308 TES = PL(ECH): IF MULTI = 0 THEN 3310 3309 IF (PLM(ECH) AND 2 ^ (NJ - 1)) = 0 THEN 3315 3310 GOSUB 2050 3315 RETURN 3400 RETURN 3500 IF MULTI = 0 THEN PL(ECH) = 0: GOTO 3520 3510 PLM(ECH) = PLM(ECH) AND (255 - (2 ^ (N㐞&J - 1))): IF PLM(ECH) = 0 THEN PL(ECH) = 0 3520 RETURN 3590 IF PL(IND) <> 255 THEN 3599 3591 IF PRETR = 0 THEN IF (PLPM(IND) AND (2 ^ (NJ - 1))) = 0 THEN 3599 3592 PLP(IND) = 0: PLPM(IND) = 0: PL(IND) = 0: PLM(IND) = 0 3593 PLPM(ECH) = PLPM(ECH) AND (255 - (2 ^ (NJ - 1))): IF PLPM(ECH) = 0 THEN PLP(ECH) = 0 3599 RETURN 3600 IF ECH < 17 THEN 3650 3605 FOR IND = 1 TO 16 3610 IF PLP(IND) = ECH THEN GOSUB 3590 3615 NEXT IND 3650 RETURN 3700 RETURN 3900 IF MULTI = 0 THEN NJ = 1: GOTO 3925 ELSE NJ =㐞& 0 3910 NJ = NJ + 1: IF NJ > 8 THEN 3950 3915 IF ALLM = 0 THEN 3925 3920 IF (ALLM AND 2 ^ (NJ - 1)) = 0 THEN 3910 3925 M% = MUL(NJ) 3930 FOR ET = 1 TO 6 3935 IF (MAS AND 2 ^ (ET - 1)) = 0 THEN 3945 3940 ON ET GOSUB 3300, 3400, 3500, 3600, 3700 3945 NEXT ET: IF MULTI THEN 3910 3950 RETURN 4000 GOSUB 2020: GOSUB 2000 4003 FOR ECH = PTD TO PTF: MAS = 0 4005 IF PL(ECH) = 0 THEN 4020 4010 IF PL(ECH) < 251 THEN MAS = 5: GOTO 4020 4015 IF PL(ECH) <> 255 THEN MAS = 4 4020 IF PLP(ECH) = 255 THEN㐞& MAS = MAS OR 8 4030 GOSUB 3900 4035 NEXT ECH: CLOSE #1: CLOSE #2: CLOSE #3: RETURN 4100 IND = 1: CALB = 0 4105 M% = MUL(IND): GOSUB 5160: GOSUB 11100: IF CAL THEN CAL = 0: CALB = 1: GOTO 4110 ELSE IND = IND + 1: IF MUL(IND) = 0 THEN RETURN ELSE GOTO 4105 4110 KN = 0: FOR T% = 1 TO 10: TCAL(T%) = 0: NEXT T%: RETURN 4350 PL(IND) = CVI(F1$): PLM(IND) = CVI(F4$): PLP(IND) = CVI(F2$): PLPM(IND) = CVI(F5$) 4352 IF MULTI = 0 AND PL(IND) THEN PLM(IND) = 1 4354 RETURN 4510 NBCHAM% = INT(PAR(52) / 16.0001)㐞& + 1: GOSUB 5153: RETURN 4515 GOSUB 5140: GET #1, 52: PAR(52) = CVI(P1$): CLOSE #1: IF PAR(52) = 0 THEN RETURN ELSE GOSUB 4510: NUME = ((PAR(52) - 1) - ((NBCHAM% - 1) * 16)): GET #1, NBCHAM%: TA$ = AB$: MID$(TA$, 5 + (NUME * 6), 2) = MKI$(1): LSET AB$ = TA$: PUT #1, NBCHAM% _ : CLOSE #1: RETURN 5010 DATA Restart,Mainten.,Stat,,,Delete,,,,Abort Menu,, 5011 DATA ,,,,,,,,,Abort Menu,, 5095 DATA tray11,tray12,tray13,tray14 5100 DATA tray21,tray22,tray23,tray24 5130 OPEN "r", 1, "method", 4: FIELD 1, 4 AS㐞 & A1$: RETURN 5132 OPEN "r", #1, "nameth", 105: FIELD #1, 105 AS A1$: RETURN 5135 OPEN "r", #1, "nameth", 105: FIELD #1, 6 AS A1$, 6 AS AA1$, 32 AS A2$, 32 AS A3$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS E1$, 5 AS E2$: RETURN 5140 OPEN "R", #1, "PARGEN", 2: FIELD #1, 2 AS P1$: RETURN 5142 OPEN "r", #1, "erreur", 23: FIELD #1, 23 AS E$: RETURN 5145 OPEN "r", #3, FIL$, 14: FIELD #3, 2 AS F1$, 2 AS F2$, 2 AS F3$, 2 AS F4$, 2 AS F5$, 2 AS F6$, 2 AS F7$: RETURN 5147 OPEN "r", #3, FIL$, 14: FIELD #3, 14㐞' AS FL1$: RETURN 5150 OPEN "r", #2, "paille", 206: FIELD #2, 12 AS NM$, 2 AS M1$, 2 AS M2$, 2 AS MR1$, 2 AS MR2$, 120 AS P$, 6 AS M2P$, 18 AS P2P$, 42 AS RP$: RETURN 5152 OPEN "r", #1, "descpai", 128: FIELD #1, 128 AS CHA$: RETURN 5153 OPEN "r", #1, "absorb", 106: FIELD #1, 106 AS AB$: RETURN 5157 CALL IO(DEV%, cim%, DAT%, RET%): RETURN 5160 GOSUB 5130: FOR IN = 1 TO 100: GET #1, (M% - 1) * 100 + IN 5175 K1(IN) = CVS(A1$): NEXT IN: CLOSE #1: RETURN 5270 GOSUB 5140: FOR T = 1 TO 60 5280 GET #1, T: PA㐞'R(T) = CVI(P1$): NEXT T: CLOSE #1: RETURN 5665 GOSUB 5140 5685 FOR T = 1 TO 60: LSET P1$ = MKI$(PAR(T)): PUT #1, T: NEXT T 5690 CLOSE #1: RETURN 5782 U = 1: DEV% = 52 5783 cim% = &H10: GOSUB 5157: IF RET% = 0 THEN 5783 ELSE DAT% = ASC(MID$(QP$, U, 1)): cim% = 1 5784 GOSUB 5157: U = U + 1 5785 IF DAT% <> 10 THEN 5783 ELSE RETURN 5790 R$ = "": cim% = &HC: DAT% = 0: GOSUB 5157: cim% = 2: DAT% = 0 5791 GOSUB 5157: IF RET% = -1 THEN 5791 5792 R$ = R$ + CHR$(RET%): IF RET% <> 10 THEN 5791 5793 cim% = &㐞'HC: DAT% = 1: GOSUB 5157: RETURN 6797 L = 25: BI$ = "Delete": GOSUB 2021: RETURN 6798 L = 25 6799 BI$ = SPACE$(40): GOSUB 2021: RETURN 6800 STP = 1 6805 FOR PLAT = 1 TO 4 6810 IF METCO = 1 THEN OG = PLAT ELSE OG = PLAT + 4 6815 GOSUB 2070 6820 ORDRE = (PLAT - 1) + 8 * (METCO - 1): IF (PAR(35) AND 2 ^ ORDRE) = 0 THEN 6890 6825 IF PAR(36) AND 2 ^ ORDRE THEN 6890 6830 PTD = 1: PTF = 48: ALLM = 0 6835 GOSUB 4000: GOSUB 2080 6840 PAR(35) = PAR(35) XOR 2 ^ ORDRE 6890 NEXT PLAT 6895 PAR(9 + METCO) = 㐞'0: PAR(37 + METCO) = 0: GOSUB 2100 6900 IF PAR(11 + METCO) = 0 THEN PAR(13 + METCO) = 0 6901 GOSUB 1371 6905 GOSUB 2200 6910 GOSUB 6798 6915 IF PAR(16) = 0 THEN STATUS = 0 6950 STP = 0: RETURN 6960 IF M% > 10 THEN 6964 6962 DMR1 = DMR1 XOR 2 ^ (M% - 1): RETURN 6964 DMR2 = DMR2 XOR 2 ^ (M% - 11): RETURN 7945 IF AIG1 THEN 625 ELSE 610 9240 COLOR 5, 0: VIEW PRINT 1 TO 21: CLS : VIEW PRINT 9250 COLOR 1, 2: VIEW PRINT 3 TO 19: CLS : VIEW PRINT 9260 VIEW PRINT 22 TO 25: CLS : VIEW PRINT 9270 COLOR 5㐞', 0: FOR T = 23 TO 25: LOCATE T, 1: PRINT SPACE$(11); : LOCATE T, 70: PRINT SPACE$(11); : NEXT T: COLOR 1, 2 9310 LOCATE 23, 32: PRINT "Instrument Status TC :" 9320 LOCATE 23, 64: PRINT USING "##.#"; VAL(TEMPER$) 9330 LOCATE 1, 1, 0: RETURN 11100 IF K1(33) THEN RETURN 11110 IF (K1(6) = 3) OR (K1(6) = 4) THEN RETURN 11120 GOSUB 5132 11130 GET #1, 33: DAT$ = A1$: DATTE$ = MID$(DAT$, 1 + (M% - 1) * 4, 4) 11140 MJ = CVI(LEFT$(DATTE$, 2)) 11150 IF MJ <> 0 THEN CLOSE #1: RETURN ELSE CAL = 1: CAL㐞'B = 1: KN = KN + 1: TCAL(KN) = M%: CLOSE #1: RETURN 12000 GOSUB 600: GOSUB 1090: GOSUB 593: GOSUB 5270: GOSUB 2560 12010 IF PAS THEN 3200 12020 LOCATE 12, 37, 0: PRINT "DELETE": GOSUB 6800: GOTO 7945 13000 PA$ = "LTCP": GOTO 35 30000 OPEN "r", #1, "NAMETH", 105 30010 FIELD #1, 6 AS A1$, 6 AS D$, 32 AS A2$, 32 AS A3$, 6 AS U1$, 6 AS U2$, 1 AS D1$, 1 AS D2$, 5 AS COF$, 5 AS E1$, 5 AS E2$ 30020 FOR I = 1 TO 32 30030 GET #1, I 30040 B$(I) = A1$: MTT$(I) = A3$ 30050 NEXT I: CLOSE #1: RETURN ''(㐞'1 'cahier de paillasse 5 ' WORKCP version 2.4 + 3.0 8 '********** 9 ' version 29/09/88 15 DEFINT C-K,N-Q,S-Z 18 DIM PRETRT(2),QUE$(6),REPONSE$(6),L(5),C(5),PROFILE(10) 19 DIM U1$(20),U2$(20),E1$(20),E2$(20),D1$(20),D2$(20),COF$(20),LNGME$(20) 20 DIM METH$(20),BIL$(20),DEMANDE(20),DEMAN(20),COMPO1(20),COMPO2(20),TEMPO$(129),TMFORM$(1,255),TLBMFORM(1),TREPET(12,2) 25 DIM P64(64),LE%(48),PLACE(48),PAR(60),B$(32),MTT$(32),HF$(30) 27 COMMON STATUS,METH%,P64(),LE%(),PLACE(),O1!,㐞'C1!,O2,C2,AIG1%,AIG3%,PAR(),M%,M1%,RE%,VER,BUT%,PAS,PA$,LIGNE%,METP%,DEMET,LIMI%,NONL$,TEMPER$,DATEF$ 28 lprint "in workcp":GOSUB 30000:DEV%=52:CIM%=&HC:DAT%=0 ':CALL IO(DOV%, CIM%, DAT%, RET%) 29 GOSUB 6060:GET#1,1:SAUVEG!=CVI(SA$):VINTEXT=CVI(V$):MA%=ASC(M$):SOURCE$=S$:CLOSE#1 31 MA%=0:F9%=2^8:SUP%=F9%:NBBLOC=1:GOSUB 1132:IF LIGNE%=1 THEN 5000 ELSE 5000 'vers prog. 35 ' 36 GOSUB 592:GOSUB 602:CLOSE:GOSUB 6060:IF PA$="creaform" OR PA$="imprint" OR PA$="saupai" THEN LSET SA$=MKI$(SAUVEG!):LSET V$=MKI㐞 '$(VINTEXT):LSET M$=CHR$(MA%):LSET S$=SOURCE$ ELSE LSET SA$=MKI$(0):LSET V$=MKI$(0):LSET M$=CHR$(0):LSET S$=" " 37 PUT#1,1:CLOSE#1:DEV%=52:CIM%=&HC:DAT%=1:AFREE=FRE(""):lprint "chain ";pa$:CHAIN PA$ 100 READ A$ 'aff. 105 IF LON=0 THEN 110 106 IF A$="" THEN A$=" " 107 N=INT(LEN(A$)/2):RETURN 110 PRINT A$;:LON=0:RETURN 120 GOSUB 600:COLOR 5,0:LOCATE 1,1,0:PRINT SPACE$(80):LOCATE 2,30:PRINT SPACE$(20):COLOR 1,2 121 GOSUB 602:COLOR 5,0:C1=5 122 FOR I=1 TO 7:READ A$:CUR=11*(I-1)+INT(.4*I) 1㐞'60 IF I>1 THEN LOCATE 20,2+CUR ELSE LOCATE 20,1+CUR 162 A3$=SPACE$(5-LEN(A$)/2)+A$:A$=A3$+SPACE$(10-LEN(A3$)):PRINT A$ 164 LOCATE 21,C1-2 165 IF A$=SPACE$(10) THEN PRINT " ":GOTO 168 166 IF (SUP% AND 2^(I-1))=2^(I-1) THEN PRINT " S F"+RIGHT$(STR$(I),1):GOTO 168 167 PRINT " F"+RIGHT$(STR$(I),1)+" " 168 C1=C1+11+CINT(I/2 -INT(I/2)):NEXT I 169 L(1)=24:C(1)=7:L(2)=24:C(2)=75:L(3)=1:C(3)=39:L(4)=1:C(4)=6:L(5)=2:C(5)=40 170 FOR I=8 TO 12:LON=1:GOSUB 100:LOCATE L(I-7),C(I-7)-N:GOSUB 110:NEXT I 205 A㐞'1$=SPACE$(5):A2$=SPACE$(11) 210 LON=1:A$=A1$:GOSUB 105:LOCATE 24,1:GOSUB 110:A$=A2$:LOCATE 25,1:GOSUB 110 220 IF STATUS<>9 THEN A1$=SPACE$(5):A2$=SPACE$(11) ELSE A1$=" Abort ":A2$=" S F9 " 225 LON=1:A$=A1$:GOSUB 105:LOCATE 24,70:GOSUB 110:A$=A2$:LOCATE 25,70:GOSUB 110 250 LOCATE 2,2:PRINT DATEF$; 285 COLOR 1,2:LOCATE 3,1 300 SUP%=F9%:RETURN 305 'touches 310 R$="":I=0:CBAK=C 311 IF C=81 THEN L=L+1:C=1 312 IF MASK=1 THEN LOCATE L,C ELSE LOCATE L,C-2,1:PRINT" "; 315 IF DRAP THEN DRAP=0:GOTO㐞' 330 ELSE COMPTEUR=0 320 A$=INKEY$:IF A$="" THEN COMPTEUR=COMPTEUR+1 ELSE COMPTEUR=0 325 IF COMPTEUR<2 THEN 320 330 A$=INKEY$:IF A$="" THEN 330 340 IF A$=CHR$(13) THEN J=10:GOTO 575 345 IF A$=CHR$(8) THEN 565 350 IF (MASK AND 1)=0 THEN 405 355 IF A$=CHR$(130) AND (FONCT AND 2^1)<>0 THEN J=1:IF I<>0 THEN LOCATE L,C:PRINT SPACE$(MAX+1):GOTO 585 ELSE 585 'fonct=touches fonction autorisees(pb effacement) 360 IF A$=CHR$(131) AND (FONCT AND 2^2)<>0 THEN J=2:GOTO 585 365 IF A$=CHR$(132) AND (FONCT AND 2^3㐞')<>0 THEN J=3:GOTO 585 370 IF A$=CHR$(133) AND (FONCT AND 2^4)<>0 THEN J=4:GOTO 585 375 IF A$=CHR$(134) AND (FONCT AND 2^5)<>0 THEN J=5:GOTO 585 385 IF A$=CHR$(135) AND (FONCT AND 2^6)<>0 THEN J=6:GOTO 585 390 IF A$=CHR$(136) AND (FONCT AND 2^7)<>0 THEN J=7:GOTO 585 395 ' 400 IF A$=CHR$(138) AND PAR(37) AND PAR(17)=0 THEN GOSUB 810:J=9:GOTO 585 405 IF (MASK AND 2)=0 THEN 415 410 IF A$>CHR$(47) AND A$0 THEN 435 425 IF A$="-" THEN 525 430 㐞'IF A$="+" THEN 525 435 IF (MASK AND 8)=0 THEN 450 440 IF ASD=1 THEN 450 445 IF A$="." THEN ASD=ASD+1:ROU=I:GOTO 505 450 IF (MASK AND 16)=0 THEN 460 455 IF (A$>CHR$(64) AND A$CHR$(31) AND A$㐞'CHR$(64) AND A$(MAX-1) THEN 330 510 IF VALMIN=0 AND VALMAX=0 THEN 525 515 Q$=R$+A$:IF (I+1=MAX AND VAL(Q$)VALMAX THEN 330 ELSE 550 525 IF MIN$="" AND MAX$="" THEN 550 530 IF A$>=MIN$ AND A$<=MAX$ THEN 550 ELSE 330 550 IF I=0 THEN LOCATE L,C:PRINT SPACE$(MAX+1):C=CBAK+1:LOCATE L,C 552 IF I=0 AND A$=CHR$(32) THEN 330 555 I=I㐞'+1:R$=R$+A$:PRINT A$; 560 IF (C+I)=81 THEN C=1:I=1:L=L+1 561 LOCATE L,C+I:GOTO 330 565 IF I<>0 THEN I=I-1:R$=LEFT$(R$,I):IF MASK=1 THEN 330 ELSE LOCATE L,C+I,1:PRINT " ";:LOCATE L,C:PRINT R$;:IF I=ROU THEN ASD=0 570 IF I=0 THEN LOCATE L,C-2,1:PRINT " ";:GOTO 330 ELSE 330 575 ' 580 IF NOMIN THEN GOTO 585 ELSE Q#=VAL(R$) 585 IF R$="+" OR R$="-" OR R$="." THEN 330 ELSE MASK=65:VALMIN=0:VALMAX=0:MIN$="":MAX$="":MAX=6:ASD=0:FONCT=1022:NOMIN=0 590 RETURN 592 DOV%=&H32:CIM%=&HF:DAT%=&HFF40:CALL IO(DOV%,CI㐞'M%,DAT%,RET%):RETURN 'clavier out 593 DOV%=&H32:CIM%=&HF:DAT%=&HBF00:CALL IO(DOV%,CIM%,DAT%,RET%):RETURN 'clavier in 595 CALL HAR:RETURN 'hardcopy 600 CALL CLA(MA%,SUP%):RETURN 'reassign. 602 VIEW PRINT 3 TO 19:CLS:VIEW PRINT:RETURN 'effacement 605 'chain 610 PA$="maincp":GOTO 35 'principal 620 PA$="ltcp":GOTO 35 621 PA$="creaform":GOTO 35 622 ON AIG1% GOTO 625,625,630,660,650,650,725,630,720,660,720,630 625 PA$="calc1cp":GOTO 35 'calculs 630 PA$="calc2cp":GOTO 35 650 PA$="㐞 'calc3cp":GOTO 35 660 PA$="calc4cp":GOTO 35 720 PA$="calc5cp":GOTO 35 725 PA$="calc6cp":GOTO 35 735 RETURN 740 REPO=0:F$=INKEY$:IF F$="" THEN 790 'interrogation fonctions 745 REIT=0:IF F$=CHR$(138) AND PAR(37) AND PAR(17)=0 THEN GOSUB 810 750 IF (ENTREE AND 2^REIT) THEN 755 ELSE 785 'masque 755 ON REIT+1 GOTO 760,762,764,766,768,770,772 ',774 760 IF F$=CHR$(130) THEN REPO=1:GOTO 790 'f1 762 IF F$=CHR$(131) THEN REPO=2:GOTO 790 'f2 764 IF F$=CHR$(132) THEN REPO=3:GOTO 790 'f3 766 IF F$=CHR$㐞((133) THEN REPO=4:GOTO 790 'f4 768 IF F$=CHR$(134) THEN REPO=5:GOTO 790 'f5 770 IF F$=CHR$(135) THEN REPO=6:GOTO 790 'f6 772 IF F$=CHR$(136) THEN REPO=7:GOTO 790 'f7 774 ' 785 IF REIT<7 THEN REIT=REIT+1:GOTO 750 790 RETURN 810 LOCATE 24,30:PRINT " ABORT REQUESTED " ':QP$="STO"+CHR$(13)+CHR$(10) 813 'I=1:DEV%=52 'routine w i/o 816 'CIM%=&H10:GOSUB 2130:IF RET%=0 THEN 816 ELSE CHAR=ASC(MID$(QP$,I,1)):CIM%=1:DAT%=CHAR 819 'GOSUB 2130:I=I+1:IF CHAR<>10 THEN 816 822 'R$="":DEV%=52:CIM%=&HC:DAT%=0㐞(:GOSUB 2130 'lecture i/o 825 'CIM%=2:DAT%=0 828 'GOSUB 2130:CHAR=RET% 831 'IF CHAR=-1 THEN 828 ELSE R$=R$+CHR$(CHAR) 834 'IF CHAR<>10 THEN 828 835 'DEV%=52:CIM%=&HC:DAT%=1:GOSUB 2130 837 'test reponse valide 840 COLOR 5,0:LOCATE 24,70:PRINT SPACE$(11):LOCATE 25,70:PRINT SPACE$(11);:COLOR 1,2:PAR(17)=1:STATUS=0:RETURN 900 GOSUB 593:A$=INKEY$:IF A$="" THEN 900 ELSE GOSUB 592 905 RESTORE 5054:FOR BOU=1 TO 30:READ V:IF A$=CHR$(V) THEN 920 910 NEXT BOU:IF A$=CHR$(138) AND PAR(37) <>0 AND PAR(17)=0 THE㐞(N GOSUB 810:GOTO 900 911 REPO=0:F$=A$:GOSUB 745:IF (ENTREE AND 2^(REPO-1))=0 THEN REPO=0 'REPO=3 AND PATIENT20 THEN ANE=BOU-20:GOTO 5960 'HH=0:GG=21 ELSE 922 922 IF BOU<11 THEN GG=1:HH=0 ELSE GG=11:HH=1 923 IF (METH$(BOU)=CHOIX$) OR (METH$(BOU)="") THEN 900 924 IF BOU<11 THEN IF (RES1 AND 2^(BOU-1))<>0 THEN 900 ELSE 925 ELSE IF (RES2 AND 2^(BOU-11))<>0 THEN 900 925 TABL$=LEFT$(METH$(BOU),6):GOSUB 970:DD=(BOU-GG) 926 㐞(IF DEMANDE(BOU)=0 AND DEMAN(BOU)=0 THEN DEMANDE(BOU)=1:GOSUB 931 ELSE IF (DEMANDE(BOU) OR DEMAN(BOU)) THEN DEMANDE(BOU)=0:DEMAN(BOU)=0:GOSUB 929:GOSUB 930 927 ANE=(BOU):GOSUB 593:GOTO 900 929 COU=2:GOSUB 932:RETURN 930 COU=7:GOSUB 933:GOSUB 935:RETURN 931 COU=0:GOSUB 932:COLOR 5,0:GOSUB 935:COLOR 1,2:RETURN 932 LINE((X1+(HH*24)+(DD*56)),Y1+(HH*24))-((53+X1)+(DD*56)+(HH*24),Y2+(HH*24)),COU,BF:RETURN 933 LINE((X1+(HH*24)+(DD*56)),Y1+(HH*24))-((53+X1)+(DD*56)+(HH*24),Y2+(HH*24)),COU,B:RETURN 935 LOCATE 㐞(LL+(HH*3),(4+(AA+(HH*3)+(DD*7))):PRINT TABL$:LOCATE LL+1+(HH*3),(4+(AA+(HH*3)+(DD*7))):PRINT " ";HF$(BOU):RETURN 970 AA=0:LL=6:Y1=36:Y2=58:X1=21::RETURN 999 LOCATE 19,18:PRINT"Press a labelled key to select a method":RETURN 1132 RESTORE 5053:FOR Y=1 TO 30:READ BX$:HF$(Y)=BX$:NEXT Y:RETURN 1135 X1=21:Y1=36:Y2=58:DW=4:LK=6:Y3=413:Y4=112:WD=59:LR=0 1140 FOR PR=0 TO 2:X1=21:IF PR=2 THEN LR=20 1145 RP=PR:GOSUB 1160:RP=0:FOR X1=(77+(PR*24)) TO ((Y3+(PR*24))+Y4) STEP 56:GOSUB 1160:NEXT X1:GOSUB 1150:NEXT㐞( PR:LOCATE 13,1,0:PRINT "PROFILES":RETURN 1150 FOR SS=DW+(PR*3) TO WD+14 STEP 7:LR=LR+1:GOSUB 1155:LOCATE LK+(PR*3),SS:PRINT PW$:LOCATE (LK+1)+(PR*3),SS:PRINT" ";HF$(LR):NEXT SS:LR=10:RETURN 1155 IF LR>20 THEN PW$=LEFT$(BIL$(LR-20),6):RETURN ELSE PW$=LEFT$(METH$(LR),6):RETURN 1160 LINE (X1+(RP*24),Y1+(PR*24))-((X1+53)+(RP*24),Y2+(PR*24)),7,B:RETURN 2000 FOR VIR=1 TO LEN(IDENTITE$) 2005 IF MID$(IDENTITE$,VIR,1)=CHR$(32) OR (MID$(IDENTITE$,VIR,1)>CHR$(47) AND MID$(IDENTITE$,VIR,1)0 THEN DEB$="*":FIN$=" " ELSE IF (P2 AND 2)<>0 THEN DEB$=CHR$(91):FIN$=CHR$(93) ELSE DEB$=" ":FIN$=" " 5540 IF (MET1 AND 2^ERT)=0 THEN 5550 ELSE LPRINT DEB$;METH$(ERT+1);FIN$;:DEB=DEB+1 5545㐞) IF DEB MOD(5)=0 THEN LPRINT "" 5550 NEXT ERT 5560 FOR TRE=0 TO 9 5562 P2$=MID$(VALEUR$,(1+(6*(TRE+10))),2):P2=CVI(P2$) 5563 IF (P2 AND 1)<>0 THEN DEB$="*":FIN$=" " ELSE IF (P2 AND 2)<>0 THEN DEB$=CHR$(91):FIN$=CHR$(93) ELSE DEB$=" ":FIN$=" " 5565 IF (MET2 AND 2^TRE)=0 THEN 5575 ELSE LPRINT DEB$;METH$(TRE+11);FIN$;:DEB=DEB+1 5570 IF DEB MOD(5)=0 THEN LPRINT "" 5575 NEXT TRE 5580 IF DEB MOD(5)<>0 THEN LPRINT "" 5585 LPRINT 5590 A$=INKEY$:IF A$=CHR$(132) THEN VINTEXT=1:GOSUB 9860:IMPRIME=VALIDE ':G㐞)OTO 5597 5595 NEXT IMPRIME 5597 FOR QW=1 TO 7:LPRINT "":NEXT QW:CLOSE#4:RETURN 5598 GOSUB 2120:RETURN 5710 'impression All patient result 5715 ON VINTEXT+1 GOSUB 5860,5860,5870,5870,5880,5880,6615 5716 IF VINTEXT=>20 THEN 5775 ELSE GOSUB 2060:GOSUB 2110 5717 VSTOP=0:NBERR%=0:DEBFINREP=0:CHECKSUM!=0:VBCMFORMD=1:VBCMFORMF=NBBLOC:GOSUB 9720 5718 IF DEBFINREP>5 THEN 5767 5719 IF VINTEXT<2 THEN LPRINT TAB(2) "CREATION REPORT DATE : ";:IF CONSULT THEN LPRINT RIGHT$(CAHPAIL$,8):LPRINT ELSE GET#2,1:LPRINT 㐞 )MID$(P2P$,1,8):LPRINT 5720 ON DEBFINREP+1 GOTO 5725,5767,5730,5767,5735,5767 5725 VBCMFORMD=1:VCMFORMD=1:GOSUB 9875:GOTO 5770 5730 DEBFINMET=0:TREPET(4,1)=TREPET(2,1):TREPET(4,2)=TREPET(2,2):GOTO 5740 5735 DEBFINMET=1 5740 DEBFINREP=1:GOSUB 9840:GOSUB 9850:DEBFINREP=4:GOSUB 9870:GOTO 5770 5767 LOCATE 24,33:PRINT "FORMAT NOT CORRECT";:VINTEXT=VINTEXT+20:GOSUB 5891:GOTO 5775 5770 GOSUB 5890 5772 LOCATE 24,31 5773 IF VINTEXT=4 OR VINTEXT=5 THEN PRINT NBERR% "PARITY ERROR":GOTO 5775 5774 PRINT SPACE$(㐞)35) 5775 RETURN 5779 'lecture du format memorise 5800 FOR VBCMFORM%=VBCMFORMD TO VBCMFORMF 5801 IF VBCMFORM%=VBCMFORMF THEN VCMFORMF=TREPET(DEBFINREP,2) 5805 FOR VCMFORM%=VCMFORMD TO VCMFORMF 5810 IF VSTOP THEN 5830 ELSE GOSUB 5840 5815 NEXT VCMFORM% 5816 VCMFORMD=1:VCMFORMF=TLBMFORM(1) '(VBCMFORM%+1) 5820 NEXT VBCMFORM% 5830 RETURN 5839 'impression ou commandes/impression 5840 FORMIN$=TMFORM$(VBCMFORM%,VCMFORM%):IF FORMIN$="" THEN 5850 5841 A$=INKEY$:IF A$=CHR$(134) THEN VSTOP=1:GOSUB 9867㐞) ELSE IF ASC(FORMIN$)<=128 THEN 9400 5842 FOR VAIGFORM%=1 TO 26 5843 IF ASC(FORMIN$)=VAIGFORM%+176 THEN 5845 5844 NEXT VAIGFORM% 5845 ON VAIGFORM% GOTO 9110,9120,9130,9140,5850,9160,9170,9180,5850,9200,5850,9220,9230,9240,5850,9260,9270,9281,9290,9300,9310,9320,9330,9340,5850,9360 5850 RETURN 5851 'test des peripheriques 5860 FORM$="FORMINT":RS232PRN$="PRN":GOSUB 5885: 5861 DEV%=&H35:CIM%=&HA 5862 DAT%=0:RET%=0:GOSUB 2130 5863 IF RET%<>0 THEN VINTEXT=VINTEXT+20:GOSUB 5891:LOCATE 24,33:PRINT "PRIN㐞)TER FAULT";:RETURN ELSE RETURN 5870 FORM$="FORMEXT":RS232PRN$="COMB":GOSUB 5885:DEV%=&HF1:GOTO 5882 5880 FORM$="FORMCOMP":RS232PRN$="COMA":GOSUB 5885:DEV%=&HF0:GOTO 5882 5882 CIM%=&H12:DAT%=0:RET%=0:GOSUB 2130 5883 IF RET%=0 THEN GOSUB 5891:GOSUB 2060:VINTEXT=VINTEXT+20:LOCATE 24,31 ELSE RETURN 5884 IF VINTEXT>21 AND VINTEXT<24 THEN GOSUB 5433:RETURN ELSE GOSUB 5434:RETURN 5885 OPEN RS232PRN$ FOR OUTPUT AS #4:RETURN 5890 IF VINTEXT<4 THEN FOR ERT=1 TO 5:PRINT#4,"":NEXT ERT 5891 CLOSE#4:RETURN 5904 㐞)'impression identity 5905 GOSUB 5167:IF IMPOUT THEN RETURN ELSE LPRINT TAB(10) "PATIENT IDENTITY" TAB(30) DATEF$:LPRINT TAB(10) "- - - - - - - - -":VERIF=1 5910 FOR SS=1 TO LEN(ECRITURE$) 5915 IF MID$(ECRITURE$,SS,1)=CHR$(58) THEN BUT%=SS ELSE 5930 5920 EVOLUE=VAL(MID$(ECRITURE$,VERIF,(BUT%-VERIF))):VERIF=BUT+1 5923 IF SS=1 THEN LPRINT "TRAY : ";TRAY ELSE IF TRAY<>TRAYBAK THEN LPRINT "TRAY : ";TRAY 5925 LPRINT EVOLUE TAB(5) ": ";TEMPO$(EVOLUE) 5927 TRAYBAK=TRAY 5930 NEXT SS:GOSUB 5485:RETURN 5935 '㐞)routine choix methodes & inverse video 5940 GOTO 900 5960 IF (BIL$(ANE)=CHOIX$) OR (BIL$(ANE)="") THEN 900 'pas de bilan 5962 IF PROFILE(ANE)=0 THEN PROFILE(ANE)=1 ELSE PROFILE(ANE)=0 5965 BO=0:FOR MOI=0 TO 9 5970 IF (COMPO1(ANE) AND 2^MOI)=0 THEN 5985 5975 IF (RES1 AND 2^MOI)<>0 OR METH$(MOI+1)=CHOIX$ THEN 5985 5980 IF PROFILE(ANE) THEN DEMAN(MOI+1)=DEMAN(MOI+1)+1:DEMANDE(MOI+1)=1:GOSUB 6015:GOTO 5985 5982 IF PROFILE(ANE)=0 THEN GOSUB 6015:IF DEMAN(MOI+1) THEN DEMAN(MOI+1)=DEMAN(MOI+1)-1 5983 㐞)IF DEMAN(MOI+1)=0 THEN DEMANDE(MOI+1)=0 5985 NEXT MOI 5990 BO=1:FOR MOI=0 TO 9 5995 IF (COMPO2(ANE) AND 2^MOI)=0 THEN 6010 6000 IF (RES2 AND 2^MOI)<>0 OR METH$(MOI+11)=CHOIX$ THEN 6010 6005 IF PROFILE(ANE) THEN DEMAN(MOI+11)=DEMAN(MOI+11)+1:DEMANDE(MOI+11)=1:GOSUB 6015:GOTO 6010 6007 IF PROFILE(ANE)=0 THEN GOSUB 6015:IF DEMAN(MOI+11) THEN DEMAN(MOI+11)=DEMAN(MOI+11)-1 6008 IF DEMAN(MOI+11)=0 THEN DEMANDE(MOI+11)=0 6010 NEXT MOI:GOTO 900 6015 GOSUB 970 6020 IF BO=0 THEN HH=0:BOU=MOI+1:DD=BOU-1 ELSE㐞) BOU=MOI+11:HH=1:DD=BOU-11 6025 TABL$=LEFT$(METH$(BOU),6) 6027 IF PROFILE(ANE) THEN IF DEMAN(BOU) AND DEMANDE(BOU) THEN GOSUB 931:GOTO 6035 ELSE GOTO 6035 6028 IF DEMAN(BOU) AND DEMANDE(BOU) THEN GOSUB 929:GOSUB 930 6035 RETURN 6040 OPEN"r",#3,DECAHPAIL$,128:FIELD#3,128 AS CHAMP$:GET#3,1:PARPAT$=CHAMP$:GET#3,2:PARENR$=CHAMP$:RETURN 6045 CLOSE#3:OPEN"r",#3,"descpai",128:FIELD#3,128 AS CHAMP$:RETURN 6050 OPEN"R",#6,FICHFORM$,38:FIELD#6,12 AS NFIC$,24 AS COFIC$,2 AS NBFIC$:RETURN 6060 OPEN"r",#1,"comw㐞)ork",6:FIELD#1,2 AS SA$,2 AS V$,1 AS M$,1 AS S$:RETURN 6180 'lecture fichier 6185 GOSUB 6190:GOSUB 593:IF SAUVEG!<>0 AND PAR(20)<>0 THEN GOSUB 9910:FICHIER$="prn":GOTO 8215 ELSE 6385' lecture des fichiers,retour de sauvegarde de paille ou 1ere entree 6190 OPEN "r",#1,"bilan",10:FIELD#1,6 AS NB$,4 AS MT$ 6195 FOR NUM=1 TO 10 6200 GET#1,NUM 6205 BIL$(NUM)=NB$:COMPO2(NUM)=CVI(LEFT$(MT$,2)):COMPO1(NUM)=CVI(RIGHT$(MT$,2)) 6210 NEXT NUM:CLOSE#1 6215 PRETRT(1)=0:PRETRT(2)=0:OPEN "r",#1,"method",4:FIELD#1,4㐞 ) AS A2$ 6220 FOR ERT=0 TO 19:GET#1,ERT*100+6:K16=CVS(A2$):GET#1,ERT*100+58 6225 IF CVS(A2$)<>0 AND (K16=5 OR K16=6 OR K16=10) THEN PRETRT(1+INT(ERT/10))=PRETRT(1+INT(ERT/10)) OR 2^(ERT MOD(10)) 6230 NEXT ERT:CLOSE#1 6247 GOSUB 6250:GOTO 6260 6250 OPEN"r",#1,"nameth",105 6255 FIELD#1,12 AS A1$,32 AS A2$,32 AS A3$,6 AS U1$,6 AS U2$,1 AS D1$,1 AS D2$,5 AS COF$,5 AS E1$,5 AS E2$ 6257 RETURN 6260 PATQCL=PAR(58) AND 255:PATQCH=((PAR(58) AND 32512)/256) 6264 FOR NUM=1 TO 20 6265 GET#1,NUM 6270 ME$=A1$:M㐞*ETH$(NUM)=LEFT$(ME$,6):IF (PRETRT(1+INT((NUM-1)/10)) AND 2^((NUM-1) MOD(10)))<>0 THEN METH$(NUM)=CHOIX$ 6280 U1$(NUM)=U1$:U2$(NUM)=U2$:E1$(NUM)=E1$:E2$(NUM)=E2$:D1$(NUM)=D1$:D2$(NUM)=D2$:COF$(NUM)=COF$:LNGME$(NUM)=A3$ 6305 NEXT NUM 6310 CLOSE#1:GOSUB 6315:GOTO 6340 6315 OPEN"r",#1,"pcomme",42 6320 FIELD#1,7 AS CM1$,7 AS CM2$,7 AS CM3$,7 AS CM4$,7 AS CM5$,7 AS CM6$ 6325 GET#1,1 6330 QUE$(1)=CM1$:QUE$(2)=CM2$:QUE$(3)=CM3$:QUE$(4)=CM4$:QUE$(5)=CM5$:QUE$(6)=CM6$ 6335 CLOSE#1:RETURN 6340 VALIDE=0:GOSUB 㐞*6040 6342 TROU=0:DEPAR=0:FOR DF=128 TO 1 STEP-1:TRAP$=MID$(PARENR$,DF,1):IF DEPAR=0 AND ASC(TRAP$)>0 THEN DEPAR=DF 6344 IF DF0) THEN RANG=RECHERCHE:DRAPEAU=1:AFFICH=1:ANCIEN=VALIDE+1:LOCATE ,,0:NUMERIC=0:SURN$="":GOTO 7465 6760 NEXT REC㐞*HERCHE:NUMERIC=0:GOSUB 5425:GOTO 6710 6765 'ecran L1 Addition 6770 IF VALIDE=128 THEN LOCATE 18,15:GOSUB 5315:GOTO 6690 ELSE SCREEN 2:GOSUB 9100:RESTORE 5070:GOSUB 120:GOSUB 11000 'refus 129 eme 6775 ANCIEN=VALIDE+1 'autorise repeat pour patients suivant ancien 6800 DRAPEAU=2:AFFICH=2:ANCIEN=VALIDE+1:DERNIER=VALIDE+1:GOTO 7470 6805 ' ****** ecran M1 ** Delete 6810 IF PAR(19)<>0 THEN GOSUB 2150:GOTO 6690 ELSE IF PAR(37)<>0 THEN MAUV=1:GOSUB 5353:GOTO 6690 ELSE RESTORE 5080:GOSUB 120 6815 LOCATE 6,3,1㐞 *:GOSUB 5320 6817 IF ASC(LEFT$(PARPAT$,1))=0 THEN LOCATE 8,30:GOSUB 5325 6820 NOMIN=1:FONCT=128:LOCATE ,,1:MAX=12:MASK=259:L=6:C=30:GOSUB 310:ON J GOTO 6820,6820,6820,6820,6820,6820,6605,6820,6820,6825 6825 RANG=0:SURN$=R$+SPACE$(12-LEN(R$)):IF R$="" THEN 6820 6830 LOCATE,,0:FOR RECHERCHE=1 TO VALIDE 6845 IF TEMPO$(RECHERCHE)=SURN$ THEN RANG=RECHERCHE:GOTO 6867 6855 NEXT RECHERCHE 6865 IF RANG=0 THEN GOSUB 5425:GOTO 6820 'rang est le numero de patient dans paille 6867 LOCATE 6,44:PRINT SPACE$(28) 㐞* 6870 PERSON=ASC(MID$(PARPAT$,RANG,1)) 6875 MID$(PARENR$,PERSON,1)=CHR$(0) 'enleve numero du patient dans parenr$ 6876 FOR T=1 TO VALIDE+TROU:QW=ASC(MID$(PARENR$,T,1)):IF QW>RANG THEN MID$(PARENR$,T,1)=CHR$(QW-1) 6877 NEXT T 6880 MID$(PARPAT$,RANG,129-RANG)=MID$(PARPAT$,RANG+1,128-RANG)+CHR$(0) 'enleve place de lenregitrement du patient a dileter dans parpat$ 6885 IF RANG0 THEN GOSUB 2150:GOTO 6690 ELSE IF PAR(37)<>0 THEN MAUV=1:GOSUB 5353:GOTO 6690 7000 IF VALIDE=128 THEN LOCATE 18,15:GOSUB 5315:GOTO 6690 ELSE SCREEN 2:GOSUB 9910:RESTORE 5085:GOSUB 120 'refus 129 eme 7015 INS=1:SANS=2:FONCT=128:LOCATE 3,23,1:COLOR 1,2:GOSUB 53㐞*30:COLOR 5,0:GOSUB 2103:COLOR 1,2:L=3:C=50:MASK=259:MAX=12:GOSUB 310:ON J GOTO 7015,7015,7015,7015,7015,7015,8040,7015,7015,7020 7020 IF R$="" THEN 7015 ELSE PRECED$=R$+SPACE$(12-LEN(R$)) 7025 RANG=0:FOR RECHERCHE=1 TO VALIDE 7040 IF TEMPO$(RECHERCHE)=PRECED$ THEN RANG=RECHERCHE+1:GOTO 7060 7050 NEXT RECHERCHE 7055 IF RANG=0 THEN LOCATE 3,50:PRINT SPACE$(13):GOTO 7015 7060 X=2:GOSUB 11205:GOSUB 11600:GOSUB 11000:COLOR 1,2:LOCATE 4,25:PRINT RANG;" . ";:GOSUB 5259:NOMIN=1:MASK=259:MAX=12:L=4:C=45:GOSUB 㐞*310:ON J GOTO 7060,7060,7060,11100,11110,7060,8040,7060,7060,7065 7065 SL=1:TEMPO$=R$+SPACE$(12-LEN(R$)):IF TEMPO$=SPACE$(12) THEN 7060 7070 IDEM=0 7075 FOR CONTROLE=1 TO VALIDE 7090 IF TEMPO$=TEMPO$(CONTROLE) THEN IDEM=1:GOTO 7100 7095 NEXT CONTROLE 7100 IF IDEM=1 THEN GOSUB 5425:TEMPO$="":GOTO 7060 7105 LOCATE ,,0:FOR SD=VALIDE+1 TO RANG+1 STEP-1:TEMPO$(SD)=TEMPO$(SD-1):NEXT SD:TEMPO$(RANG)=TEMPO$:GOSUB 12900 7110 SELECT1=0:SELECT2=0:ANCIEN=VALIDE+1:PATIENT=RANG:AFFICH=3:DRAPEAU=3:GOSUB 11800:GOSU㐞*B 11500:GOTO 7465 7120 IF TROU=0 THEN DISPO=VALIDE+1:GOTO 7135 ELSE FOR TR=1 TO 128:YOYO=ASC(MID$(PARENR$,TR,1)):IF YOYO=0 THEN TROU=TROU-1:GOTO 7130 7125 NEXT TR 7130 DISPO=TR '1er enregitrement libre 7135 MID$(PARENR$,DISPO,1)=CHR$(RANG):MID$(PARPAT$,RANG,129-RANG)=CHR$(DISPO)+MID$(PARPAT$,RANG,128-RANG) 7140 FOR SD=1 TO VALIDE+TROU:RECULE=ASC(MID$(PARENR$,SD,1)):IF RECULE>=RANG AND SD<>DISPO THEN MID$(PARENR$,SD,1)=CHR$(RECULE+1) 7145 NEXT SD 7155 LSET MN$=TEMPO$(RANG) 'param㐞*etres pat. insere 7160 LSET M1$=MKI$(MET1):LSET M2$=MKI$(MET2) 7165 LSET MR1$=MKI$(0):LSET MR2$=MKI$(0):LSET P$=JKL$:LSET M2P$=DFG$:LSET P2P$=QWE$ 7170 LSET RP$=COMMENTAIRE$ 7175 PUT#2,DISPO 7180 LSET CHAMP$=PARPAT$:PUT#3,1:LSET CHAMP$=PARENR$:PUT#3,2 7190 GOSUB 6045 7300 AFFICH=0:VALIDE=VALIDE+1:IF RUSE=1 THEN RUSE=0:ON J GOTO 8000,8015,7990,7990,8072,8075,8040 ELSE GOTO 8067 7305 ' identite 7310 GOSUB 2060:RESTORE 5075:GOSUB 120:ECRITURE$="":CHAINE$=":" 7315 FOR TITI=1 TO VALIDE+TROU 'titi=nume㐞*ro patient 7320 NOM$=TEMPO$(TITI) 7322 GOTO 7325 7323 NOM$=MN$:CNOM=CVI(M1$) 7324 RETURN 7325 IF TITI>VALIDE THEN TITI=128:GOTO 7410 7330 GOSUB 7416:IF NUMER=0 THEN 7410 7335 NOMIN=1:FONCT=198:LOCATE 8,10,1:GOSUB 5420:MASK=259:MAX=12:L=8:C=50:GOSUB 310:ON J GOTO 7340,7350,7335,7335,7335,7360,7337,7335,7335,7365 7337 GOTO 6605 7340 IF LEN(CHAINE$)=1 THEN 7335 ELSE LONGU=LEN(CHAINE$):FOR XC=LONGU-1 TO 1 STEP-1:IF MID$(CHAINE$,XC,1)=":" THEN TITI=VAL(RIGHT$(CHAINE$,LONGU-XC)):CHAINE$=LEFT$(CHAINE$,XC)㐞*:GOTO 7345 'chaine$ memorise les patients "sautes" par next 7341 NEXT XC 7345 NOM$=TEMPO$(TITI):GOTO 7335 7350 TIBAK=TITI:NMBAK$=NOM$ 'next 7351 TITI=TITI+1 7352 IF TITI>VALIDE THEN TITI=TIBAK:NOM$=TEMPO$(TIBAK):GOTO 7335 ELSE NOM$=TEMPO$(TITI):GOSUB 7416:IF NUMER=0 THEN 7351 ELSE CHAINE$=CHAINE$+STR$(TIBAK)+":":GOTO 7335 7355 GET#2,PERS:GOSUB 7323:IF CNOM=0 THEN TITI=TIBAK:GET#2,PERS:GOSUB 7323:GOTO 7335 ELSE IF (TEMPO$(TITI)<>SPACE$(12) AND TEMPO$(TITI)<>"") THEN 7351 ELSE CHAINE$=CHAINE$+STR$(TI㐞 *BAK)+":" :GOTO 7335 7360 IF LEN(ECRITURE$)=0 THEN 7335 ELSE LOCATE ,,0:GOSUB 5905:GOTO 7335 'impression 7365 WOM$=(R$+SPACE$(12-LEN(R$))):IF WOM$=SPACE$(12) THEN 7335 7370 IDEM=0:LOCATE ,,0 7375 FOR CONTROLE=1 TO 128:IF ASC(MID$(PARPAT$,CONTROLE,1))=0 THEN CONTROLE=128:GOTO 7390 7385 IF CONTROLE=TITI THEN 7390 ELSE IF WOM$=TEMPO$(CONTROLE) THEN IDEM=1:GOTO 7393 7390 NEXT CONTROLE 7393 IF IDEM=1 THEN GOSUB 5425:GOTO 7335 7394 GOSUB 13200 7395 ENREG=ASC(MID$(PARPAT$,TITI ,1)) 7396 IF VAL(RIGHT$(CHAI㐞+NE$,LEN(STR$(TITI))+1))=TITI THEN CHAINE$=LEFT$(CHAINE$,LEN(CHAINE$)-(LEN(STR$(TITI))+1)) 7397 GET#2,ENREG:MET1$=M1$:MET2$=M2$:METRES1$=MR1$:METRES2$=MR2$:RES$=P$:MET2P$=M2P$:RES2P$=P2P$:REP$=RP$ 7400 ECRITURE$=ECRITURE$+STR$(TITI)+":":TEMPO$(TITI)=WOM$:LSET MN$=WOM$ 7402 LSET M1$=MET1$:LSET M2$=MET2$:LSET MR1$=METRES1$:LSET MR2$=METRES2$:LSET P$=RES$:LSET M2P$=MET2P$:LSET P2P$=RES2P$:LSET RP$=REP$ 7405 PUT#2,ENREG 7407 LOCATE 8,10,0:PRINT SPACE$(60) 7410 NEXT TITI:LOCATE 8,20:PRINT "END":COLOR 5,0:GO㐞+SUB 2080:GOSUB 2090:GOSUB 5288:GOSUB 5293:COLOR 1,2 7412 FONCT=192:GOSUB 2020:ON J GOTO 7412,7412,7412,7412,7412,7415,7413,7412,7412,7412 7413 GOTO 6605 7415 GOSUB 2110:GOSUB 5905:GOSUB 2120:GOTO 6605 7416 NUMER=1:FOR VIR=1 TO LEN(NOM$) 7417 IF MID$(NOM$,VIR,1)=CHR$(32) OR MID$(NOM$,VIR,1)=CHR$(0) OR (MID$(NOM$,VIR,1)>CHR$(47) AND MID$(NOM$,VIR,1)1 THEN GOSUB 5285:GOSUB 5287:GOSUB 11000 ELSE GOSUB 2080:GOSUB 5288:GOSUB 11000 7500 IF SUIV=1 THEN GOSUB 5290㐞+:GOSUB 5292 ELSE GOSUB 2090:GOSUB 5293 7505 COLOR 1,2:EMPLA=ASC(MID$(PARPAT$,PATIENT,1)):IF EMPLA=0 THEN EMPLA=255:GOSUB 7517:GOTO 7520 ELSE EMPLA=ASC(MID$(PARPAT$,PATIENT,1)) 'cas de creation:empla=0 :prend valeurs nulles empla=255 pour test enregistrement 7507 GET#2,EMPLA 7510 NOM$=MN$:SELECT1=CVI(M1$):SELECT2=CVI(M2$):REPONSE$=RP$ ' select1=methodes 1 a 10 , select2=methodes 11 a 20 7515 RES1=CVI(MR1$):RES2=CVI(MR2$):VALEUR$=P$:MET2P$=M2P$:RES2P$=P2P$:GOTO 7520 7517 NOM$=FAM$:SELECT1=CVI(VBN$)㐞+:SELECT2=CVI(VBN$):REPONSE$=XCV$:RES1=CVI(VBN$):RES2=CVI(VBN$):VALEUR$=JKL$:MET2P$=DFG$:RES2P$=QWE$ 7518 IF PATIENT=1 THEN RES2P$=LEFT$(DATEF$,6)+RIGHT$(DATEF$,2) 7519 RETURN 7520 IF REPETE=1 THEN SELECT1=ENCORE1:SELECT2=ENCORE2:REPETE=0 7525 L=4:LOCATE L,15,1:PRINT PATIENT;".";:GOSUB 5259:NOMIN=1:IF AUTOMAT=1 THEN NOM$=SUIVANT$:AUTOMAT=0 7530 IF NOM$<>FAM$ AND NOM$<>"" THEN LOCATE L,37:PRINT NOM$; 7532 ' 7533 FONCT=182:IF PATIENT=1 THEN FONCT=FONCT-2 7534 IF SUIV=0 THEN FONCT=FONCT-4 7535 GOSUB 11㐞+205:GOSUB 11700:GOSUB 11000:COLOR 1,2:X=1:NOMIN=1:MAX=12:C=36:MASK=259:LOCATE L,C,1:DRAP=1:GOSUB 310:ON J GOTO 7540,7545,7530,11100,11110,7530,7537,7530,7530,7550 7537 IF VALIDE=0 THEN 6605 ELSE 8040 7540 IF PATIENT=1 THEN 7535 ELSE PATIENT=PATIENT-1:GOTO 7480 7545 IF SUIV=0 THEN 7535 ELSE PATIENT=PATIENT+1:GOTO 7480 7550 IF R$="" THEN IDENTITE$=NOM$ ELSE IDENTITE$=R$+SPACE$(12-LEN(R$)) 7556 IF IDENTITE$=FAM$ THEN 7535 7558 LOCATE ,,0 7560 IDEM=0 7565 FOR CONTROLE=1 TO VALIDE 7570 IF CONTROLE=PATIE㐞+NT THEN 7575 ELSE IF IDENTITE$=TEMPO$(CONTROLE) THEN IDEM=1:GOTO 7580 7575 NEXT CONTROLE 7580 IF IDEM=1 THEN GOSUB 5425:IDENTITE$="":GOTO 7535 7581 TEMPO$(PATIENT)=IDENTITE$ 7582 GOSUB 11800:GOSUB 11500 7585 COLOR 5,0:GOSUB 2080:GOSUB 2090:LOCATE 20,72:PRINT SPACE$(9):GOSUB 5288:GOSUB 5293:LOCATE 21,74:PRINT SPACE$(2):COLOR 1,2 ' efface Exit 7587 IF RECOPIE THEN RECOPIE=0:GOSUB 999:GOTO 7741 7589 FOR Q=1 TO 10:PROFILE(Q)=0:NEXT Q 7590 FOR T=1 TO 20:DEMANDE(T)=0:DEMAN(T)=0:NEXT T:GOSUB 7595:GOS㐞 +UB 999:GOTO 7645 7595 IF CADRE=0 THEN CADRE=1:GOSUB 1135:RETURN ELSE RETURN 7615 FOR BOU=1 TO 20:IF DEMANDE(BOU) THEN 7620 ELSE 7630 7620 IF BOU<11 THEN HH=0:DD=BOU-1 ELSE HH=1:DD=BOU-11 7625 TABL$=LEFT$(METH$(BOU),6):GOSUB 929:GOSUB 930 7630 NEXT BOU:GOSUB 2070:RETURN 7645 FOR DSA=0 TO 9 7646 IF (SELECT1 AND 2^DSA)=0 THEN 7690 7647 IF (METH$(DSA+1)=CHOIX$ OR METH$(DSA+1)="") THEN 7690 7655 P2$=MID$(VALEUR$,(1+(6*DSA)),2):P2=CVI(P2$) 7657 IF (RES1 AND 2^DSA)<>0 AND (P2 AND 1)<>0 THEN 7660 ELSE 767㐞+0 7660 GOSUB 970:HH=0:BOU=DSA+1:DD=BOU-1:LOCATE LL+1+(HH*3),(4+(AA+(HH*3)+(DD*7))):PRINT " **":DEMANDE(DSA+1)=1:GOTO 7690 7670 DEMANDE(DSA+1)=1 7685 GOSUB 970:HH=0:BOU=DSA+1:DD=BOU-1:TABL$=LEFT$(METH$(DSA+1),6):GOSUB 931:IF (P2 AND 2)<> 0 THEN COLOR 1,2:LOCATE LL+1+(HH*3),(4+(AA+(HH*3)+(DD*7))):PRINT " ";HF$(BOU) 7690 NEXT DSA 7695 FOR DSA=0 TO 9 7696 IF (SELECT2 AND 2^DSA)=0 THEN 7740 7697 IF (METH$(DSA+11)=CHOIX$ OR METH$(DSA+1)="") THEN 7740 7705 P2$=MID$(VALEUR$,(1+(6*(DSA+10))),2):P2=CVI(P2$㐞+) 7707 IF (RES2 AND 2^DSA)<>0 AND (P2 AND 1)<>0 THEN 7710 ELSE 7720 7710 GOSUB 970:HH=1:BOU=DSA+11:DD=BOU-11:LOCATE LL+1+(HH*3),(4+(AA+(HH*3)+(DD*7))):PRINT " **":DEMANDE(DSA+11)=1:GOTO 7740 7720 DEMANDE(DSA+11)=1 7735 GOSUB 970:HH=1:BOU=DSA+11:DD=BOU-11:TABL$=LEFT$(METH$(DSA+11),6):GOSUB 931:IF (P2 AND 2)<> 0 THEN COLOR 1,2:LOCATE LL+1+(HH*3),(4+(AA+(HH*3)+(DD*7))):PRINT " ";HF$(BOU) 7740 NEXT DSA 7741 GOSUB 7945 'choix touches autorisees 7745 GOSUB 5940:IF REPO=3 THEN RECOPIE=1 ' i㐞+nterrogation 7750 BLOQ=0:FOR SURVEILLE=1 TO 20:BLOQ=BLOQ+DEMANDE(SURVEILLE)+DEMAN(SURVEILLE):NEXT SURVEILLE 7755 IF BLOQ=0 AND REPO=7 THEN TEMPO$(PATIENT)=NOM$:INS=0:LOCATE 24,33:PRINT "NO VALIDATION":FOR T=1 TO 7500:NEXT T:GOSUB 11200:GOSUB 13000:GOTO 6605 ELSE IF BLOQ=0 THEN 7745 ELSE IF REPO<>4 THEN COMMENTAIRE$=REPONSE$:GOTO 7815 7760 GOSUB 2070:INCREM=0:COLOR 1,2:COMMENTAIRE$="":FOR BN=1 TO 6:REPONSE$(BN)="":NEXT BN 7765 FOR QUESTION=1 TO 6 7770 GOSUB 2210:IF VCO THEN REPONSE$(QUESTION)=POSE$:GOTO㐞+ 7805 7775 REP$=MID$(REPONSE$,((7*(QUESTION-1))+1),7) 7780 INCREM=INCREM+1:COLONE=INCREM:IF INCREM>3 THEN COLONE=INCREM-3 7785 LOCATE (15+2*(INT(INCREM/4))),(1+((COLONE-1)*26)):PRINT QUE$(QUESTION);" : ";REP$; 7787 IF SANS=2 THEN FONCT=230 ELSE IF SANS=1 THEN FONCT=166 ELSE FONCT=206 7790 L=(15+2*(INT(INCREM/4))):C=(12+((COLONE-1)*26)):MAX=7:GOSUB 310:ON J GOTO 12100,12100,12100,7785,12100,12100,12100,7785,7785,7795 7795 IF R$="" THEN REPONSE$(QUESTION)=REP$ ELSE REPONSE$(QUESTION)=R$+SPACE$(7-LEN(R㐞+$)) 7800 IF REPONSE$(QUESTION)="" THEN REPONSE$(QUESTION)=POSE$ 7805 COMMENTAIRE$=COMMENTAIRE$+REPONSE$(QUESTION) 7810 NEXT QUESTION:LOCATE 18,1,0 7815 MET1=0:MET2=0:METRES1=0:METRES2=0 7820 FOR DEM=1 TO 10 7825 IF (DEMANDE(DEM) OR DEMAN(DEM)) THEN MET1=MET1+(2^(DEM-1)) 7830 NEXT DEM 7835 FOR DEM=11 TO 20 7840 IF (DEMANDE(DEM) OR DEMAN(DEM)) THEN MET2=MET2+(2^(DEM-11)) 7845 NEXT DEM 7850 IF AFFICH=3 THEN 7120 ' revient de I1 en affich=0 7875 LSET MN$=TEMPO$(PATIENT) 7880 LSET M1$=MKI$(M㐞+ET1):LSET M2$=MKI$(MET2) 7885 LSET MR1$=MKI$(RES1):LSET MR2$=MKI$(RES2) 7890 LSET P$=VALEUR$ 7900 LSET M2P$=MET2P$:LSET P2P$=RES2P$ 7902 'probleme methodes 7904 '2 reactions part 7906 ' 7908 ' 7910 ' 7915 LSET RP$=COMMENTAIRE$:IF EMPLA=255 THEN 7920 ELSE PLACE=EMPLA:GOTO 7930 7920 IF VALIDE=0 THEN PLACE=1:GOTO 7926 ELSE IF TROU=0 THEN PLACE=VALIDE+1:GOTO 7926 7922 FOR PLACE=1 TO VALIDE:IF ASC(MID$(PARENR$,PLACE,1))=0 THEN TROU=TROU-1:GOTO 7926 7924 NEXT PLACE 7926 MID$(PARENR$,PLACE,1)=CHR$(PAT㐞+IENT):MID$(PARPAT$,PATIENT,1)=CHR$(PLACE) 7930 PUT#2,PLACE:IF (PATIENT MOD(10))=0 THEN CLOSE#2:GOSUB 5020 7935 LSET CHAMP$=PARPAT$:PUT#3,1:LSET CHAMP$=PARENR$:PUT#3,2 7940 IF (PATIENT MOD(10))=0 THEN GOSUB 5035:LSET P1$=MKI$(PAR(20)):PUT#1,20:CLOSE#1:GOSUB 6045 7941 IF ZZ=1 THEN RETURN 7942 IF DRAPEAU=1 THEN 8052 ELSE IF DRAPEAU=3 THEN 8067 ELSE IF ENTREE=99 THEN 7996 ELSE IF ENTREE=67 THEN 7998 ELSE IF ENTREE=103 THEN 7987 ELSE 7992 7945 IF DRAPEAU=1 THEN 8045 7950 IF DRAPEAU=3 THEN 8060 7952 IF PA㐞+TIENTCHR$(47) AND MID$(IDENTITE$,VIR,1)1 THEN PATIENT=PATIENT-2:GOTO 8020 ELSE REPO=0:IF F6=1 THEN 7987 ELSE IF F6=0 THEN 7992 ELSE IF F6=2 THEN 8052 ELSE IF F6=3 THEN 8067 'previous 8005 GOSUB 2070:REPETE=1:RECOPIE=1:ENCORE1=MET1:ENCORE2=MET2:GOTO 8015 'repeat 8010 AUTOMAT=1:SUI#=VAL(IDENTITE$) 'a㐞,uto 8011 IF SUI#=999999999999# THEN SUI#=0 8012 SUI$=STR$(SUI#+1):SUIVANT$=RIGHT$(SUI$,LEN(SUI$)-1):SUIVANT$=SUIVANT$+SPACE$(12-LEN(SUIVANT$)):FOR CONTROLE=1 TO VALIDE:IF TEMPO$(CONTROLE)=SUIVANT$ THEN SUI#=SUI#+1:GOTO 8011 8013 NEXT CONTROLE 8015 INS=0:SL=0:IF PATIENT=128 THEN LOCATE 19,30:GOSUB 5315:REPO=0:ON (F6+1) GOTO 7992,7987,8052,8067 8020 GOSUB 8021:GOTO 8030 8021 IF VALIDE=0 THEN VALIDE=1:RETURN 8022 FOR LK=VALIDE TO 128:IF ASC(MID$(PARPAT$,LK,1))=0 THEN 8026 8025 NEXT LK 8026 VALIDE=LK-1㐞,:RETURN 8030 GOSUB 8375 8035 NEXT PATIENT 8040 INS=0:SL=0:SANS=0:GOSUB 8021:GOTO 6605 8045 COLOR 5,0:GOSUB 5285:GOSUB 5290:GOSUB 5305:GOSUB 5310:GOSUB 2103:GOSUB 12000:GOSUB 13500 8050 GOSUB 5287:GOSUB 5292:GOSUB 5302:GOSUB 5312:COLOR 1,2:ENTREE=83:GOSUB 13400:RETURN 8052 F6=2:IF REPO THEN ON REPO GOTO 8000,8015,8055,8055,8057,8055,8040 8055 FONCT=166:GOSUB 2020:ON J GOTO 8000,8015,8055,8055,8057,8055,8040,8055,8055,8055 8057 GOSUB 8375:GOTO 6705 8060 COLOR 5,0:GOSUB 5285:GOSUB 5290:LOCATE 20,50:GO㐞,SUB 5345:LOCATE 20,61:GOSUB 5350:GOSUB 5310:GOSUB 2103:GOSUB 12000:GOSUB 13500 'insertion 8065 GOSUB 5287:GOSUB 5292:GOSUB 5302:GOSUB 5303:GOSUB 5312:COLOR 1,2:ENTREE=115:GOSUB 13400:RETURN 8067 F6=3:IF REPO THEN ON REPO GOTO 8000,8015,8070,8070,8072,8075,8040 8070 FONCT=230:GOSUB 2020:ON J GOTO 8000,8015,8070,8070,8072,8075,8040,8070,8070,8070 8072 INS=0:IF VALIDE=128 THEN LOCATE 19,30:GOSUB 5315:REPO=0:GOTO 8070 ELSE GOSUB 8375:GOTO 7015 8075 INS=0:GOSUB 5445:GOTO 8070 8080 ' S1 edition resultats 8㐞,085 UNITE=1:GOTO 8100 8090 UNITE=2 8100 GOSUB 2060:IF VINTEXT>=20 THEN VINTEXT=VINTEXT-20 8105 IF VALIDE=0 THEN IF VINTEXT=1 THEN L=5:GOSUB 2050:GOSUB 5325:GOTO 8265 ELSE L=7:GOSUB 2050:GOSUB 5325:IF VINTEXT=3 THEN VINTEXT=7:GOTO 8810 ELSE 8820 8106 IF O2=64 AND VINTEXT=1 AND CONSULT=0 THEN GOSUB 5860:IF VINTEXT>20 THEN 8215 ELSE GOSUB 5115:SAUVEG!=UNITE+1:PA$="imprint":GOTO 36 8107 FONCT=16:COLOR 5,0:LOCATE 1,20:PRINT SPACE$(40);:LOCATE 1,31:PRINT "All Result Printout":LOCATE 20,49:PRINT " STOP ":GO㐞,SUB 5302:COLOR 1,2 8108 GOSUB 5715:IF CONSULT THEN 10625 8109 GOTO 8215 8110 'ecran E1 impression 1 patient 8115 RESTORE 5100:GOSUB 120 8117 IF VALIDE=0 THEN LOCATE 9,35:GOSUB 5325 8120 LOCATE 7,10,1:GOSUB 5375 8125 NOMIN=1:FONCT=128:MAX=12:L=7:C=35:GOSUB 310:LOCATE L,C,0:ON J GOTO 8125,8125,8125,8125,8125,8125,8197,8125,8125,8130 8130 RANG=0:SURN$=R$+SPACE$(12-LEN(R$)) 8132 IF VALIDE=0 THEN LOCATE 9,35:GOSUB 5325:GOTO 8125 8135 IF R$="" THEN 8175 8138 GOSUB 2000 8145 FOR RECHERCHE=1 TO VALIDE 㐞, 8150 IF TEMPO$(RECHERCHE)=SURN$ THEN RANG=RECHERCHE:GOTO 8160 8152 IF NUMERIC THEN IF (VAL(TEMPO$(RECHERCHE))=VAL(SURN$) AND VAL(SURN$)<>0 AND TEMPO$(RECHERCHE)=SURN$)THEN RANG=RECHERCHE 8160 NEXT RECHERCHE:NUMERIC=0 8170 IF RANG<>0 THEN 8186 8175 LOCATE 7,55:GOSUB 5340 8180 FONCT=128:MASK=3:L=7:C=70:MAX=3:VALMIN=1:VALMAX=VALIDE:GOSUB 310:LOCATE L,C,0:ON J GOTO 8180,8180,8180,8180,8180,8180,6385,8180,8180,8185 8185 IF Q#=0 THEN 8180 ELSE RANG=Q# 8186 PATIENT=RANG:GOSUB 5715 8190 COLOR 5,0:LOCATE 20㐞 ,,3,0:GOSUB 5380:LOCATE 20,14:GOSUB 5385:LOCATE 20,25:GOSUB 5386:GOSUB 5287:GOSUB 5292:GOSUB 5297:COLOR 1,2 8192 LOCATE 12,1:GOSUB 5365:LOCATE 14,1:GOSUB 5370 8195 FONCT=142:GOSUB 2020:ON J GOTO 8200,8200,8205,8195,8195,8195,8197,8195,8195,8195 8197 GOSUB 2060 8198 IF CONSULT THEN 10590 ELSE 6385 8200 IF J=2 THEN UNITE=2 ELSE UNITE=1 8201 IF VINTEXT>=20 THEN GOSUB 2060:VINTEXT=VINTEXT-20 8202 GOTO 8186 8205 UNITE=1:COLOR 5,0:GOSUB 2080:GOSUB 2090:GOSUB 2100:GOSUB 5288:GOSUB 5293:GOSUB 5298:COLOR 1,2:㐞,LOCATE 7,35,1:PRINT SPACE$(40) 8206 IF VINTEXT>=20 THEN GOSUB 2060:VINTEXT=VINTEXT-20 8207 LOCATE 12,1:PRINT SPACE$(70):LOCATE 14,1:PRINT SPACE$(70):GOTO 8125 8210 'ecran K1 8215 RESTORE 5105:SUP%=2^2+F9%:GOSUB 120 8216 GOSUB 5436 8217 LOCATE 6,10:GOSUB 5396 8218 LOCATE 10,10:GOSUB 5395 8220 LOCATE 12,10:GOSUB 5390:FONCT=158 8225 GOTO 8227 'GOSUB 2020:ON J GOTO 8226,8226,8230,8275,8225,8225,8227,8225,8225,8225 8226 GOSUB 2060:ON J GOTO 8085,8090 8227 GOTO 6605 'GOSUB 2060:GOTO 6605 8230 FIN=VALI㐞,DE+TROU:GOSUB 8700:IF MAUV THEN GOSUB 5353:GOTO 8225 ELSE GOSUB 5352:GOSUB 8235:GOTO 6605 8234 'delete liste 8235 PATQCL=0:PATQCH=0:GOSUB 11205:PAR(19)=0:PAR(20)=0 8257 FOR TY=1 TO FIN:TEMPO$(TY)=FAM$:NEXT TY 8260 VALIDE=0 8261 COC$=STRING$(128,0):LSET CHAMP$=COC$:PUT#3,1:PUT#3,2:GOSUB 6045:PARPAT$=COC$:PARENR$=COC$:TROU=0:GOSUB 5035:FOR T=19 TO 21:LSET P1$=MKI$(0):PUT#1,T:NEXT T:LSET P1$=MKI$(PAR(58)):PUT#1,58:CLOSE#1:RETURN 8265 GOSUB 5115 'exit 8272 IF AIG1% THEN 622 ELSE 610 8274 ' ecran N1 㐞,8275 RESTORE 5110:GOSUB 120 8280 CLOSE#2:CLOSE#3:GOSUB 592:LOCATE 10,20:PRINT "STORAGE REQUESTED":LOCATE 24,36:PRINT "Storage":PA$="saupai":GOTO 36 8374 'effacement centre ecran 8375 LOCATE 3,1:PRINT SPACE$(80):LOCATE 4,15:PRINT SPACE$(42):IF REPETE=0 THEN GOSUB 7615 8380 INCREM=0:FOR LKJ=1 TO 6 8385 INCREM=INCREM+1:COLONE=INCREM:IF INCREM>3 THEN COLONE=INCREM-3 8390 L=(15+2*(INT(INCREM/4))):C=(12+((COLONE-1)*26)):LOCATE L,C:PRINT SPACE$(8) 8395 NEXT LKJ 8400 COLOR 5,0:GOSUB 2080:GOSUB 2090:GOSUB 21㐞,00:LOCATE 20,48:PRINT SPACE$(9);:LOCATE 20,59:PRINT SPACE$(10) 8405 GOSUB 5288:GOSUB 5293:GOSUB 5298:LOCATE 21,51:PRINT " ";:LOCATE 21,63:PRINT " ";:COLOR 1,2 8410 RETURN 8699 'routine recherche methode en cours ou non validee pour effacement paille 8700 MAUV=0:IF PAR(37)<>0 THEN MAUV=1:RETURN 8705 IF PAR(52)<>0 THEN MAUV=2:RETURN 8710 FOR T=42 TO 49 8715 IF (PAR(T) AND 256)<>0 THEN MAUV=3 8720 NEXT T:RETURN 8795 'ecran O1 8800 RESTORE 5052:GOSUB 120 8805 LOCATE 5,1:GOSUB 5242 8806 IF FIRST=0 㐞,THEN L=5:GOSUB 2050:GOSUB 5432 8809 IF VINTEXT<9 THEN LOCATE 13,1:GOSUB 5245:COLOR 5,0:LOCATE 20,60:PRINT "Ext. comp":LOCATE 2,34:PRINT " PRINTER":COLOR 1,2 ELSE 8819 8810 GOTO 6385 'FONCT=254:GOSUB 2020:ON J GOTO 8811,8812,8900,8825,8810,8818,6385 8811 IF VINTEXT=7 THEN VINTEXT=2:GOTO 8115 ELSE GOSUB 2140:GOTO 8810 8812 VINTEXT=3:GOTO 8085 8818 VINTEXT=VINTEXT+2 8819 LOCATE 13,1:GOSUB 5246:COLOR 5,0:LOCATE 20,60:PRINT "Ext. prn ":LOCATE 2,34:PRINT " COMPUTER":COLOR 1,2 8820 GOTO 6385 'FONCT=254:GOS㐞,UB 2020:ON J GOTO 8821,8822,8900,8825,8820,8823,6385 8821 IF VINTEXT=9 THEN VINTEXT=4:GOTO 8115 ELSE GOSUB 2140:GOTO 8820 8822 VINTEXT=5:GOTO 8085 8823 VINTEXT=VINTEXT-2:GOTO 8809 8825 VINTEXT=VINTEXT+5:GOSUB 602 8826 RESTORE 5056:GOSUB 120:DISKID$="Z":GOSUB 10250 8827 IF SORT THEN 8887 8828 GOSUB 593 8829 IF VINTEXT <14 THEN PERIPH$="PRINTER ":FICHFORM$="FICHPRN.FIC":FORM$="FORMEXT" ELSE PERIPH$="COMPUTER":FICHFORM$="FICHCOMP.FIC":FORM$="FORMCOMP" 8832 RESTORE 5057:GOSUB 120:LOCATE 5,1:GOSUB 5247:㐞,COLOR 5,0:LOCATE 2,34:PRINT PERIPH$:COLOR 1,2 8833 GOSUB 6050 8835 FONCT=158:GOSUB 2020:ON J GOTO 8839,8850,8890,8837,8835,8835,8886 8837 IF VINTEXT <14 THEN VINTEXT=VINTEXT+2 ELSE VINTEXT=VINTEXT-2 8838 CLOSE#6:GOTO 8829 8839 GOSUB 8840:GOTO 8835 8840 GOSUB 602:GET#6,1:NFICH$=NFIC$:NBFICH=CVI(NBFIC$):TMFORM$(0,1)=NFICH$:TMFORM$(0,2)=COFIC$ 8841 LOCATE 5,1:PRINT "PRESENT FORMAT FOR EXT.";PERIPH$;" IS : ";LEFT$(NFICH$,8):PRINT 8842 LAFFI=8:CAFFI=1 8843 FOR NBLIGN%=2 TO NBFICH:GET#6,NBLIGN% 8844 NFI㐞,CH$=NFIC$:COFICH$=COFIC$ 8845 LOCATE LAFFI,CAFFI:PRINT LEFT$(NFICH$,8);" : ";COFICH$;:LAFFI=LAFFI+1 8846 IF LAFFI=14 THEN LAFFI=8:IF CAFFI=1 THEN CAFFI=40 ELSE CAFFI=1 8847 NEXT NBLIGN% 8848 RETURN 8849 'Transfert de format 8850 GOSUB 8840:LOCATE 17,29:PRINT SPACE$(30):LOCATE 17,1,1:PRINT "NAME OF FILE TO TRANSFER : ";:INPUT NMFICH$ 8851 LOCATE 5,1:PRINT SPACE$(60) 8852 DF=0:IF NMFICH$="" THEN 8856 8853 FOR NBLIGN%=2 TO NBFICH:GET#6,NBLIGN% 8854 NFICH$=NFIC$:IF NMFICH$=LEFT$(NFICH$,LEN(NMFICH$)) T㐞 ,HEN GOSUB 8880 8855 NEXT NBLIGN% 8856 IF DF=0 THEN LOCATE 17,31:PRINT "NO EXISTING FILE":GOTO 8835 8860 GOSUB 8875:GET#6,TREPET(ZX,1):NFICH$=NFIC$:COFICH$=COFIC$ 8862 LOCATE 5,1:PRINT "NEW FORMAT FOR EXT.";PERIPH$;" IS : ";LEFT$(NFICH$,8):PRINT 8863 LSET NFIC$=NFICH$:LSET COFIC$=COFICH$:NBFICH$=MKI$(NBFICH):LSET NBFIC$=NBFICH$:PUT#6,1 8864 CLOSE#6 8865 VIEW PRINT 6 TO 19:CLS:VIEW PRINT 8866 COLOR 5,0:LOCATE 20,1:PRINT SPACE$(45):LOCATE 21,1:PRINT SPACE$(45):COLOR 1,2 8867 OPEN"R",#5,NFICH$,257:FIEL㐞-D#5,255 AS DATDIR$,2 AS LNGBLC$ 8868 FOR VTRANS%=1 TO NBBLOC:GET#5,VTRANS%:TMFORM$(VTRANS%,1)=DATDIR$:TMFORM$(VTRANS%,2)=LNGBLC$:NEXT VTRANS% 8869 CLOSE#5:GOSUB 10350 8870 IF SORT THEN 8891 8872 OPEN"R",#5,FORM$,257:FIELD#5,255 AS DATDIR$,2 AS LNGBLC$: 8873 FOR VTRANS%=1 TO NBBLOC:LSET DATDIR$=TMFORM$(VTRANS%,1):LSET LNGBLC$=TMFORM$(VTRANS%,2):PUT #5,VTRANS%:NEXT VTRANS% 8874 CLOSE#5:GOTO 8887 8875 ZX=1:CV=1:IF DF=1 THEN RETURN 8876 IF ZX+CV>=DF THEN RETURN 8877 IF TREPET(ZX,2)>=TREPET(ZX+CV,2) THE㐞-N CV=CV+1 ELSE ZX=ZX+CV:CV=1 8878 GOTO 8876 8880 DF=DF+1:TREPET(DF,1)=NBLIGN%:ZX=0 8881 FOR CV=1 TO 8 8882 IF MID$(NFICH$,CV,1)=" " THEN ZX=ZX+1:TREPET(DF,2)=ZX 8883 NEXT CV 8885 RETURN 8886 CLOSE#6:GOSUB 602:GOSUB 10350:IF SORT THEN 8828 8887 GOSUB 593:VINTEXT=VINTEXT-5:GOTO 8800 8890 CLOSE#1:CLOSE#2:CLOSE#3:CLOSE#6:GOTO 621 8891 GOSUB 6050 8893 LSET NFIC$=TMFORM$(0,1):LSET COFIC$=TMFORM$(0,2):NBFICH$=MKI$(NBFICH):LSET NBFIC$=NBFICH$:PUT#6,1: 8894 CLOSE#6:GOTO 8829 8900 RESTORE 5058:GOSUB 120 㐞- 8905 LOCATE 5,1:GOSUB 5251 8910 FONCT=130:GOSUB 2020:ON J GOTO 8920,8910,8910,8910,8910,8910,8800 8920 LOCATE 17,1:INPUT "ENTER Y TO CONFIRM : ",REP$ 8925 IF REP$<>"Y" THEN LOCATE 17,1:PRINT SPACE$(50):GOTO 8910 8930 SHELL "CONFIGCO.BAT" 8940 END 9000 ' 9001 ' 9002 ' 9100 GOTO 9910 'appel au cadre 9110 GOSUB 2200 9111 GOSUB 2210:IF VCO THEN 9405 9112 FORMIN$=MID$(COMMENTAIRES$,7*(QUESTION-1)+1,7)+SPACE$(3):GOTO 9401 9120 FORMIN$=STR$(DECI):GOTO 9401 9130 FORMIN$=CHR$(13):GOTO 9401 9140 FORMI㐞-N$=DATEF$:GOTO 9401 9160 FORMIN$=CHR$(12):GOTO 9401 9170 IF SAUTER THEN FORMIN$=SPACE$(7) ELSE IF ECR$<>"" THEN FORMIN$=ECR$:SAUTER=1 ELSE P8!=VAL(VALSUP$)*COEF!:GOSUB 9420:FORMIN$=RIGHT$(FORMIN$,7) 9171 GOTO 9400 9180 FORMIN$=LEFT$(TIME$,5):GOTO 9401 9200 FORMIN$=STR$(P3!*COEF!):GOTO 9401 9210 ' 9220 FORMIN$=CHR$(10):GOTO 9401 9230 FORMIN$=LEFT$(ME$,6) 9232 IF VINTEXT>1 THEN IF MID$(LNGME$,6,3)<> " " THEN FORMIN$=LNGME$ ELSE FORMIN$=FORMIN$+SPACE$(26) 9233 IF P2=0 THEN 9401 9234 IF (P2 AND 1)㐞-=0 THEN FORMIN$=CHR$(91)+MID$(FORMIN$,1,LEN(FORMIN$))+CHR$(93):GOTO 9401 9237 GOTO 9401 9240 FORMIN$=NOM$:GOTO 9400 9250 ' 9260 FORMIN$=STR$(PATIENT):GOTO 9400 9270 GOSUB 2200 9271 GOSUB 2210:IF VCO THEN 9405 9272 FORMIN$=QUE$(QUESTION)+" : " 9273 IF VINTEXT<2 AND (QUESTION+1) MOD 2=0 THEN FORMIN$=CHR$(13)+CHR$(10)+FORMIN$ 9274 GOTO 9401 9281 IF P2 =0 THEN FORMIN$=SPACE$(8):GOTO 9401 9282 IF (P2 AND 1)=0 AND VINTEXT<2 THEN FORMIN$=SPACE$(6):GOTO 9401 9283 P8!=P3!*COEF!:GOSUB 9420:GOTO 9400 9290㐞- FORMIN$=SPACE$(6-LEN(STR$(P2)))+STR$(P2):GOTO 9401 9300 FORMIN$=CHR$(9):GOTO 9401 9310 FORMIN$=UNITE$:GOTO 9400 9320 FORMIN$=CHR$(11):GOTO 9401 9330 IF SAUTER THEN FORMIN$=SPACE$(7) ELSE IF ECR$<>"" THEN FORMIN$=ECR$:SAUTER=1 ELSE P8!=VAL(VALINF$)*COEF!:GOSUB 9420:FORMIN$=RIGHT$(FORMIN$,7) 9331 GOTO 9400 9340 VCMFORM%=VCMFORM%+1:QUESTION=ASC(TMFORM$(VBCMFORM%,VCMFORM%))-208 9341 IF QUESTION=1 THEN PRINT#4,CHECKSUM!:CHECKSUM!=0:GOTO 9405 9342 IF QUESTION=2 THEN PRINT#4,CHECKSUM! MOD 256:CHECKSUM!=0:㐞-GOTO 9405 9343 IF QUESTION=3 THEN PRINT#4,NOT(CHECKSUM! MOD 256):CHECKSUM!=0:GOTO 9405 9344 PRINT#4,0:GOTO 9405 9360 GOTO 9405 9400 IF DRAPMET AND DEBFINREP=3 AND VINTEXT<>4 AND VINTEXT<>5 THEN FORMIN$=SPACE$(LEN(FORMIN$)) 9401 IF VINTEXT=4 OR VINTEXT=5 THEN GOSUB 9410:GOTO 5850 9403 FORMIN$=FORMIN$+CHR$(0) 9404 PRINT#4,FORMIN$;:GOSUB 9410 9405 GOTO 5850 9410 FOR CHECASC=1 TO LEN(FORMIN$) 9411 CARFORM%=ASC(MID$(FORMIN$,CHECASC,1)) 9412 IF VINTEXT=4 OR VINTEXT=5 THEN RET%=0:CALL IO(&HF0,1,CARFORM%㐞-,RET%) 9413 IF RET%<>0 THEN CALL IO(&HF0,&H1E,0,RET%):IF RET% AND &H4 THEN NBERR%=NBERR%+1 9417 CHECKSUM!=CHECKSUM!+CARFORM% 9418 NEXT CHECASC 9419 RETURN 9420 IF ABS(P8!)/10^(6-DECI)<1 THEN 9421 ELSE DECI=DECI-1:GOTO 9420 9421 IF P8!>=0 THEN POLAR=0 ELSE POLAR=1 9423 P9!=10*INT(ABS(P8!*10^DECI)):IF INT(ABS(P8!*10^(DECI+1)))-P9!>=5 THEN P9!=P9!+10 9424 P9!=P9!/10:NBZERO=0:P3PUIS$=STR$(P9!):LONGRES=LEN(P3PUIS$)-1:IF MID$(STR$(P9!),2,1)="1" AND (MID$(STR$(P9!),3,1)="0" OR MID$(STR$(P9!),3,1)="") THEN 㐞 -VP9%=1 9425 P3PUIS$=RIGHT$(P3PUIS$,LONGRES) 9426 IF ABS(P8!)>=1 THEN 9435 ELSE IF VAL(P3PUIS$)<1 THEN FORMIN$=SPACE$(7)+"0":RETURN 9427 WHILE ABS(P8!)*10^NBZERO<1 9428 NBZERO=NBZERO+1:IF VP9% THEN VP9%=0 ELSE P3PUIS$="0"+P3PUIS$:LONGRES=LONGRES+1 9429 WEND 9435 IF VP9%=1 THEN VP9%=0 9436 IF POLAR=1 AND DECI<6 THEN P3PUIS$="-"+P3PUIS$:LONGRES=LONGRES+1 9437 IF DECI THEN FORMIN$=RIGHT$(SPACE$(7),7-LONGRES)+LEFT$(P3PUIS$,LONGRES-DECI)+"."+MID$(P3PUIS$,LONGRES-DECI+1,DECI):GOTO 9439 9438 FORMIN$=RIGHT$㐞-(SPACE$(7),8-LONGRES)+LEFT$(P3PUIS$,LONGRES-DECI) 9439 IF VAL(RIGHT$(FORMIN$,8-(7-LONGRES)))=0 THEN FORMIN$=SPACE$(7)+"0" 9440 RETURN 9499 ' METHODES 9500 FOR DECALAG%=0 TO 10 STEP 10 9505 FOR LLK%=0 TO 9 9510 LT=LLK%+1+DECALAG% 9515 DRAPMET=0:GOTO 9525 9520 IF DECALAG%=0 THEN IF (METRES1 AND 2^LLK%)=0 THEN 9575 ELSE 9530 ELSE IF (METRES2 AND 2^LLK%)=0 THEN 9575 ELSE 9530 9525 IF DECALAG%=0 THEN IF (MET1 AND 2^LLK%)=0 THEN 9575 ELSE 9530 ELSE IF (MET2 AND 2^LLK%)=0 THEN 9575 ELSE 9530 9530 P3$=MID㐞-$(VALEUR$,(3+(6*(LT-1))),4):P3!=CVS(P3$) 9535 P2$=MID$(VALEUR$,(1+(6*(LT-1))),2):P2=CVI(P2$) 9536 IF P2=0 OR (P2 AND 1)=0 THEN DRAPMET=1 9540 ' IF CONSULT THEN GOSUB 10130 ELSE GOSUB 6250 9545 ' GET#1,LK%+1+DECALAG% 9550 UNIT1$=U1$(LT):UNIT2$=U2$(LT):VALINF$=E1$(LT):VALSUP$=E2$(LT):DECI1$=D1$(LT):DECI2$=D2$(LT):COEF$=COF$(LT):ME$=METH$(LT):LNGME$=LNGME$(LT) 9560 ' CLOSE#1 9564 IF VAL(VALINF$)=0 AND VAL(VALSUP$)=0 THEN SAUTER=1 ELSE SAUTER=0 9565 IF UNITE=1 THEN UNITE$=UNIT1$:DECI=VAL(DECI1$):COEF!=1㐞- ELSE UNITE$=UNIT2$:DECI=VAL(DECI2$):COEF!=VAL(COEF$) 9566 IF P2 AND 2^2 THEN ECR$="M.Fact.":SAUTER=0 ELSE ECR$="" 9569 VBCMFORMD=TREPET(2,1):VCMFORMD=TREPET(2,2):VBCMFORMF=TREPET(3,1):VCMFORMF=TLBMFORM(VBCMFORMD):GOSUB 5800 9575 NEXT LLK% 9580 NEXT DECALAG% 9585 DRAPMET=0:RETURN 9710 'memorisation de form$ 9720 OPEN"R",#5,FORM$,257:FIELD#5,255 AS DATDIR$,2 AS LNGBLOC$ 9722 FOR VBCMFORM%=VBCMFORMD TO VBCMFORMF 9723 GET#5,VBCMFORM%:DATDISK$=DATDIR$:TLBMFORM(VBCMFORM%)=CVI(LNGBLOC$) 9724 VCMFORM%=1:㐞-LECTFORMD=1 9725 FOR LECTFORM%=1 TO TLBMFORM(VBCMFORM%) 9726 DATFORM$=MID$(DATDISK$,LECTFORM%,1) 9727 IF ASC(DATFORM$)<128 THEN 9735 9728 IF LECTFORM%>1 AND LECTFORM%<>LECTFORMD THEN TMFORM$(VBCMFORM%,VCMFORM%)=MID$(DATDISK$,LECTFORMD,LECTFORM%-LECTFORMD):VCMFORM%=VCMFORM%+1 9731 IF ASC(DATFORM$)=191 OR ASC(DATFORM$)=187 THEN DEBFINREP=DEBFINREP+1:TREPET(DEBFINREP,1)=VBCMFORM%:TREPET(DEBFINREP,2)=VCMFORM% 9734 TMFORM$(VBCMFORM%,VCMFORM%)=DATFORM$:VCMFORM%=VCMFORM%+1:LECTFORMD=LECTFORM%+1 9735 NEXT LE㐞-CTFORM% 9741 TLBMFORM(VBCMFORM%)=VCMFORM%-1 9742 NEXT VBCMFORM% 9743 CLOSE#5 9744 RETURN 9745 'edition par patient 9751 PERSON=ASC(MID$(PARPAT$,PATIENT,1)):IF PERSON=0 THEN 9765 9752 GET#2,PERSON 9753 NOM$=MN$:COMMENTAIRES$=RP$:MET1=CVI(M1$):MET2=CVI(M2$):METRES1=CVI(MR1$):METRES2=CVI(MR2$):VALEUR$=P$:WRT$="Man. Fact." 9754 NOM$=NOM$+SPACE$(5) 9755 IF NOM$=FAM$ THEN 9765 9758 DEBFINREP=2:VBCMFORMD=TREPET(1,1):VCMFORMD=TREPET(1,2):VBCMFORMF=TREPET(2,1):VCMFORMF=TLBMFORM(VBCMFORMD):GOSUB 5800 9759㐞- IF DEBFINMET=0 THEN 9765 9760 DEBFINREP=3:GOSUB 9500:REM ****** boucle methodes 9761 DEBFINREP=4:VBCMFORMD=TREPET(3,1):VCMFORMD=TREPET(3,2):VBCMFORMF=TREPET(4,1):VCMFORMF=TLBMFORM(VBCMFORMD):GOSUB 5800 9765 RETURN 9779 'lecture du tableau memoire 9840 VBCMFORMD=1:VCMFORMD=1:VBCMFORMF=TREPET(1,1):VCMFORMF=TLBMFORM(VBCMFORMD):GOSUB 5800:RETURN 9850 IF VINTEXT MOD 2=0 THEN GOSUB 9751:RETURN 9851 FOR PATIENT=1 TO 128 9852 GOSUB 9751 9853 IF PATIENT >VALIDE THEN 9856 9854 IF VSTOP THEN GOSUB 9860:GOT㐞-O 9856 9855 NEXT PATIENT 9856 RETURN 9860 IF VINTEXT=1 THEN DEV%=&H35:CIM%=8:GOTO 9866 9861 IF VINTEXT=3 THEN DEV%=&HF1:GOTO 9865 9862 IF VINTEXT=5 THEN DEV%=&HF0:GOTO 9865 9865 CIM%=&H1C 9866 DAT%=0:RET%=0:GOSUB 2130 9867 LOCATE 24,33:PRINT "STOP REQUESTED": 9868 RETURN 9869 ' 9870 VBCMFORMD=TREPET(DEBFINREP,1):VCMFORMD=TREPET(DEBFINREP,2) 9875 DEBFINREP=0:TREPET(0,2)=TLBMFORM(NBBLOC) 9880 VBCMFORMF=NBBLOC:VCMFORMF=TLBMFORM(VBCMFORMD):GOSUB 5800:RETURN 9905 'CADRE 9910 COLOR 5,0:VIEW PRINT 1㐞- TO 21:CLS:VIEW PRINT 9920 COLOR 1,2:VIEW PRINT 3 TO 19:CLS :VIEW PRINT 9925 VIEW PRINT 22 TO 25:CLS:VIEW PRINT 9930 COLOR 5,0:LOCATE 23,1:PRINT SPACE$(11):LOCATE 23,70:PRINT SPACE$(11) 9935 LOCATE 24,1:PRINT SPACE$(11):LOCATE 24,70:PRINT SPACE$(11) 9940 LOCATE 25,1 :PRINT SPACE$(11);:LOCATE 25,70:PRINT SPACE$(11);:COLOR 1,2 9945 LOCATE 23,32,0:PRINT"Instrument Status TC :" 9950 LOCATE 23,64:PRINT USING "##.#"; VAL(TEMPER$) 9955 LOCATE 1,1,0:RETURN 9999 DATA ,,,,,,,,,Data Review,, 10000 D㐞 -ATA ,,,,,,EXIT,,,Data Review,, 10001 DATA ,,,Delete,,,EXIT,,,Data Review,, 10003 DATA ,,,,,,,,,Data Deletion,, 10005 DATA Page,"S. Res.","All Res",,,,EXIT,,,Data Print out,, 10007 DATA Unit 1,Unit 2,,,,,EXIT,,,Data Print out,, 10010 LOCATE 18,40:PRINT "REPORT DATE (mm-dd-yy) ?":RETURN 10020 PRINT "-REMOVE THE WORKDISK":RETURN 10030 PRINT "-INSERT THE STORAGE DISK":RETURN 10035 PRINT "-INSERT THE TDEF DISK":RETURN 10040 LOCATE 17,30:PRINT "REMOVE THIS DISK":RETURN 10050 LOCATE 17,30:PRINT SPACE$(35㐞.):RETURN 10060 L=20:C=72 10061 COLOR 5,0:LOCATE L,C:PRINT SPACE$(8):LOCATE L+1,C+1:PRINT " ":COLOR 1,2:RETURN 10063 COLOR 5,0:LOCATE 20,15:PRINT "Review":LOCATE 21,17:PRINT "F2":COLOR 1,2 10065 COLOR 5,0:LOCATE 20,72:PRINT " EXIT ":GOSUB 5312:COLOR 1,2:RETURN 10070 PRINT "-INSERT THE WORKDISK":RETURN 10080 PRINT "-REMOVE THE STORAGE DISK":RETURN 10085 PRINT "-REMOVE THE TDEF DISK":RETURN 10090 LOCATE 7,5:PRINT SPACE$(35):RETURN 10095 COLOR 5,0:LOCATE 20,39:PRINT "Stop":LOCATE 21,40:PRINT "F4":COL㐞.OR 1,2:RETURN 10100 IF O2=64 THEN OPEN"r",#1,"b:mempaill",210 ELSE OPEN"r",#1,"mempaill",210 10105 FIELD#1,2 AS CB$,208 AS CP$:RETURN 10110 OPEN"r",#1,"id",1:FIELD#1,1 AS NM$:RETURN 10115 OPEN"r",#1,"b:id",1:FIELD#1,1 AS NM$:RETURN 10120 GOSUB 6040:CLOSE#3:RETURN 10130 OPEN"r",#1,METHPAIL$,35 10140 FIELD#1,6 AS A1$,6 AS U1$,6 AS U2$,1 AS D1$,1 AS D2$,5 AS COF$,5 AS E1$,5 AS E2$:RETURN 10200 DEV%=&H39:DAT%=0:CIM%=&HC:GOSUB 2130:RETURN 10210 GOSUB 10200:IF (RET% AND 128)=0 THEN FOR IYU=1 TO 2000:NEXT㐞. IYU:GOTO 10210 ELSE RETURN 'test si enleve 10220 GOSUB 10200:IF (RET% AND 128) THEN FOR IYU=1 TO 2000:NEXT IYU:GOTO 10220 ELSE RETURN 'test si remis 10250 GOSUB 10110:GET#1,1:SOURCE$=NM$:LSET NM$="S":PUT#1,2:CLOSE#1 'insertion stor. disq 10255 IF O2=64 THEN 10280 ELSE GOSUB 12510:GOSUB 593:GOSUB 12500:GOSUB 12520:LOCATE 7,5:GOSUB 10020 10260 A$=INKEY$:IF A$=CHR$(136) THEN SORT=1:RETURN ELSE SORT=0 10270 GOSUB 10200:IF (RET% AND 128)=0 THEN FOR IYU=1 TO 2000:NEXT IYU:GOTO 10260 10280 GOSUB 592:GOSUB㐞. 10090:LOCATE 9,5:IF VINTEXT<10 THEN GOSUB 10030 ELSE IF O2=64 THEN RETURN ELSE GOSUB 10035 10285 IF O2=64 THEN 10290 ELSE GOSUB 10060:GOSUB 10220:GOTO 10310 10290 GOSUB 593:A$=INKEY$:IF A$=CHR$(136) THEN SORT=1:RETURN ELSE SORT=0 10300 GOSUB 10200:IF (RET% AND 128) THEN FOR IYU=1 TO 2000:NEXT IYU:GOTO 10290 10310 IF O2=64 THEN GOSUB 10115 ELSE GOSUB 10110 10315 GET#1,1:DEST$=NM$:CLOSE#1:IF DEST$=DISKID$ THEN GOSUB 10050:RETURN 10320 GOSUB 12500:GOSUB 10040 10330 GOSUB 10210 10340 GOSUB 10050:GOTO 1㐞.0280 10350 IF VINTEXT<10 THEN 10355 ELSE IF O2=64 THEN 10390 ELSE LOCATE 7,5:GOSUB 10085:GOTO 10360 10355 IF O2=64 THEN RESTORE 9999 ELSE RESTORE 10000 10357 GOSUB 120:GOSUB 12500:LOCATE 7,5:GOSUB 10080 10360 A$=INKEY$:IF A$=CHR$(136) THEN SORT=1:RETURN ELSE SORT=0 10370 GOSUB 10200:IF (RET% AND 128)=0 THEN FOR IYU=1 TO 2000:NEXT IYU:GOTO 10360 10380 IF O2=64 THEN 10390 ELSE GOSUB 10090:GOSUB 10060:LOCATE 9,5:GOSUB 10070 10385 GOSUB 10220 10390 GOSUB 10110:GET#1,1:DEST$=NM$:GET#1,2:ORI$=NM$:IF DEST$㐞.=SOURCE$ AND ORI$="S" THEN LSET NM$=" ":PUT#1,2:CLOSE#1:GOSUB 10050:RETURN 10400 CLOSE#1:GOSUB 12500:GOSUB 10040:GOSUB 10210:GOSUB 10050:GOTO 10385 10410 GOSUB 10095:GOSUB 5715:L=20:C=39:GOSUB 10061:RETURN 10440 ' 10450 LOCATE 10,5:PRINT "ALL DATA STORED DELETION REQUESTED" 10455 GOSUB 10100:LSET CB$=MKI$(0):LSET CP$=SPACE$(208):PUT#1,1:CLOSE#1 10460 FOR DF=0 TO COMBIEN-1:TUER$=MID$(TITRE$,(1+(8*DF)),8):DTUER$="d"+LEFT$(TUER$,5)+RIGHT$(TUER$,2):IF O2=64 THEN TUER$="b:"+TUER$:DTUER$="b:"+DTUER$ 10465 㐞.KILL TUER$:KILL DTUER$:DTUER$="m"+RIGHT$(DTUER$,7):IF O2=64 THEN DTUER$="b:"+DTUER$ 10470 KILL DTUER$:NEXT DF:LOCATE 10,5:PRINT SPACE$(60):COMBIEN=0:RETURN 10500 GOSUB 9910:CONSULT=1:PAR20=PAR(20):VINTEXT=6:GOSUB 600:IF O2=64 THEN RESTORE 9999 ELSE RESTORE 10000 'ecran 1 10502 GOSUB 120 10505 DISKID$="Y":GOSUB 10250:IF SORT THEN 10530 10510 LOCATE 9,5:PRINT SPACE$(25):GOSUB 10100:GET#1,1:COMBIEN=CVI(CB$):TITRE$=CP$:CLOSE#1 10515 IF COMBIEN=0 THEN LOCATE 10,20:PRINT "NO REPORT STORED":GOSUB 12500:GO㐞.TO 10610 ELSE GOSUB 593:RESTORE 10001:SUP%=2^3+F9%:GOSUB 120 10517 LOCATE 4,31:PRINT "REPORTS IN MEMORY":L=6:C=-12:FOR DF=0 TO COMBIEN-1:C=C+16:IF C>65 THEN L=L+2:C=4 'consult disk 10518 LOCATE L,C:PRINT MID$(TITRE$,(1+(8*DF)),8):NEXT DF:GOSUB 10010 10520 MASK=131:FONCT=144:MAX=8:L=18:C=68:LOCATE L,C,1:GOSUB 310:ON J GOTO 10520,10520,10520,10535,10520,10520,10525,10520,10520,10540 10525 GOSUB 10350:IF SORT THEN 10515 'exit 10530 IF AIG1% THEN 622 ELSE 610 10535 RESTORE 10003:GOSUB 120:GOSUB 1045㐞 .0:GOTO 10515 10540 LOCATE ,,0:IF COMBIEN=0 THEN 10515 ELSE REP$=LEFT$(R$,2)+MID$(R$,4,2)+RIGHT$(R$,2)'nom cahier 10550 TROUVE=0:FOR DF=0 TO COMBIEN-1:TROUV$=MID$(TITRE$,(1+(8*DF)),2)+MID$(TITRE$,(4+(8*DF)),2)+MID$(TITRE$,(7+(8*DF)),2) 10560 IF REP$=TROUV$ THEN TROUVE=DF+1:CAHPAIL$=MID$(TITRE$,(1+(8*DF)),8):DF=COMBIEN-1 10570 NEXT DF:IF TROUVE=0 THEN LOCATE 18,68:PRINT SPACE$(9):GOTO 10515 10580 DECAHPAIL$="d"+LEFT$(CAHPAIL$,5)+RIGHT$(CAHPAIL$,2):IF O2=64 THEN CAHPAIL$="b:"+CAHPAIL$:DECAHPAIL$="b:"+DECA㐞.HPAIL$ 10582 GOSUB 10120:FOR DF=1 TO 128:IF ASC(MID$(PARPAT$,DF,1))<>0 THEN PAR(20)=DF:VALIDE=DF ELSE DF=128 10585 NEXT DF:GOSUB 5020:FOR DF=1 TO PAR(20):PAT=ASC(MID$(PARPAT$,DF,1)):GET#2,PAT:TEMPO$(DF)=MN$:NEXT DF 10587 METHPAIL$="m"+RIGHT$(DECAHPAIL$,7):IF O2=64 THEN METHPAIL$="b:"+METHPAIL$ 10588 GOSUB 10130:FOR DF=1 TO 20:GET#1,DF:METH$(DF)=A1$ 10589 U1$(DF)=U1$:U2$(DF)=U2$:E1$(DF)=E1$:E2$(DF)=E2$:D1$(DF)=D1$:D2$(DF)=D2$:COF$(DF)=COF$:NEXT DF:CLOSE#1 10590 RESTORE 10005:GOSUB 120:GOSUB 10670 '㐞.ecran edition 10600 VINTEXT=0:FONCT=142:GOSUB 2020:ON J GOTO 10740,10615,10620,10600,10600,10600,10605,10600,10600,10600 10605 CLOSE#2:GOTO 10515 10610 PAR(20)=PAR20:GOSUB 10350:IF COMBIEN=0 THEN 10530 ELSE IF SORT THEN GOSUB 10090:GOTO 10515 10615 UNITE=1:GOTO 8115 10620 VINTEXT=1:GOTO 8085 10625 RESTORE 10007:GOSUB 120:LOCATE 10,2:GOSUB 5365:LOCATE 12,2:GOSUB 5370 10630 FONCT=134:GOSUB 2020:ON J GOTO 8085,8090,10630,10630,10630,10630,10590,10630,10630,10630 10640 ' 10650 ' 10660 ' 10670 PREM=1:㐞.IF PAR(20)>63 THEN DERN=64 ELSE DERN=PAR(20)'liste 10680 L=4:C=-18:FOR DF=PREM TO DERN:PAT=ASC(MID$(PARPAT$,DF,1)):GET#2,PAT:NOM$=MN$:C=C+20:IF C>70 THEN L=L+1:C=2 10690 LOCATE L,(C+4-LEN(STR$(DF))):PRINT DF;"-";NOM$:NEXT DF 10710 LOCATE 3,15:PRINT "REPORT DATE : ";CAHPAIL$ TAB(50) "PATIENT LIST ";PREM;" TO ";DERN:RETURN 10740 GOSUB 602:IF PAR(20)<65 THEN GOSUB 10680:GOTO 10600 ELSE IF PREM=1 THEN PREM=65:DERN=PAR(20):GOSUB 10680:GOTO 10600 ELSE PREM=1:DERN=64:GOSUB 10680:GOTO 10600 11000 IF (PAR(58) A㐞.ND 255)<>0 OR PATIENT=128 THEN COLOR 5,0:GOSUB 2103 ELSE COLOR 5,0:GOSUB 5296:GOSUB 5299 11010 IF ((PAR(58) AND 32512)/256)<>0 OR PATIENT=128 THEN COLOR 5,0:GOSUB 2107 ELSE COLOR 5,0:GOSUB 5301:GOSUB 5302 11020 RETURN 11100 GOSUB 11400:LOCATE L,C:PRINT "QC 1"+SPACE$(8):DRAPQC=1:PATQCL=PATIENT:GOTO 11120 11110 GOSUB 11400:LOCATE L,C:PRINT "QC 2"+SPACE$(8):DRAPQC=2:PATQCH=PATIENT:GOTO 11120 11120 GOSUB 11205:IF DRAPQC=1 THEN R$="QC 1" ELSE IF DRAPQC=2 THEN R$="QC 2" 11130 ON X GOTO 7550,7065 11200 IF R㐞.$="QC 1" THEN PATQCL=0 ELSE IF R$="QC 2" THEN PATQCH=0 11205 PAR(58)=PATQCL+(PATQCH*256):RETURN 11300 IF SURN$="QC 1"+SPACE$(8) THEN PATQCL=0:GOTO 11205 ELSE IF SURN$="QC 2"+SPACE$(8) THEN PATQCH=0:GOTO 11205 ELSE RETURN 11400 IF X=1 THEN L=4:C=37:RETURN ELSE IF X=2 THEN L=4:C=46:RETURN 11500 IF TEMPO$(PATQCL)<>"QC 1"+SPACE$(8) THEN PATQCL=0 11510 IF TEMPO$(PATQCH)<>"QC 2"+SPACE$(8) THEN PATQCH=0 11520 GOTO 11205 11600 FONCT=176:IF PATIENT=128 THEN FONCT=128:RETURN ELSE IF (PAR(58) AND 255)<>0 THEN F㐞.ONCT=FONCT-16 11650 IF ((PAR(58) AND 32512)/256)<>0 THEN FONCT=FONCT-32 11670 RETURN 11700 IF PATIENT=128 THEN FONCT=134:RETURN ELSE IF (PAR(58) AND 255)<>0 THEN FONCT=FONCT-16 11750 IF ((PAR(58) AND 32512)/256)<>0 THEN FONCT=FONCT-32 11770 RETURN 11800 IF R$="QC 1" THEN PATQCL=PATIENT:GOTO 11205 11900 IF R$="QC 2" THEN PATQCH=PATIENT:GOTO 11205 ELSE RETURN 12000 ENTR=0:GOSUB 6315 12030 FOR TEST=1 TO 6 12040 IF QUE$(TEST)=SPACE$(7) OR QUE$(TEST)="" THEN TOTO=TOTO+1 12050 NEXT TEST:IF TOTO=6 THEN 㐞.GOSUB 2103 ELSE LOCATE 20,38:PRINT "Comments":ENTR=1:GOSUB 5299 12060 TOTO=0:RETURN 12100 ZZ=1:FOR TITI=QUESTION TO 6 12110 IF REPONSE$(TITI)="" THEN REPONSE$(TITI)=MID$(REPONSE$,((7*(TITI-1))+1),7) 12120 COMMENTAIRE$=COMMENTAIRE$+REPONSE$(TITI):NEXT TITI:LOCATE 18,1,0 12130 IF AFFICH<>3 THEN GOSUB 7815 ELSE ZZ=0:RUSE=1:GOTO 7815 12140 ZZ=0:ON J GOTO 8000,8015,8005,7790,12150,8010,8040 12150 IF SANS=2 THEN GOTO 8072 ELSE GOTO 8057 12500 FOR LT=1 TO 4000:NEXT LT:RETURN 12510 LOCATE 16,30:PRINT " 㐞.PLEASE WAIT ":RETURN 12520 LOCATE 16,30:PRINT SPACE$(16):RETURN 12600 IF RANG3 THEN COLONE=INCC-3 13515 REPONSE$(TITI)=MID$(REPONSE$,((7*(TITI-1))+1),7) 13520 LOCATE (15+2*(INT(INCC/4))),(1+((COLONE-1)*26)):PRINT QUE$(TITI);" : ";REPONSE$(TITI); 13530 NEXT TITI:INCC=0:COLOR 5,0:RETU㐞/RN 14000 OPEN "r",#1,"jourtes",4:FIELD#1,4 AS JOUR$ 14005 GET#1,1 14007 R$=JOUR$:SE$="1" 14010 R=VAL(R$)+VAL(SE$):R$=STR$(R) 14020 LPRINT "JOUR : ";JOUR$;" HEURE : ";TIME$ 14025 LPRINT:LPRINT:LPRINT 14030 LSET JOUR$=R$:PUT#1,1:CLOSE#1 14040 RETURN 15000 FOR IC=1 TO 4:GET#1,IC:LSET FLG$=R$:PUT#1,IC:NEXT IC:CLOSE#1:RETURN 30000 OPEN"r",#1,"NAMETH",105 30010 FIELD#1,6 AS A1$,6 AS D$,32 AS A2$,32 AS A3$,6 AS U1$,6 AS U2$,1 AS D1$,1 AS D2$,5 AS COF$,5 AS E1$,5 AS E2$ 30020 FOR I=1 TO 32 30030 GET#㐞/1,I 30040 B$(I)=A1$:MTT$(I)=A3$ 30050 NEXT I:CLOSE#1:RETURN ELSE OPEN"r",#1,"mempaill",210 10105 FIELD#1,2 AS CB$,208 AS CP$:RETURN 10110 OPEN"r",#1,"id",1:FIELD#1,1 AS NM$:RETURN 10115 OPEN"r",#1,"b:id",1:FIELD#1,1 AS NM$:RETURN 10120 GOSUB 6040:CLOSE#3:RETURN 10130 OPEN"r",#1,METHPAIL$,35 10140 FIELD#1,6 AS A1$,6 AS U1$,6 AS U2$,1 AS D1$,1 AS D2$,5 AS COF$,5 AS E1$,5 AS E2$:RETURN 10200 DEV%=&H39:DAT%=0:CIM%=&HC:GOSUB 2130:RETURN 10210 GOSUB 10200:IF (RET% AND 128)=0 THEN FOR IYU=1 TO 2000:NEXTZ>/Z>/Z>/Z>/Z>/Z>/Z> /Z>/Z>/Z>/Z>/Z>/Z>/Z>/Z>/Z> /Z>0Z>0Z>0Z>0Z>0Z>0Z>0Z>0Z> 0Z>0Z>0Z>0Z>0Z>0Z>0Z>0Z>0Z> 0Z>1Z>1Z>1Z>1Z>1Z>1Z>1Z>1Z> 1Z>1Z>1Z>1Z>1Z>1Z>1Z>1Z>1Z> 1Z>2Z>2Z>2Z>2Z>2Z>2Z>2Z>2Z> 2Z>2Z>2Z>2Z>2Z>2Z>2Z>2Z>2Z> 2Z>3Z>3Z>3Z>3Z>3Z>3Z>3Z>3Z> 3Z>3Z>3Z>3Z>3Z>3Z>3Z>3Z>3Z> 3Z>4Z>4Z>4Z>4Z>4Z>4Z>4Z>4Z> 4Z>4Z>4Z>4Z>4Z>4Z>4Z>4Z>4Z> 4Z>5Z>5Z>5Z>5Z>5Z>5Z>5Z>5Z> 5Z>5Z>5Z>5Z>5Z>5Z>5Z>5Z>5Z> 5Z>6Z>6Z>6Z>6Z>6Z>6Z>6Z>6Z> 6Z>6Z>6Z>6Z>6Z>6Z>6Z>6Z>6Z> 6Z>7Z>7Z>7Z>7Z>7Z>7Z>7Z>7Z> 7Z>7Z>7Z>7Z>7Z>7Z>7Z>7Z>7Z> 7Z>8Z>8Z>8Z>8Z>8Z>8Z>8Z>8Z> 8Z>8Z>8Z>8Z>8Z>8Z>8Z>8Z>8Z> 8Z>9Z>9Z>9Z>9Z>9Z>9Z>9Z>9Z> 9Z>9Z>9Z>9Z>9Z>9Z>9Z>9Z>9Z> 9Z>:Z>:Z>:Z>:Z>:Z>:Z>:Z>:Z> :Z>:Z>:Z>:Z>:Z>:Z>:Z>:Z>:Z> :Z>;Z>;Z>;Z>;Z>;Z>;Z>;Z>;Z> ;Z>;Z>;Z>;Z>;Z>;Z>;Z>;Z>;Z> ;Z><Z><Z><Z><Z><Z><Z><Z><Z> <Z><Z><Z><Z><Z><Z><Z><Z><Z> <Z>=Z>=Z>=Z>=Z>=Z>=Z>=Z>=Z> =Z>=Z>=Z>=Z>=Z>=Z>=Z>=Z>=Z> =Z>>Z>>Z>>Z>>Z>>Z>>Z>>Z>>Z> >Z>>Z>>Z>>Z>>Z>>Z>>Z>>Z>>Z> >Z>?Z>?Z>?Z>?Z>?Z>?Z>?Z>?Z> ?Z>?Z>?Z>?Z>?Z>?Z>?Z>?Z>?Z> ?Z>@Z>@Z>@Z>@Z>@Z>@Z>@Z>@Z> @Z>@Z>@Z>@Z>@Z>@Z>@Z>@Z>@Z> @Z>AZ>AZ>AZ>AZ>AZ>AZ>AZ>AZ> AZ>AZ>AZ>AZ>AZ>AZ>AZ>AZ>AZ> AZ>BZ>BZ>BZ>BZ>BZ>BZ>BZ>BZ> BZ>BZ>BZ>BZ>BZ>BZ>BZ>BZ>BZ> BZ>CZ>CZ>CZ>CZ>CZ>CZ>CZ>CZ> CZ>CZ>CZ>CZ>CZ>CZ>CZ>CZ>CZ> CZ>DZ>DZ>DZ>DZ>DZ>DZ>DZ>DZ> DZ>DZ>DZ>DZ>DZ>DZ>DZ>DZ>DZ> DZ>EZ>EZ>EZ>EZ>EZ>EZ>EZ>EZ> EZ>EZ>EZ>EZ>EZ>EZ>EZ>EZ>EZ> EZ>FZ>FZ>FZ>FZ>FZ>FZ>FZ>FZ> FZ>FZ>FZ>FZ>FZ>FZ>FZ>FZ>FZ> FZ>GZ>GZ>GZ>GZ>GZ>GZ>GZ>GZ> GZ>GZ>GZ>GZ>GZ>GZ>GZ>GZ>GZ> GZ>HZ>HZ>HZ>HZ>HZ>HZ>HZ>HZ> HZ>HZ>HZ>HZ>HZ>HZ>HZ>HZ>HZ> HZ>IZ>IZ>IZ>IZ>IZ>IZ>IZ>IZ> IZ>IZ>IZ>IZ>IZ>IZ>IZ>IZ>IZ> IZ>JZ>JZ>JZ>JZ>JZ>JZ>JZ>JZ> JZ>JZ>JZ>JZ>JZ>JZ>JZ>JZ>JZ> JZ>KZ>KZ>KZ>KZ>KZ>KZ>KZ>KZ> KZ>KZ>KZ>KZ>KZ>KZ>KZ>KZ>KZ> KZ>LZ>LZ>LZ>LZ>LZ>LZ>LZ>LZ> LZ>LZ>LZ>LZ>LZ>LZ>LZ>LZ>LZ> LZ>MZ>MZ>MZ>MZ>MZ>MZ>MZ>MZ> MZ>MZ>MZ>MZ>MZ>MZ>MZ>MZ>MZ> MZ>NZ>NZ>NZ>NZ>NZ>NZ>NZ>NZ> NZ>NZ>NZ>NZ>NZ>NZ>NZ>NZ>NZ> NZ>OZ>OZ>OZ>OZ>OZ>OZ>OZ>OZ> OZ>OZ>OZ>OZ>OZ>OZ>OZ>OZ>OZ> O㐞SOURCES SOAK TEST SIMULATOR