1 REM PATIENTEN REGISTRATIE- EN ZOEKPROGRAMMA
2 REM TRIOTEL / TRIOSORT
3 REM B.A.E. van der Pol
4 REM Spanjaardslaan 102
5 REM 8917 AW  LEEUWARDEN
6 REM april 1982 / october 1983
10 PRINT CHR$(&H1A):PRINT
20 PRINT "** PATIENTEN REGISTRATIE- EN ZOEKPROGRAMMA ..."
30 PRINT TAB(10);"TRIOTEL / TRIOSORT **"
40 PRINT:PRINT:PRINT "Wilt u naar het werkprogramma TRIOTEL ..."
50 PRINT "Type dan <W>."
60 PRINT "Wilt u naar het zoekprogramma TRIOSORT ..."
70 PRINT "Type dan <Z>."
80 PRINT:PRINT "Controleer eerst of u de juiste schijf .."
90 PRINT "in de B drive geplaatst heeft !"
100 PRINT "Is dit niet het geval doe dat dan eerst !"
110 PRINT:INPUT "Heeft u dit gedaan ";J$
120 RESET
130 PRINT:PRINT "Maak dan nu uw programmakeuze !"
140 KAR$=INPUT$(1)
150 IF ASC(KAR$)<65 OR ASC(KAR$)>90 THEN 160 ELSE 180
160 PRINT:PRINT "GEBRUIK HOOFDLETTERS !"
170 PRINT:PRINT "DRUK DE ALPHA LOCK IN !"
180 IF KAR$="W" THEN 210
190 IF KAR$="Z" THEN 3950
200 GOTO 140
210 REM HOOFDMENU
220 PRINT CHR$(&H1A)
230 PRINT TAB(10);"** PATIENTENREGISTRATIE 'TRIOTEL' **"
240 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
250 PRINT TAB(10);"** HOOFDMENU **"
260 PRINT
270 PRINT "U heeft de volgende mogelijkheden:":PRINT
280 PRINT "INVOER VAN GEGEVENS ..........:1"
290 PRINT "UITVOER VAN GEGEVENS .........:2"
300 PRINT "VERANDEREN VAN GEGEVENS ......:3"
310 PRINT "EINDE ........................:4"
320 PRINT
330 INPUT "Wat is uw keuze ";K
340 IF K<0 OR K>4 THEN 330
350 ON K GOTO 360, 1300, 2800, 3550
360 PRINT CHR$(&H1A)
370 PRINT:PRINT:PRINT TAB(10);"** INVOER VAN GEGEVENS **"
380 PRINT
390 PRINT "Moet het werkbestand eerst gelezen worden"
400 PRINT "tot het eerste vrije record ? .............. 1"
410 PRINT "Of weet u het eerste vrije volgnummer nog"
420 PRINT "en wilt u daarmee direct beginnen ? ........ 2"
430 PRINT "Retour hoofdmenu ? ......................... 3"
440 PRINT:INPUT "Wat is uw keuze ";K
450 IF K<0 OR K>3 THEN 440
460 IF K=3 THEN  210
470 IF K=2 THEN 740
480 REM KIJK OF DE FILE EXISTEERT
490 OPEN "R",#1,"B:PRWERK.DAT",23
500 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
510 GET #1
520 REM GEEN FILE, DAN CREER EEN
530 IF EOF (1) THEN GOSUB 3660:GOTO 770
540 CLOSE #1
550 REM LEES FILE EN GEEF EERSTE VRIJE RECORD
560 OPEN "R",#1,"B:PRWERK.DAT",23
570 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
580 FOR LUS=0 TO 999
590 GET #1
600 V$=VOLGN$
610 G$=GEBD$
620 N$=NAAM$
630 S$=SEX$
640 F$=FOTO$
650 E$=EERD$
660 D$=DIAGN$
670 LC=LOC(1)-1
680 IF V$<>"000" AND VAL(V$)=0 THEN 710
690 NEXT LUS
700 CLOSE #1
710 PRINT CHR$(&H1A):PRINT:PRINT:PRINT "Het eerstvolgende volgnummer wordt :";LC
720 H=LC:GOTO 780
730 REM EIGENLIJKE INVOER VAN DATA
740 PRINT CHR$(&H1A):PRINT:PRINT
750 INPUT "MET WELK VOLGNUMMER BEGINT U ";H
760 OPEN "R",#1,"B:PRWERK.DAT",23
770 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
780 REM
790 H=H+1
800 PRINT:PRINT "PATIENT NR. ... ";H-1
810 PRINT
820 INPUT "VOLGNUMMER (3 POS):";V$
830 IF LEN(V$)<>3 THEN 820
840 IF VAL(V$)<>H-1 THEN 850 ELSE 860
850 PRINT "Onjuist volgnummer !":GOTO 820
860 INPUT "GEB.DAT (6 POS):";G$
870 IF LEN(G$)<>6 THEN 860
880 INPUT "4 LETTERS NAAM (4 POS):";N$
890 IF LEN(N$)<>4 THEN 880
900 INPUT "GESLACHT, M OF V (1 POS):";S$
910 IF S$<>"M" AND S$<>"V" THEN 900
920 INPUT "FOTO,JA=J EN NEE=N (1 POS):";F$
930 IF F$<>"J" AND F$<>"N" THEN 920
940 INPUT "EERD.DIAGN. JAAR (2 POS):";E$
950 IF LEN(E$)<>2 THEN 940
960 INPUT "DIAGNOSE (6 POS):";D$
970 IF LEN(D$)<>6 THEN 960
980 LSET VOLGN$=V$
990 LSET GEBD$=G$
1000 LSET NAAM$=N$
1010 LSET SEX$=S$
1020 LSET FOTO$=F$
1030 LSET EERD$=E$
1040 LSET DIAGN$=D$
1050 PUT #1, H
1060 REM KIJK OF FILE VOL IS
1070 IF H=1001 THEN 1080 ELSE 1220
1080 PRINT CHR$(&H1A)
1090 PRINT:PRINT:PRINT:PRINT
1100 PRINT "HET WERKBESTAND IS VOL !!"
1110 PRINT:PRINT "Voordat u verder gaat moet u eerst .."
1120 PRINT "het werkbestand opbergen op de diskette .."
1130 PRINT "met de zoekbestanden van dit jaar."
1140 PRINT "U moet dit doen met het PIP - programma van CP/M"
1150 PRINT "Het nu gevulde werkbestand moet een naam krijgen .."
1160 PRINT "die logisch volgt op de reeds aanwezige bestanden .."
1170 PRINT "op de diskette van dit jaar."
1180 PRINT "De bestandsnamen bestaan uit de letters PR .."
1190 PRINT "met een volgnummer, dus bv. PR2.DAT."
1200 PRINT:INPUT "BENT U KLAAR VOOR CP/M (type <return>)";C$
1210 SYSTEM
1220 PRINT "VOLGENDE PATIENT (<J> of <return> / <N>) ?"
1230 INPUT "Of nog correctie - herinvoer (<C>) ";Q$
1240 IF Q$="C" THEN 800
1250 IF Q$<>"N" THEN 790
1260 CLOSE #1
1270 PRINT CHR$(&H1A)
1280 PRINT "Het laatst ingevoerde volgnr. is: ";V$
1290 GOTO 240
1300 PRINT CHR$(&H1A)
1310 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
1320 PRINT TAB(10);"** UITVOER VAN GEGEVENS **"
1330 PRINT
1340 PRINT "U moet eerst de sorteerexpressie formuleren."
1350 PRINT
1360 PRINT "Alle variabelen moeten gedefinieerd worden"
1370 PRINT "in termen van een boven - en ondergrens."
1380 PRINT "Geldt voor een variabele slechts een waarde"
1390 PRINT "dan moeten beide grenzen gelijke waarden krijgen."
1400 PRINT
1410 PRINT "Van de geboortedatum en de diagnose"
1420 PRINT "kunnen delen als sorteercriterium"
1430 PRINT "gekozen worden."
1440 PRINT "Bv. het geboortejaar."
1450 PRINT:PRINT:PRINT
1460 PRINT "Voor continueren type <return>"
1470 INPUT "Voor retour hoofdmenu type <H> ";X$
1480 IF X$="H" THEN 210
1490 PRINT CHR$(&H1A)
1500 PRINT:PRINT"VOLGNUMMER"
1510 PRINT
1520 INPUT "ONDERGRENS ... ";VOO$
1530 IF VOO$<"000" THEN 1520
1540 INPUT "BOVENGRENS ... ";VOB$
1550 IF VOB$>"999" THEN 1540
1560 PRINT CHR$(&H1A)
1570 PRINT:PRINT"GEBOORTEDATUM"
1580 PRINT:PRINT "DDMMJJ"
1590 PRINT "123456"
1600 PRINT:PRINT "HOEVEEL KARAKTERS MOETEN GEBRUIKT WORDEN ?"
1610 PRINT "EN VANAF WELK KARAKTER GEREKEND ?"
1620 PRINT "BV. BIJ HET GEB.JAAR: VANAF HET 5e"
1630 PRINT "2 KARAKTERS (5 EN 6)."
1640 INPUT "VANAF WELK KARAKTER : ";G1
1650 INPUT "HOEVEEL KARAKTERS : ";G2
1660 PRINT
1670 PRINT:INPUT "ONDERGRENS ... ";GBO$
1680 INPUT "BOVENGRENS ... ";GBB$
1690 IF LEN(GBO$)<>G2 OR LEN(GBB$)<>G2 THEN 1560
1700 PRINT CHR$(&H1A)
1710 PRINT:PRINT "NAAM"
1720 INPUT "ONDERGRENS (MIN. AAAA) ... ";NAO$
1730 INPUT "BOVENGRENS (MAX. ZZZZ) ... ";NAB$
1740 IF LEN(NAO$)<>4 OR LEN(NAB$)<>4 THEN 1700
1750 PRINT CHR$(&H1A)
1760 PRINT:PRINT "GESLACHT"
1770 PRINT "MANNETJES .......... : 1"
1780 PRINT "VROUWTJES .......... : 2"
1790 PRINT "BEIDE .............. : 3"
1800 INPUT L
1810 IF L>3 OR L<0 THEN 1800
1820 ON L GOTO 1830,1840,1850
1830 SEO$="A":SEB$="N":GOTO 1860
1840 SEO$="U":SEB$="Z":GOTO 1860
1850 SEO$="A":SEB$="Z"
1860 PRINT CHR$(&H1A)
1870 PRINT:PRINT"FOTO"
1880 PRINT
1890 PRINT "WEL FOTO ....... : 1"
1900 PRINT "GEEN FOTO ...... : 2"
1910 PRINT "BEIDE .......... : 3"
1920 INPUT L
1930 IF L>3 OR L<0 THEN 1920
1940 ON L GOTO 1950,1960,1970
1950 FOO$="A":FOB$="M":GOTO 1980
1960 FOO$="M":FOB$="Z":GOTO 1980
1970 FOO$="A":FOB$="Z"
1980 PRINT CHR$(&H1A)
1990 PRINT:PRINT "EERDERE DIAGNOSE"
2000 PRINT:INPUT "ONDERGRENS ... ";EEO$
2010 INPUT "BOVENGRENS ... ";EEB$
2020 IF LEN(EEO$)<>2 OR LEN(EEB$)<>2 THEN 1980
2030 PRINT CHR$(&H1A)
2040 PRINT:PRINT "DIAGNOSE"
2050 PRINT:PRINT "SCHEMA: 123456"
2060 PRINT:PRINT "VANAF WELK KARAKTER MOETEN HOEVEEL"
2070 PRINT "GEBRUIKT WORDEN ?"
2080 INPUT "VANAF KARAKTER NR. : ";D1
2090 INPUT "AANTAL KARAKTERS : ";D2
2100 PRINT
2110 PRINT:INPUT "ONDERGRENS ... ";DIO$
2120 INPUT "BOVENGRENS ... ";DIB$
2130 IF LEN(DIO$)<>D2 OR LEN(DIB$)<>D2 THEN 2030
2140 PRINT CHR$(&H1A)
2150 PRINT
2160 PRINT "U KUNT KIEZEN UIT ....:"
2170 PRINT "SORTEREN OP SCHERM .......:1"
2180 PRINT "SORTEREN OP PRINTER ......:2"
2190 PRINT "RETOUR HOOFDMENU .........:3"
2200 INPUT "WAT KIEST U:";L
2210 PRINT CHR$(&H1A)
2220 ON L GOTO 2240,2550,220
2230 PRINT
2240 REM ZOEK OP SORTEERFORMULE VOOR UITVOER OP SCHERM
2250 OPEN "R",#1,"B:PRWERK.DAT",23
2260 FIELD #1, 3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
2270 FOR LUS=0 TO 999
2280 GET #1
2290 V$=VOLGN$
2300 G$=GEBD$
2310 N$=NAAM$
2320 S$=SEX$
2330 F$=FOTO$
2340 E$=EERD$
2350 D$=DIAGN$
2360 IF V$="000" THEN PRINT "BESTAND : ";G$+N$
2370 IF V$>=VOO$ AND V$<=VOB$ THEN 2380 ELSE 2520
2380 IF MID$(G$,G1,G2)>=GBO$ AND MID$(G$,G1,G2)<=GBB$ THEN 2390 ELSE 2520
2390 IF N$>=NAO$ AND N$<=NAB$ THEN 2400 ELSE 2520
2400 IF S$>=SEO$ AND S$<=SEB$ THEN 2410 ELSE 2520
2410 IF F$>=FOO$ AND F$<=FOB$ THEN 2420 ELSE 2520
2420 IF E$>=EEO$ AND E$<=EEB$ THEN 2430 ELSE 2520
2430 IF MID$(D$,D1,D2)>=DIO$ AND MID$(D$,D1,D2)<=DIB$ THEN 2440 ELSE 2520
2440 PRINT
2450 PRINT "VOLGN.,GEB.DAT.,NAAM,GESLACHT:";V$;".";G$;".";N$;".";S$
2460 PRINT "FOTO:";F$,"EERD.DIAGN.:";E$
2470 PRINT "DIAGNOSE:";D$
2480 PRINT
2490 INPUT "NOG MEER:";J$
2500 IF J$<>"N" GOTO 2520
2510 GOTO 2530
2520 NEXT LUS
2530 CLOSE #1
2540 GOTO 1300
2550 REM ZOEK OP SORTEERFORMULE VOOR UITVOER OP PRINTER
2560 OPEN "R",#1,"B:PRWERK.DAT",23
2570 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
2580 FOR LUS=0 TO 999
2590 GET #1
2600 V$=VOLGN$
2610 G$=GEBD$
2620 N$=NAAM$
2630 S$=SEX$
2640 F$=FOTO$
2650 E$=EERD$
2660 D$=DIAGN$
2670 IF V$="000" THEN PRINT "BESTAND : ";G$+N$
2680 IF V$>=VOO$ AND V$<=VOB$ THEN 2690 ELSE 2770
2690 IF MID$(G$,G1,G2)>=GBO$ AND MID$(G$,G1,G2)<=GBB$ THEN 2700 ELSE 2770
2700 IF N$>=NAO$ AND N$<=NAB$ THEN 2710 ELSE 2770
2710 IF S$>=SEO$ AND S$<=SEB$ THEN 2720 ELSE 2770
2720 IF F$>=FOO$ AND F$<=FOB$ THEN 2730 ELSE 2770
2730 IF E$>=EEO$ AND E$<=EEB$ THEN 2740 ELSE 2770
2740 IF MID$(D$,D1,D2)>=DIO$ AND MID$(D$,D1,D2)<=DIB$ THEN 2750 ELSE 2770
2750 LPRINT V$;".";G$;".";N$;".";S$
2760 LPRINT F$,E$,D$
2770 NEXT LUS
2780 CLOSE #1
2790 GOTO 1300
2800 PRINT CHR$(&H1A)
2810 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
2820 PRINT TAB(10);"** VERANDEREN IN HET BESTAND **"
2830 LC=0
2840 PRINT
2850 PRINT "WILT U EERST DE BETR. RECORD ZIEN ?"
2860 INPUT "voor retour hoofdmenu type <H> ";J$
2870 IF LEFT$(J$,1)="H" THEN 220
2880 IF LEFT$(J$,1)<>"J" THEN 3120 ELSE 2890
2890 PRINT:PRINT "WAT IS HET BETREFFENDE VOLGNUMMER ?"
2900 INPUT K$
2910 IF LEN(K$)<>3 GOTO 2900
2920 OPEN "R",#1,"B:PRWERK.DAT",23
2930 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$, 2 AS EERD$,6 AS DIAGN$
2940 FOR LUS=0 TO 999
2950 GET #1
2960 V$=VOLGN$
2970 G$=GEBD$
2980 N$=NAAM$
2990 S$=SEX$
3000 F$=FOTO$
3010 E$=EERD$
3020 D$=DIAGN$
3030 IF V$=K$ THEN 3050 ELSE 3100
3040 IF V$="000" THEN PRINT:PRINT "BESTAND : ";G$+N$
3050 PRINT:PRINT V$;".";G$;".";N$;".";S$
3060 PRINT F$,E$,D$
3070 PRINT "HET RECORDNUMMER IS:";LOC(1)
3080 LC=LOC(1)
3090 GOTO 3110
3100 NEXT LUS
3110 CLOSE #1
3120 PRINT
3130 PRINT "INVOER VAN DE NIEUWE DATA"
3140 PRINT
3150 INPUT "WILT U VERDER OF RETOUR HOOFDMENU ('H')";Q$
3160 IF Q$<>"H" THEN 3170 ELSE 210
3170 PRINT:INPUT "HET VOLGNR. IS .... ";H
3180 H=H+1
3190 REM KIJK OF VOLNUMMER EN RECORDNUMMER KLOPPEN
3200 IF H<>LC AND LC<>0 THEN 3210 ELSE 3260
3210 PRINT CHR$(&H1A):PRINT:PRINT "HET VOLGNUMMER KOMT NIET OVEREEN "
3220 PRINT "MET HET RECORD, WAARVAN U AANGEGEVEN HEEFT, "
3230 PRINT "DAT U HET WILDE WIJZIGEN."
3240 PRINT "DAAROM NOGMAALS ...."
3250 GOTO 2840
3260 OPEN "R",#1,"B:PRWERK.DAT",23
3270 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
3280 INPUT "VOLGN.(3 POS):";V$
3290 IF LEN(V$)<>3 GOTO 3280
3300 IF VAL(V$)<>H-1 THEN 3310 ELSE 3320
3310 PRINT "Onjuist volgnummer !":GOTO 3280
3320 INPUT "GEB.DAT(6 POS):";G$
3330 IF LEN(G$)<>6 GOTO 3320
3340 INPUT "NAAM(4 POS):";N$
3350 IF LEN(N$)<>4 GOTO 3340
3360 INPUT "GESLACHT(1 POS):";S$
3370 IF S$<>"M" AND S$<>"V" GOTO 3360
3380 INPUT "FOTO(1 POS):";F$
3390 IF F$<>"J" AND F$<>"N" GOTO 3380
3400 INPUT "EERD.DIAGN(2 POS):";E$
3410 IF LEN(E$)<>2 GOTO 3400
3420 INPUT "DIAGN.(6 POS):";D$
3430 IF LEN(D$)<>6 GOTO 3420
3440 LSET VOLGN$=V$
3450 LSET GEBD$=G$
3460 LSET NAAM$=N$
3470 LSET SEX$=S$
3480 LSET FOTO$=F$
3490 LSET EERD$=E$
3500 LSET DIAGN$=D$
3510 PUT #1,H
3520 CLOSE #1
3530 PRINT CHR$(&H1A)
3540 GOTO 220
3550 PRINT CHR$(&H1A)
3560 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
3570 RESET
3580 PRINT "*** DIT WAS HET PATIENTENREGISTRATIE-"
3590 PRINT TAB(10);"PROGRAMMA ......"
3600 PRINT:PRINT
3610 PRINT TAB(20);"*** TRIOTEL ***"
3620 PRINT:PRINT:PRINT:PRINT
3630 PRINT "Maak een copie van de werk-diskette !"
3640 PRINT "m.b.v. het 'copy' programma." 
3650 END
3660 REM CREEER EN LABEL EEN NIEUW WERKBESTAND
3670 PRINT CHR$(&H1A):PRINT:PRINT:PRINT "Er is nog geen werkbestand !"
3680 PRINT:PRINT "U moet een nieuw werkbestand creeren."
3690 PRINT "Wat zal de naam van het te creeren werkbestand "
3700 PRINT "worden op de diskette van dat jaar ?"
3710 PRINT "Geef op: de naam (PRx, x is het volgnummer)"
3720 PRINT "en het jaar (19xx)."
3730 PRINT:INPUT "BESTANDSNAAM (PRX) ...";B$
3740 PRINT:INPUT "JAAR ........";J$
3750 ZZ$="                    "
3760 DUM$=B$+"/"+J$+ZZ$
3770 V$="000"
3780 G$=LEFT$(DUM$,6)
3790 N$=MID$(DUM$,7,4)
3800 S$=MID$(DUM$,11.1)
3810 F$=MID$(DUM$,12,1)
3820 E$=MID$(DUM$,13,2)
3830 D$=MID$(DUM$,15,6)
3840 LSET VOLGN$=V$
3850 LSET GEBD$=G$
3860 LSET NAAM$=N$
3870 LSET SEX$=S$
3880 LSET FOTO$=F$
3890 LSET EERD$=E$
3900 LSET DIAGN$=D$
3910 PUT #1,1
3920 H=1
3930 PRINT CHR$(&H1A)
3940 RETURN
3950 REM TRIOSORT ZOEKPROGRAMMA
3960 PRINT CHR$(&H1A)
3970 PRINT TAB(10);"** SORTEERPROGRAMMA TRIOSORT **"
3980 PRINT:PRINT:PRINT
3990 PRINT "Bestanden van elk 999 patienten"
4000 PRINT "zijn beschikbaar."
4010 PRINT:PRINT "Eerst moet de sorteerexpressie"
4020 PRINT "Geformuleerd worden in termen van minimale"
4030 PRINT "en maximale criteria voor iedere variabele."
4040 PRINT "Van de geboortedatum en de diagnose"
4050 PRINT "kan een deel gebruikt worden, "
4060 PRINT "bv. het geboortejaar."
4070 PRINT:PRINT "Voor continueren type <return>"
4080 PRINT "Voor stop programma type <S>."
4090 INPUT J$
4100 IF LEFT$(J$,1)="S" THEN 5100 ELSE 4120
4110 REM FORMULEER ZOEK EXPRESSIE
4120 PRINT CHR$(&H1A):PRINT:PRINT
4130 PRINT "VOLGNUMMER"
4140 PRINT:PRINT:INPUT "MINIMALE WAARDE : ";VOO$
4150 INPUT "MAXIMALE WAARDE : ";VOB$
4160 IF LEN(VOO$)<>3 OR LEN(VOB$)<>3 THEN 4120
4170 PRINT CHR$(&H1A):PRINT:PRINT
4180 PRINT "GEBOORTEDATUM"
4190 PRINT:PRINT "Geef op vanaf welk karakter en hoeveel"
4200 PRINT "karakters meedoen."
4210 PRINT "Volgens het schema  123456"
4220 PRINT:INPUT "VANAF KARAKTER NR. : ";G1
4230 INPUT "HOEVEEL KARAKTERS : ";G2
4240 PRINT:INPUT "MINIMALE WAARDE : ";GBO$
4250 INPUT "MAXIMALE WAARDE : ";GBB$
4260 IF LEN(GBO$)<>G2 OR LEN(GBB$)<>G2 THEN 4170
4270 PRINT CHR$(&H1A):PRINT:PRINT
4280 PRINT "NAAM"
4290 PRINT:PRINT "Het alphanumerieke minimum is AAAA"
4300 PRINT "Het alphanumerieke maximum is ZZZZ."
4310 PRINT:INPUT "MINIMALE WAARDE : ";NAO$
4320 INPUT "MAXIMALE WAARDE : ";NAB$
4330 IF LEN(NAO$)<>4 OR LEN(NAB$)<>4 THEN 4270
4340 PRINT CHR$(&H1A):PRINT:PRINT
4350 PRINT "GESLACHT"
4360 PRINT:PRINT "MANNETJES ........... : 1"
4370 PRINT "VROUWTJES ........... : 2"
4380 PRINT "BEIDE ............... : 3"
4390 PRINT:INPUT "WAT KIEST U : ";SEX
4400 IF SEX<1 OR SEX>3 THEN 4340
4410 ON SEX GOTO 4420, 4430, 4440 
4420 SEO$="A":SEB$="N":GOTO 4450
4430 SEO$="U":SEB$="Z":GOTO 4450
4440 SEO$="A":SEB$="Z"
4450 PRINT CHR$(&H1A):PRINT:PRINT
4460 PRINT "FOTO"
4470 PRINT:PRINT "WEL FOTO ........... : 1"
4480 PRINT "GEEN FOTO .......... : 2"
4490 PRINT "BEIDE .............. : 3"
4500 PRINT:INPUT "WAT KIEST U : ";FOT
4510 IF FOT<1 OR FOT>3 THEN 4450
4520 ON FOT GOTO 4530, 4540, 4550
4530 FOO$="A":FOB$="K":GOTO 4560
4540 FOO$="M":FOB$="Z":GOTO 4560
4550 FOO$="A":FOB$="Z"
4560 PRINT CHR$(&H1A):PRINT:PRINT
4570 PRINT "EERDERE DIAGNOSE"
4580 PRINT:INPUT "MINIMALE WAARDE : ";EEO$
4590 INPUT "MAXIMALE WAARDE : ";EEB$
4600 IF LEN(EEO$)<>2 OR LEN(EEB$)<>2 THEN 4560
4610 PRINT CHR$(&H1A):PRINT:PRINT
4620 PRINT "DIAGNOSE"
4630 PRINT:PRINT "Geef aan vanaf welk kararkter, hoeveel"
4640 PRINT "karakters meedoen."
4650 PRINT "Volgens het schema  123456"
4660 INPUT "VANAF WELK KARAKTER NR. : ";D1
4670 INPUT "HOEVEEL KARAKTERS : ";D2
4680 PRINT:INPUT "MINIMALE WAARDE : ";DIO$
4690 INPUT "MAXIMALE WAARDE : ";DIB$
4700 IF LEN(DIO$)<>D2 OR LEN(DIB$)<>D2 THEN 4610
4710 PRINT CHR$(&H1A):PRINT:PRINT
4720 PRINT "U HEEFT DE VOLGENDE MOGELIJKHEDEN:"
4730 PRINT
4740 PRINT "UITVOER OP SCHERM ................ 1"
4750 PRINT "UITVOER OP PRINTER ............... 2"
4760 PRINT "HERFORMULEREN EXPRESSIE .......... 3"
4770 PRINT "STOP PROGRAMMA ................... 4"
4780 PRINT:PRINT
4790 INPUT "WAT KIEST U ";K
4800 IF K=4 THEN 5100
4810 IF K=3 THEN 4110
4820 IF K=1 THEN PRINT CHR$(&H1A):PRINT:PRINT:PRINT "** UITVOER OP HET SCHERM **"
4830 IF K=3 THEN PRINT CHR$(&H1A):PRINT:PRINT:PRINT "** UITVOER OP DE PRINTER **"
4840 REM GEEF DIRECTORY DRIVE B
4850 PRINT:PRINT "De diskette in drive B bevat de volgende "
4860 PRINT "patientenbestanden : "
4870 FILES "B:*.DAT"
4880 PRINT:PRINT:PRINT "Welk bestand wilt u doorzoeken ?"
4890 INPUT "Geef op ... PRx : ";DUM$
4900 IF RIGHT$(DUM$,1)="." OR RIGHT$(DUM$,4)="." THEN 4910 ELSE 4930
4910 PRINT "Geef de bestandsnaam zonder punt en .."
4920 PRINT "zonder extensie !":GOTO 4880
4930 DUM$="B:"+DUM$+".DAT"
4940 PRINT CHR$(&H1A)
4950 REM KIJK OF FILE BESTAAT
4960 OPEN "R",#1,DUM$,23
4970 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
4980 GET #1
4990 IF EOF(1) THEN 5000 ELSE 5020
5000 CLOSE #1
5010 PRINT:PRINT "BESTAND NIET AANWEZIG !":GOTO 4720
5020 CLOSE #1
5030 OPEN "R",#1,DUM$,23
5040 IF K=1 THEN GOSUB 5170
5050 IF K=2 THEN GOSUB 5490
5060 PRINT:PRINT "WILT U VERDER ZOEKEN TYPE DAN <RETURN> ?"
5070 INPUT "OF WILT U STOPPEN, TYPE DAN <S> : ";S$
5080 IF LEFT$(S$,1)="S" THEN 5100
5090 PRINT CHR$(&H1A):GOTO 4710
5100 PRINT CHR$(&H1A)
5110 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
5120 PRINT TAB(10);"DIT WAS ......"
5130 PRINT:PRINT TAB(15);"HET SORTEERPROGRAMMA ...."
5140 PRINT:PRINT TAB(20);"*** TRIOSORT ***"
5150 END
5160 REM SCHERMUITVOER
5170 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
5180 FOR LUS=0 TO 999
5190 GET #1
5200 V$=VOLGN$
5210 G$=GEBD$
5220 N$=NAAM$
5230 S$=SEX$
5240 F$=FOTO$
5250 E$=EERD$
5260 D$=DIAGN$
5270 IF V$="000" THEN 5280 ELSE 5300
5280 PRINT CHR$(&H1A):PRINT:PRINT "BESTAND : ";G$+N$
5290 PRINT:PRINT:GOTO 5450
5300 IF V$>=VOO$ AND V$<=VOB$ THEN 5310 ELSE 5450
5310 IF MID$(G$,G1,G2)>=GBO$ AND MID$(G$,G1,G2)<=GBB$ THEN 5320 ELSE 5450
5320 IF N$>=NAO$ AND N$<=NAB$ THEN 5330 ELSE 5450
5330 IF S$>=SEO$ AND S$<=SEB$ THEN 5340 ELSE 5450
5340 IF F$>=FOO$ AND F$<=FOB$ THEN 5350 ELSE 5450
5350 IF E$>=EEO$ AND E$<=EEB$ THEN 5360 ELSE 5450
5360 IF MID$(D$,D1,D2)>=DIO$ AND MID$(D$,D1,D2)<=DIB$ THEN 5370 ELSE 5450
5370 PRINT
5380 PRINT "VOLGN.,GEB.DAT.,NAAM,GESLACHT:";V$;".";G$;".";N$;".";S$
5390 PRINT "FOTO:";F$,"EERD.DIAGN.:";E$
5400 PRINT "DIAGNOSE:";D$
5410 PRINT
5420 INPUT "NOG MEER ";J$
5430 IF J$<>"N" GOTO 5450
5440 GOTO 5460
5450 NEXT LUS
5460 CLOSE #1
5470 RETURN
5480 REM PRINTERUITVOER
5490 FIELD #1,3 AS VOLGN$,6 AS GEBD$,4 AS NAAM$,1 AS SEX$,1 AS FOTO$,2 AS EERD$,6 AS DIAGN$
5500 FOR LUS=0 TO 999
5510 GET #1
5520 V$=VOLGN$
5530 G$=GEBD$
5540 N$=NAAM$
5550 S$=SEX$
5560 F$=FOTO$
5570 E$=EERD$
5580 D$=DIAGN$
5590 IF V$="000" THEN 5600 ELSE 5620
5600 PRINT CHR$(&H1A):PRINT:PRINT "BESTAND : ";G$+N$
5610 PRINT:PRINT:GOTO 5710
5620 IF V$>=VOO$ AND V$<=VOB$ THEN 5630 ELSE 5710
5630 IF MID$(G$,G1,G2)>=GBO$ AND MID$(G$,G1,G2)<=GBB$ THEN 5640 ELSE 5710
5640 IF N$>=NAO$ AND N$<=NAB$ THEN 5650 ELSE 5710
5650 IF S$>=SEO$ AND S$<=SEB$ THEN 5660 ELSE 5710
5660 IF F$>=FOO$ AND F$<=FOB$ THEN 5670 ELSE 5710
5670 IF E$>=EEO$ AND E$<=EEB$ THEN 5680 ELSE 5710
5680 IF MID$(D$,D1,D2)>=DIO$ AND MID$(D$,D1,D2)<=DIB$ THEN 5690 ELSE 5710
5690 LPRINT V$;".";G$;".";N$;".";S$
5700 LPRINT F$,E$,D$
5710 NEXT LUS
5720 CLOSE #1
5730 RETURN
IB$ THEN 5690 ELSE 5710
5690 LPRINT V$;".";G$;".";N$;".";S$
5700 LPRINT F$,E$,D$
5710 NEXT LUS
5720 CLOSE #1
5730