DataMuseum.dk

top - metrics - download

    Length: 1879 (0x757)
    Notes: Mikados TextFile, Mikados_K
    Names: »PERSONNU«

└─⟦bcf7b34c7⟧ Bits:30003895/4xCOMAL2.imd 4 * COMAL - SPC/1 - Disketter til bogen
    └─⟦this⟧ »PERSONNU« 

Text

0010 // ------------------ personnu -----------------------
0020 // Programmet kontrollerer om et opgivet personnummer er korrekt
0030 // Datoens gyldighed kontrolleres også
0040 // 
0041 INTEGER TRUE,FALSE
0042 TRUE:=1;FALSE:=0
0050 PROC CPR_CHECK(REF CHTAL$)
0060 SUM:=0;TEST:=TRUE
0070 FOR I:=1 TO 7 DO 
0080 SUM:=SUM+ASC(CHTAL$(11-I))*I
0090 NEXT I
0100 FOR I:=2 TO 4 DO 
0110 SUM:=SUM+ASC(CHTAL$(5-I))*I
0120 NEXT I
0130 IF SUM MOD 11<>0 THEN TEST:=FALSE
0140 DATO:=ASC(CHTAL$(1:2))
0150 MÅNED:=ASC(CHTAL$(3:2))
0160 ÅR:=ASC(CHTAL$(5:2))
0170 IF DATO=0 OR DATO>31 OR MÅNED=0 OR MÅNED>12 THEN TEST:=FALSE
0180 RESTORE 
0190 DATA 4,6,9,11
0200 FOR I:=1 TO 4 DO 
0210 READ KORTMÅNED
0220 IF KORTMÅNED=MÅNED AND DATO=31 THEN TEST:=FALSE
0230 NEXT I
0240 IF MÅNED=2 AND DATO>29 THEN TEST:=FALSE
0250 IF MÅNED=2 AND DATO=29 AND (ÅR MOD 4<>0 OR ÅR=0) THEN TEST:=FALSE
0260 IF TEST=TRUE THEN CHTAL$:="OK"
0270 ENDPROC CPR_CHECK
0280 // 
0290 CLEAR 
0300 DIM TAL$ OF 20,KOPI$ OF 10
0310 PRINT 
0320 PRINT "          De 10 cifre i personnummeret skal nu indtastes uden ";
0321 PRINT "mellemrum"
0330 PRINT "          F.eks kan indtastningen se således ud: 1212121212"
0340 PRINT "          Programmet stopper, når der tastes 0"
0350 REPEAT 
0360 REPEAT 
0370 OMIGEN:=FALSE
0380 CURSOR 36,10
0390 PRINT "                   "
0400 CURSOR 11,10
0410 INPUT "Indtast et personnummer:  ":TAL$
0420 IF TAL$="0" THEN 
0430 CURSOR 1,22
0440 STOP 
0450 ENDIF 
0460 IF LEN(TAL$)=10 THEN 
0470 FOR I:=1 TO 10 DO 
0480 IF ORD(TAL$(I:I))<48 OR ORD(TAL$(I:I))>57 THEN OMIGEN:=TRUE
0490 NEXT I
0500 ELSE 
0510 OMIGEN:=TRUE
0520 ENDIF 
0530 UNTIL NOT OMIGEN
0540 KOPI$:=TAL$ // Nu har vi netop 10 cifre
0550 EXEC CPR_CHECK(TAL$)
0560 CURSOR 11,15
0570 IF TAL$="OK" THEN 
0580 PRINT "CPR-nummeret ";KOPI$;" er i orden"
0590 ELSE 
0600 PRINT "CPR-nummeret ";KOPI$;" er forkert"
0610 ENDIF 
0620 CURSOR 11,20
0630 INPUT "Tast <Return>":TAL$
0640 UNTIL FALSE
2661 // mrum"