|
DataMuseum.dkPresents historical artifacts from the history of: Jet Computer Jet80 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Jet Computer Jet80 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 17792 (0x4580)
Types: TextFile
Names: »A1.PAS«
└─⟦09ad82a35⟧ Bits:30002863 PolyPascal-80 V3.10 for JET80 CP/M
└─ ⟦this⟧ »A1.PAS«
PROGRAM AYTST; (*UDSKRIFT DATO: 3/10 - 85. VOL.I *)
(*REV. DATO: 4/10 - 85. VOL.I *)
(*KSJ*)
CONST
DELIMLANG = 1;RAPHOVLANG = 1;
HNDTYPLANG = 2; SEKNRLANG = 2; FYLDNLANG = 2;
SALDOLANG = 6; DEBETLANG = 6; BSVARLANG = 6;
TIDSPLANG = 11; IDLANG = 12; FTALLLANG = 20;
AKTFEJLANG = 24;
SKILLETEGN = ',';
MAXFEJL = 17; (*ANTAL DEFINEREDE FEJLKODER*)
TYPE
AYSTRDATA = RECORD
TIDSP:STRING(.TIDSPLANG.);
RAPHOV:STRING(.RAPHOVLANG.);
ID:STRING(.IDLANG.);
HNDTYP:STRING(.HNDTYPLANG.);
SEKNR:STRING(.SEKNRLANG.);
FYLDN:STRING(.FYLDNLANG.);
SALDO:STRING(.SALDOLANG.);
DEBET:STRING(.DEBETLANG.);
BSVAR:STRING(.BSVARLANG.);
AKTFEJ:STRING(.AKTFEJLANG.);
FTALL:STRING(.FTALLLANG.);
END;
KALENDER = RECORD
SEKUND:STRING(.2.);
MINUT:STRING(.2.);
TIMER:STRING(.2.);
DAGNR:STRING(.1.);
DATO:STRING(.2.);
MANED:STRING(.2.);
ARSTAL:STRING(.2.);
NAVN:STRING(.7.);
END;
IDSTATUS = RECORD
DELMARK:STRING(.1.);
IDNUMMER:STRING(.12.);
STATUS:STRING(.1.);
END;
FEJLKODER = ARRAY(.1..24.) OF STRING(.26.);
STR1 = STRING(.1.);
STR2 = STRING(.2.);
STR6 = STRING(.6.);
STR7 = STRING(.7.);
STR12 = STRING(.12.);
STR14 = STRING(.14.);
STR40 = STRING(.40.);
STR50 = STRING(.50.);
STR110 = STRING(.110.);
VAR
TBUF:STR14;
STED,PRINTERSTATUS:INTEGER;
FEJLPOINTER: INTEGER;
PORTSTATUS,TOMINDIK,INDCHAR,CH,FEJLINDIK: STR1;
FUNKA: STR1;
RAPTYP:STR2;
HNDTYP,SEKNR,FYLDN:STR2;
SALDO,DEBET,BSVAR:STR6;
KOMMASALDO:STR7;
ID:STR12;
OVERSKRIFT,TEKST_ET:STR40;
TEKST_TO,TEKST_TRE:STR50;
DBBUF:STR110;
IBUF,DVAR:STR110;
TEMP,SRAPIND: AYSTRDATA;
DAG: KALENDER;
FEJL:FEJLKODER;
DBFIL: TEXT;
DATAFIL: FILE OF AYSTRDATA;
IDFIL:FILE OF IDSTATUS;
PROCEDURE INITIALISER_SIO;
(* INTERFACEMODUL MELLEM COMPASPASCAL
OG EN SIOPORT I JET-80 COMPUTEREN.*)
BEGIN CODE
$3E,$18, $D3,$01, $3E,$04, $D3,$01,
$3E,$C4, $D3,$01, $3E,$03, $D3,$01,
$3E,$E1, $D3,$01, $3E,$05, $D3,$01,
$3E,$EA, $D3,$01, $3E,$02, $D3,$01,
$3E,$00, $D3,$01, $3E,$01, $D3,$01,
$3E,$00, $D3,$01, $3E,$06, $D3,$01,
$3E,$00, $D3,$01, $3E,$07, $D3,$01,
$3E,$00, $D3,$01, $3E,$47, $D3,$08,
$3E,$AE, $D3,$08;
END;
PROCEDURE DATAIND_ASCII;
BEGIN
IBUF:='';
BEGIN CODE
$AF,$47,$4F,$57,$5F,$67,$6F,$FD,$21,IBUF,$DD,$21,IBUF,$FD,$23,
(*DUMMY MODTAGELSE AF FØRSTE BYTE I DATARAPPORT*)
(*---------------------------------------------*)
(* $DB,
$01,$E6,$01,$28,$FA,$DB,$00, *)
(*---------------------------------------------*)
$06,$00,$DB,
$01,$E6,$01,$28,$FA,$DB,$00,$57,$04,$83,$5F,$7A,$E6,$C0,$FE,$C0,$20,$6F,
$7A,$E6,$3F,$4F,$DB,$01,$E6,$01,$28,$FA,$DB,$00,$57,$04,$83,$5F,$7A,$E6,
$C0,$FE,$C0,$20,$58,$7A,$E6,$30,$FE,$20,$20,$04,$CB,$C5,$18,$06,$FE,$10,
$20,$49,$CB,$85,$CB,$55,$28,$0B,$7A,$E6,$0F,$FE,$0F,$20,$19,$CB,$CD,$18,
$15,$7A,$E6,$0F,$C6,$30,$DD,$34,$00,$FD,$77,$00,$FD,$23,$CB,$8D,$CB,$D5,
$18,$02,$18,$9F,$DB,$01,$E6,$01,$28,$FA,$DB,$00,$57,$04,$CB,$4D,$20,$66,
$83,$5F,$CB,$45,$28,$36,$7A,$1F,$1F,$1F,$1F,$E6,$0F,$FE,$0A,$20,$06,$3E,
$20,$18,$04,$18,$77,$C6,$30,$FD,$77,$00,$FD,$23,$DD,$34,$00,$7A,$E6,$0F,
$FE,$0A,$20,$04,$3E,$20,$18,$02,$C6,$30,$FD,$77,$00,$FD,$23,$DD,$34,$00,
$78,$B9,$28,$B6,$18,$B6,$CB,$7A,$20,$04,$3E,$30,$18,$02,$3E,$31,$FD,$77,
$00,$FD,$23,$DD,$34,$00,$CB,$72,$20,$04,$3E,$30,$18,$02,$3E,$31,$FD,$77,
$00,$FD,$23,$DD,$34,$00,$18,$06,$18,$8C,$18,$8C,$18,$76,$CB,$6A,$20,$04,
$3E,$30,$18,$02,$3E,$31,$FD,$77,$00,$FD,$23,$DD,$34,$00,$CB,$62,$20,$04,
$3E,$30,$18,$02,$3E,$31,$FD,$77,$00,$FD,$23,$DD,$34,$00,$18,$02,$18,$52,
$CB,$5A,$20,$04,$3E,$30,$18,$02,$3E,$31,$FD,$77,$00,$FD,$23,$DD,$34,$00,
$CB,$52,$20,$04,$3E,$30,$18,$02,$3E,$31,$FD,$77,$00,$FD,$23,$DD,$34,$00,
$CB,$4A,$20,$04,$3E,$30,$18,$02,$3E,$31,$FD,$77,$00,$FD,$23,$DD,$34,$00,
$CB,$42,$20,$04,$3E,$30,$18,$02,$3E,$31,$FD,$77,$00,$FD,$23,$DD,$34,$00,
$78,$B9,$28,$86,$18,$86,$7A,$BB,$28,$2C,$FD,$21,IBUF,$3E,$05,$FD,$77,$00,
$FD,$23,$3E,$45,$FD,$77,$00,$FD,$23,$3E,$52,$FD,$77,$00,$FD,$23,$3E,$52,
$FD,$77,$00,$FD,$23,$3E,$4F,$FD,$77,$00,$FD,$23,$3E,$52,$FD,$77,$00,$00;
END;
END;
PROCEDURE LAS_REALTIME_CLOCK;
BEGIN
TBUF:='';
BEGIN CODE
$3E,$0F,$D3,$7B,$3E,$03,$D3,$7B,$21,TBUF,$3E,$0D,$77,$23,$0E,$0D,$3E,$01,
$77,$23,$0D,$20,$FB,$3E,$CF,$D3,$7B,$3E,$0F,$D3,$7B,$21,TBUF,$3E,$0D,$77,
$23,$0E,$0D,$7D,$E6,$0F,$57,$3E,$CF,$D3,$7B,$3E,$00,$D3,$7B,$7A,$F6,$90,
$D3,$79,$E6,$7F,$D3,$79,$3E,$36,$3D,$20,$FD,$3E,$CF,$D3,$7B,$3E,$0F,$D3,
$7B,$3E,$30,$D3,$79,$3E,$03,$3D,$20,$FD,$DB,$79,$E6,$0F,$57,$3E,$00,$D3,
$79,$7A,$77,$23,$0D,$20,$C6,$DD,$21,TBUF,$21,TBUF, $AF,$77 ,$16,$02,$1E,
$07,$23,
$06,$03,$4E,$23,$7E,$2B,$A3,$C6,$30,$77,$23,$DD,$34,$00,$79,$E6,$0F,$C6,
$30,$77,$23,$DD,$34,$00,$05,$20,$E7,$15,$28,$0E,$7E,$E6,$07,$C6,$30,$77,
$23,$DD,$34,$00,$1E,$0F,$18,$D4;
END;
DAG.SEKUND:=COPY(TBUF,1,2);
DAG.MINUT:=COPY(TBUF,3,2);
DAG.TIMER:=COPY(TBUF,5,2);
DAG.DAGNR:=COPY(TBUF,7,1);
DAG.DATO:=COPY(TBUF,8,2);
DAG.MANED:=COPY(TBUF,10,2);
DAG.ARSTAL:=COPY(TBUF,12,2);
IF DAG.DAGNR='0' THEN DAG.NAVN:='SØNDAG' ELSE
IF DAG.DAGNR='1' THEN DAG.NAVN:='MANDAG' ELSE
IF DAG.DAGNR='2' THEN DAG.NAVN:='TIRSDAG' ELSE
IF DAG.DAGNR='3' THEN DAG.NAVN:='ONSDAG' ELSE
IF DAG.DAGNR='4' THEN DAG.NAVN:='TORSDAG' ELSE
IF DAG.DAGNR='5' THEN DAG.NAVN:='FREDAG' ELSE
IF DAG.DAGNR='6' THEN DAG.NAVN:='LØRDAG' ELSE
DAG.DAGNR:='ERRORDG';
END;
PROCEDURE INIT_FEJLKODETEKST;
BEGIN
FEJL(.1.):='DØR 1 (TEKNIKRUM) ÅBEN';
FEJL(.2.):='DØR 2 (MØNTRUM) ÅBEN';
FEJL(.3.):='MIKROTELEFON AFBRUDT';
FEJL(.4.):='MØNTKASSETTE UDTAGET';
FEJL(.5.):='MØNTKASSETTE MANGLER';
FEJL(.6.):='MØNTKASSETTE 99% FULD';
FEJL(.7.):='INDLØB BLOKERET';
FEJL(.8.):='UDLØB BLOKERET';
FEJL(.9.):='LAGERDETEKTOR BLOKERET';
FEJL(.10.):='INDKASSERINGSDET. BLOKERET';
FEJL(.11.):='MØNTKASSETTE 80% FULD';
FEJL(.12.):='SORTERING MISLYKKET';
FEJL(.13.):='INDKASSERING MISLYKKET';
FEJL(.14.):='TILBAGEBETALING MISLYKKET';
FEJL(.15.):='WATCH DOG RESET';
FEJL(.16.):='TILFÆLDIGT RESET';
FEJL(.17.):='RAM CHECKSUM FEJL';
END;
PROCEDURE FORMATER_INDDATA;
VAR
I:INTEGER;
BEGIN
I:=1;
TEMP.TIDSP:=DAG.DATO+DAG.MANED+DAG.ARSTAL+'-'+DAG.TIMER+DAG.MINUT;
TEMP.RAPHOV:=COPY(IBUF,I,RAPHOVLANG);
I:=I+RAPHOVLANG;
TEMP.ID:=COPY(IBUF,I,IDLANG);
I:=I+IDLANG;
TEMP.HNDTYP:=COPY(IBUF,I,HNDTYPLANG);
I:=I+HNDTYPLANG;
TEMP.SEKNR:=COPY(IBUF,I,SEKNRLANG);
I:=I+SEKNRLANG;
TEMP.FYLDN:=COPY(IBUF,I,FYLDNLANG);
I:=I+FYLDNLANG;
TEMP.SALDO:=COPY(IBUF,I,SALDOLANG);
I:=I+SALDOLANG;
TEMP.DEBET:=COPY(IBUF,I,DEBETLANG);
I:=I+DEBETLANG;
TEMP.BSVAR:=COPY(IBUF,I,BSVARLANG);
I:=I+BSVARLANG;
TEMP.AKTFEJ:=COPY(IBUF,I,AKTFEJLANG);
I:=I+AKTFEJLANG;
IF RAPTYP='00' THEN
TEMP.FTALL:=COPY(IBUF,I,FTALLLANG)
ELSE
TEMP.FTALL:=' ';
I:=I+FTALLLANG;
END;
PROCEDURE CHECK_ID;
VAR
FILIDSTA,NYIDSTA:IDSTATUS;
N,I,FUND:INTEGER;
BEGIN
NYIDSTA.IDNUMMER:=TEMP.ID;
ASSIGN(IDFIL,'IDSTAT.DAT');
RESET(IDFIL);
I:=0; N:=0;
WHILE NOT EOF(IDFIL) DO
BEGIN
N:=N+1;
READ(IDFIL,FILIDSTA);
FUND:=POS(NYIDSTA.IDNUMMER,FILIDSTA.IDNUMMER);
IF FUND<>0 THEN
BEGIN
I:=I+1;
FILIDSTA.STATUS:='*';
SEEK(IDFIL,N-1);
WRITE(IDFIL,FILIDSTA);
END;
END;
IF I=0 THEN
BEGIN
NYIDSTA.STATUS:='*';
SEEK(IDFIL,LENGTH(IDFIL));
WRITE(IDFIL,NYIDSTA);
END;
CLOSE(IDFIL)
END;
PROCEDURE RESET_IDSTATUS;
VAR
IDRESET:IDSTATUS;
BEGIN
ASSIGN(IDFIL,'IDSTAT.DAT');
RESET(IDFIL);
WHILE NOT EOF(IDFIL) DO
BEGIN
READ(IDFIL,IDRESET);
IF IDRESET.STATUS<>'*'
THEN
WRITELN('DØGNRAPPORT IKKE MODTAGET FRA AY4 IDNUMMER: '
,IDRESET.IDNUMMER)
ELSE BEGIN
SEEK(IDFIL,POSITION(IDFIL)-1);
IDRESET.STATUS:=' ';
WRITE(IDFIL,IDRESET);
END;
END;
CLOSE(IDFIL);
END;
PROCEDURE FJERN_ID_FRA_TABEL;
VAR
FUNKB:STR1;
SLETNR:STR12;
FUND,I:INTEGER;
IDRECORD:IDSTATUS;
NYFIL:FILE OF IDSTATUS;
BEGIN
WRITELN('LIST NUMRE I ID-TABEL (L)');
WRITELN('SLET NUMMER I ID-TABEL (D)');
WRITELN;
WRITE('INDTAST SYMBOL FOR FUNKTION: ');READLN(FUNKB);
IF FUNKB='L' THEN
BEGIN
ASSIGN(IDFIL,'IDSTAT.DAT');
RESET(IDFIL);
WRITELN('RECORDNR: ID-NR: MARK:');
WHILE NOT EOF(IDFIL) DO
BEGIN
READ(IDFIL,IDRECORD);
WRITELN(POSITION(IDFIL),' ',
IDRECORD.IDNUMMER,' ',IDRECORD.STATUS);
END;
CLOSE(IDFIL);
END ELSE
IF FUNKB='D' THEN
BEGIN
ASSIGN(IDFIL,'IDSTAT.DAT'); RESET(IDFIL);
WRITE('HVILKET IDNUMMER ØNSKES SLETTET? ');READLN(SLETNR);
I:=0;
WHILE NOT EOF(IDFIL) DO
BEGIN
READ(IDFIL,IDRECORD);
FUND:=POS(SLETNR,IDRECORD.IDNUMMER);
IF FUND<>0 THEN
BEGIN
I:=I+1;
IDRECORD.DELMARK:='*';
SEEK(IDFIL,POSITION(IDFIL)-1);
WRITE(IDFIL,IDRECORD);
END;
END;
CLOSE(IDFIL);
IF I<>0 THEN
BEGIN
ASSIGN(NYFIL,'IDSTAT.TMP'); REWRITE(NYFIL);
ASSIGN(IDFIL,'IDSTAT.DAT'); RESET(IDFIL);
WHILE NOT EOF(IDFIL) DO
BEGIN
READ(IDFIL,IDRECORD);
IF IDRECORD.DELMARK<>'*' THEN WRITE(NYFIL,IDRECORD);
END;
CLOSE(IDFIL); CLOSE(NYFIL);
ERASE(IDFIL); RENAME(NYFIL,'IDSTAT.DAT');
END ELSE
BEGIN
WRITELN('IDNUMMER IKKE FUNDET I TABEL!');
END;
END;
END;
PROCEDURE SKRIVFIL;
BEGIN
ASSIGN(DATAFIL,'AY4SRAP.DAT');
REWRITE(DATAFIL);
CLOSE(DATAFIL);
END;
PROCEDURE SKRIV_NY_IDFIL;
BEGIN
ASSIGN(IDFIL,'IDSTAT.DAT');
REWRITE(IDFIL);
CLOSE(IDFIL);
END;
PROCEDURE DECOD_FEJLSTATUS;
BEGIN
FOR FEJLPOINTER:=1 TO LEN(TEMP.AKTFEJ) DO
BEGIN
FEJLINDIK:=COPY(TEMP.AKTFEJ,FEJLPOINTER,1);
IF FEJLINDIK>'1' THEN WRITELN('ERROR I FEJLKODEOPLYSNING') ELSE
IF FEJLINDIK<'0' THEN WRITELN('ERROR I FEJLKODEOPLYSNING') ELSE
IF FEJLINDIK='1' THEN
IF FEJLPOINTER>MAXFEJL THEN WRITELN('FEJLKODE IKKE IMPLEMENTERET')
ELSE
IF PRINTERSTATUS=1 THEN WRITELN(LST,FEJL(.FEJLPOINTER.))
ELSE
WRITELN(FEJL(.FEJLPOINTER.));
END;
END;
PROCEDURE SKRIVNYRECORD;
BEGIN
ASSIGN(DATAFIL,'AY4SRAP.DAT');
RESET(DATAFIL);
SEEK(DATAFIL,LENGTH(DATAFIL));
WRITE(DATAFIL,TEMP);
CLOSE(DATAFIL);
END;
PROCEDURE SKRIV_PA_PRINTER;
BEGIN
WRITELN(LST);
WRITELN(LST,OVERSKRIFT);
WRITELN(LST);
WRITE(LST,'DATO: ',DAG.NAVN,' DEN ',DAG.DATO,'/',DAG.MANED,
'-',DAG.ARSTAL);
WRITELN(LST,' TID: ',DAG.TIMER,'.',DAG.MINUT,'.',DAG.SEKUND);
WRITELN(LST);
WRITELN(LST,'TELEFONENS NUMMER: ',TEMP.ID);
WRITELN(LST);
WRITELN(LST,'BETALTE DEBETERINGSPULSER: ',TEMP.DEBET,' STK.');
WRITELN(LST,'B-SVARS PULSER...........: ',TEMP.BSVAR,' STK.');
WRITELN(LST,'MØNTBOXENS FYLDNING......: ',TEMP.FYLDN,' %');
WRITELN(LST,'MØNTTELEFONENS INT. SALDO: ',KOMMASALDO,' KR.');
WRITELN(LST);
WRITELN(LST);
WRITELN(LST,TEKST_ET);
WRITELN(LST);
WRITELN(LST,TEKST_TO);
WRITELN(LST,TEKST_TRE);
PRINTERSTATUS:=1;
IF TOMINDIK='0' THEN DECOD_FEJLSTATUS;
PRINTERSTATUS:=0;
WRITELN(LST);
END;
PROCEDURE SKRIV_RAPP_PA_SKARM;
BEGIN
KOMMASALDO:=COPY(TEMP.SALDO,1,4)+','+COPY(TEMP.SALDO,5,2);
WRITELN;
WRITELN;
WRITELN;
WRITELN;
WRITELN;
WRITELN(OVERSKRIFT);
WRITELN;
WRITE('DATO: ',DAG.NAVN,' DEN ',DAG.DATO,'/',DAG.MANED,
'-',DAG.ARSTAL);
WRITELN(' TID: ',DAG.TIMER,'.',DAG.MINUT,'.',DAG.SEKUND);
WRITELN;
WRITELN('TELEFONENS NUMMER: ',TEMP.ID);
WRITELN;
WRITELN('BETALTE DEBETERINGSPULSER: ',TEMP.DEBET,' STK.');
WRITELN('B-SVARS PULSER...........: ',TEMP.BSVAR,' STK.');
WRITELN('MØNTBOXENS FYLDNING......: ',TEMP.FYLDN,' %');
WRITELN('MØNTTELEFONENS INT. SALDO: ',KOMMASALDO,' KR.');
WRITELN;
WRITELN;
WRITELN(TEKST_ET);
WRITELN;
WRITELN(TEKST_TO);
WRITELN(TEKST_TRE);
IF TOMINDIK='0' THEN DECOD_FEJLSTATUS;
(* SKRIV_PA_PRINTER; *)
WRITELN;
TEKST_ET:='';
TEKST_TO:='';
TEKST_TRE:='';
END;
PROCEDURE AY4RAPP_TIL_DBASEFORM;
VAR
I,N,A:INTEGER;
DBCHAR:CHAR;
BEGIN
ASSIGN(DBFIL,'AY4SRAP.TXT'); REWRITE(DBFIL);
ASSIGN(DATAFIL,'AY4SRAP.DAT'); RESET(DATAFIL);
FOR A:=LENGTH(DATAFIL)-1 DOWNTO 0 DO
BEGIN
SEEK(DATAFIL,A);
READ(DATAFIL,SRAPIND);
DBBUF:=SRAPIND.TIDSP+SKILLETEGN+
SRAPIND.RAPHOV+SKILLETEGN+SRAPIND.ID+SKILLETEGN+
SRAPIND.HNDTYP+SKILLETEGN+SRAPIND.SEKNR+SKILLETEGN+
SRAPIND.FYLDN+SKILLETEGN+SRAPIND.SALDO+SKILLETEGN+
SRAPIND.DEBET+SKILLETEGN+SRAPIND.BSVAR+SKILLETEGN+
SRAPIND.AKTFEJ+SKILLETEGN+SRAPIND.FTALL+^M^J;
N:=LEN(DBBUF);
FOR I:=1 TO N DO
BEGIN
DBCHAR:=COPY(DBBUF,I,1);
WRITE(DBFIL,DBCHAR);
END;
END;
CLOSE(DATAFIL);
CLOSE(DBFIL);
END;
PROCEDURE STRAKSRAPP;
BEGIN
SKRIVNYRECORD;
TOMINDIK:=COPY(TEMP.AKTFEJ,2,1);
IF TOMINDIK='1' THEN
BEGIN
OVERSKRIFT:='TØMNINGSRAPPORT FRA MØNTTELEFON AY4';
TEKST_ET:='OPTALT I BANK............: ____,__ KR.';
TEKST_TO:='DIFFERENCE...............: ____,__ KR.';
SKRIV_RAPP_PA_SKARM;
END
ELSE
BEGIN
OVERSKRIFT:='FEJLRAPPORT FRA MØNTTELEFON TYPE AY4';
TEKST_ET:='AKTUELLE FEJL:';
SKRIV_RAPP_PA_SKARM;
END;
WRITELN;
END;
PROCEDURE DOGNRAPP;
VAR
I:INTEGER;
TEMPTEKST:STRING(.2.);
BEGIN
SKRIVNYRECORD;
OVERSKRIFT:='DØGNRAPPORT FRA MØNTTELEFON TYPE AY4';
TEKST_ET:='FEJL I DET FORLØBNE DØGN';
TEKST_TO:='FEJLKODE: 12 13 14 15 21 22 23 24 25 26';
TEKST_TRE:='ANTAL : ';
I:=1;
TEMPTEKST:='';
WHILE I<20 DO BEGIN
TEMPTEKST:=COPY(TEMP.FTALL,I,2);
TEKST_TRE:=TEKST_TRE+TEMPTEKST+' ';
I:=I+2;
END;
SKRIV_RAPP_PA_SKARM;
WRITELN;
END;
PROCEDURE DIAGNOSERAPP;
BEGIN
CHECK_ID;
OVERSKRIFT:='DIAGNOSERAPPORT! (GEMMES IKKE PÅ DISK)';
TEKST_ET:='AKTUELLE FEJL:';
SKRIV_RAPP_PA_SKARM;
WRITELN;
END;
PROCEDURE HENTPORTDATA;
(*HENTER DATA PAA PORT, DER PLACERES I "IBUF" SOM STRING *)
(*"RAPTYP" INDEHOLDER INFORMATION OM RAPPORTTYPEN: *)
(* 00 = DØGNRAPPORT *)
(* 33 = DIAGNOSERAPPORT *)
(* ANDET= STRAKSRAPPORT *)
VAR
I: INTEGER;
BEGIN
DATAIND_ASCII;
LAS_REALTIME_CLOCK;
FORMATER_INDDATA;
WRITELN(IBUF);
I:=1+RAPHOVLANG+IDLANG;
RAPTYP:=COPY(IBUF,I,2);
IF RAPTYP='00' THEN DOGNRAPP ELSE
IF RAPTYP='33' THEN DIAGNOSERAPP ELSE STRAKSRAPP;
END;
PROCEDURE CHECK_SIODATA;
BEGIN
PORTSTATUS:='';
BEGIN CODE
$21,PORTSTATUS,$3E,$01,$77,$23,$DB,$01,$E6,$01,$20,$05,$3E,$30,$77,$18,$03,
$3E,$31,$77,$00;
END;
IF PORTSTATUS='1' THEN HENTPORTDATA;
END;
BEGIN
TEKST_ET:='';
TEKST_TO:='';
TEKST_TRE:='';
FUNKA:='';
WHILE FUNKA<>'X' DO
BEGIN
WRITELN('DETTE PROGRAM TESTER FUNKTIONER DER SKAL ANVENDES I AY4PRG');
WRITELN;
WRITELN('SKAL DER OPRETTES INITIALFILBASE?..(I)');
WRITELN('OPRET INITIAL IDFIL?...............(A)');
WRITELN;
WRITELN('RESET ID-STATUS TABEL?.............(B)');
WRITELN('LIST/SLET NUMMER I ID-TABEL?.......(C)');
WRITELN('SKAL DER INDLÆSES RAPPORTER?.....<SPACE>');
WRITELN;
WRITELN('EXIT...............................(X)');
WRITELN;
WRITE('FUNKTION: (I/A/B/C/<SPACE>/X).....: '); READLN(FUNKA);
WRITELN;
INIT_FEJLKODETEKST;
INITIALISER_SIO;
IF FUNKA='I' THEN SKRIVFIL ELSE
IF FUNKA='A' THEN SKRIV_NY_IDFIL ELSE
IF FUNKA='B' THEN RESET_IDSTATUS ELSE
IF FUNKA='C' THEN FJERN_ID_FRA_TABEL ELSE
IF FUNKA=' ' THEN
BEGIN
WHILE NOT KEYPRESS DO
BEGIN
CHECK_SIODATA
END;
AY4RAPP_TIL_DBASEFORM;
END;
END;
END.
«eof»