|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 6272 (0x1880)
Types: TextFile
Names: »BUD.GET«
└─⟦c252abf18⟧ Bits:30008917 RCTOAX RC TIME OG OMKOSTNINGS OVERSIGT ARBEJDSDISK
└─⟦this⟧ »BUD.GET«
* BUD.GET - GET PROGRAM
STORE ' T ' TO MQ:SLCT
STORE T TO MQ:GMORE
STORE 'N' TO MQ:GDEL
DO WHILE MQ:GMORE
ERASE
STORE ' VIS ' TO MQ:MODE
* DISPLAY CURRENT RECORD
IF &MQ:SLCT
DO BUD.OUT
ENDIF
STORE ' ' TO MQ:CMD
@ 21,0
@ 22,0
@ 23,0
@ 21,07 SAY 'TAST N FOR NÆSTE RECORD, P FOR FOREGÅENDE RECORD'
@ 22,07 SAY ' S FOR SØG NØGLE, M FOR FLERE KOMMANDOER '
IF MQ:SLCT <> ' T '
@ 23,01 SAY 'SCAN'
ENDIF
@ 23,07 SAY 'ELLER RETUR ' GET MQ:CMD
READ
IF !(MQ:CMD)= 'S'
STORE T TO MQ:SMORE
DO WHILE MQ:SMORE
ERASE
STORE ' SØG ' TO MQ:MODE
* GET FIELDS TO SEARCH FOR
@ 01,000 SAY '--------------------'
@ 01,020 SAY '--------------'
@ 01,036 SAY MQ:MODE
@ 01,046 SAY '--------------------'
@ 01,066 SAY '--------------'
@ 02,000 SAY '*** RC TIME OG'
@ 02,021 SAY 'OMKOSTNINGS OVERSIG'
@ 02,041 SAY 'T BUDGET'
@ 02,076 SAY '***'
@ 03,000 SAY '--------------------'
@ 03,020 SAY '--------------------'
@ 03,040 SAY '--------------------'
@ 03,060 SAY '--------------------'
@ 04,007 SAY 'KODE2 .............'
@ 04,027 SAY '.'
STORE ' ' TO MKODE2
@ 04,031 GET MKODE2
@ 05,007 SAY 'KONTOGRP ...........'
@ 05,027 SAY '.'
STORE ' ' TO MKONTOGRP
@ 05,031 GET MKONTOGRP
@ 07,007 SAY 'JANUAR ...........'
@ 07,027 SAY '.'
@ 08,007 SAY 'FEBRUAR ...........'
@ 08,027 SAY '.'
@ 09,007 SAY 'MARTS ...........'
@ 09,027 SAY '.'
@ 10,007 SAY 'APRIL ...........'
@ 10,027 SAY '.'
@ 11,007 SAY 'MAJ ...........'
@ 11,027 SAY '.'
@ 12,007 SAY 'JUNI ...........'
@ 12,027 SAY '.'
@ 13,007 SAY 'JULI ...........'
@ 13,027 SAY '.'
@ 14,007 SAY 'AUGUST ...........'
@ 14,027 SAY '.'
@ 15,007 SAY 'SEPTEMBER...........'
@ 15,027 SAY '.'
@ 16,007 SAY 'OKTOBER ...........'
@ 16,027 SAY '.'
@ 17,007 SAY 'NOVEMBER ...........'
@ 17,027 SAY '.'
@ 18,007 SAY 'DECEMBER ...........'
@ 18,027 SAY '.'
@ 20,000 SAY '--------------------'
@ 20,020 SAY '--------------------'
@ 20,040 SAY '--------------------'
@ 20,060 SAY '--------------------'
@ 21,07 SAY 'INDTAST NØGLE VÆRDIEN TIL SØGNING AF ØNSKET RECORD !! '
IF MQ:SLCT <> ' T '
@ 23,01 SAY 'SCAN'
ENDIF
READ
* EXIT FROM LOOP IF FOUND
GOTO TOP
STORE MKODE2 + MKONTOGRP TO MQ:KEY
IF MQ:SLCT= ' T '
FIND &MQ:KEY
IF # <> 0
STORE F TO MQ:SMORE
ELSE
@ 21,0
@ 22,0
@ 23,0
@ 22,07 SAY 'NØGLEN IKKE FUNDET !!! '
@ 23,07 SAY 'PRØVE IGEN ? TAST J (JA) ELLERS TAST RETUR '
SET CONSOLE OFF
WAIT TO MQ:DUMMY
SET CONSOLE ON
IF !(MQ:DUMMY) <> 'J'
STORE F TO MQ:SMORE
ENDIF J
RELEASE MQ:DUMMY
ENDIF # <> 0
ELSE
LOCATE FOR KODE2GRP = MKODE2+MKONTOGRP .AND. &MQ:SLCT
IF .NOT. EOF
STORE F TO MQ:SMORE
ELSE
@ 21,0
@ 22,0
@ 23,0
@ 22,07 SAY 'NØGLEN IKKE FUNDET !!! '
@ 23,07 SAY 'PRØVE IGEN ? TAST J (JA) ELLERS TAST RETUR '
SET CONSOLE OFF
WAIT TO MQ:DUMMY
SET CONSOLE ON
IF !(MQ:DUMMY) <> 'J'
STORE F TO MQ:SMORE
ENDIF J
RELEASE MQ:DUMMY
ENDIF EOF
ENDIF MQ:SLCT=T
ENDDO MQ:SMORE
RELEASE MQ:SMORE
RELEASE MQ:KEY
ELSE
IF !(MQ:CMD) = 'N'
STORE T TO MQ:N
DO WHILE MQ:N
SKIP
IF &MQ:SLCT
STORE F TO MQ:N
ENDIF
IF EOF
STORE F TO MQ:N
STORE ' T ' TO MQ:SLCT
@ 23,4 SAY ' '
ENDIF
ENDDO
RELEASE MQ:N
ELSE
IF !(MQ:CMD)= 'P'
STORE ' T ' TO MQ:SLCT
@ 23,4 SAY ' '
SKIP -1
ELSE
IF !(MQ:CMD)= 'M'
STORE T TO MQ:MMORE
DO WHILE MQ:MMORE
STORE ' ØVRIGE ' TO MQ:MODE
STORE ' ' TO MQ:MMD
@ 21,0
@ 22,0
@ 23,0
@ 21,07 SAY 'TAST E FOR RETTELSE, D FOR SLETNING '
@ 22,07 SAY ' P FOR PRINT, C FOR SCAN '
IF MQ:SLCT <> ' T '
@ 23,01 SAY 'SCAN'
ENDIF
@ 23,07 SAY 'ELLERS RETUR 'GET MQ:MMD
READ
IF !(MQ:MMD) = 'E'
ERASE
IF MQ:SLCT <> ' T '
@ 23,01 SAY 'SCAN'
ENDIF
* EDIT RECORD
DO BUD.ED
ELSE
IF !(MQ:MMD)= 'D'
STORE 'N' TO MQ:ANS
@ 21,0
@ 22,0
@ 23,0
IF MQ:SLCT <> ' T '
@ 23,01 SAY 'SCAN'
ENDIF
@ 23,07 SAY 'MARKERES TIL SLETNING ? ER DU SIKKER ? ( J/N ) 'GET MQ:ANS
READ
IF !(MQ:ANS)= 'J'
DELETE
STORE 'J' TO MQ:GDEL
ENDIF
RELEASE MQ:ANS
ELSE
IF !(MQ:MMD)= 'P'
STORE ' ' TO OK
@ 21,0
@ 22,0
@ 23,0
@ 23,07 SAY 'ER PRINTER KLAR ? SÅ TAST OK ELLERS TAST RETUR !!'GET OK
STORE ' PRINT ' TO MQ:MODE
READ
IF !(OK) = 'OK'
SET FORMAT TO PRINT
DO BUD.OUT
STORE ' ' TO OK
ENDIF OK
SET FORMAT TO SCREEN
ELSE
IF !(MQ:MMD)='C'
GOTO TOP
@ 21,0
@ 22,0
@ 23,0
STORE ' ' TO MQ:SLCT
@ 21,07 SAY 'TAST FELTNAVN OG ØNSKET SØGEVÆRDI, OG TAST SÅ HELT UD !!'
@ 22,07 SAY 'FYLD UD MED BLANKE ......., OG BRUG IKKE RETUR TASTEN !!'
@ 23,01 SAY 'SCAN'
@ 23,07 GET MQ:SLCT
READ
LOCATE FOR &MQ:SLCT
IF EOF
@ 21,0
@ 22,0
@ 23,0
@ 21,07 SAY 'DER ER IKKE FLERE RECORD ! (END OF FILE ) '
@ 22,07 SAY ' TAST RETUR FOR AT FORTSÆTTE ! 'GET OK
STORE ' T ' TO MQ:SLCT
READ
ELSE
DO BUD.OUT
ENDIF
ELSE
IF MQ:MMD = ' '
STORE F TO MQ:MMORE
ELSE
LOOP
ENDIF
ENDIF F
ENDIF P
ENDIF D
ENDIF E
ENDDO MQ:MMORE
RELEASE MQ:MMORE,MQ:MMD
ELSE
IF MQ:CMD=' '
STORE F TO MQ:GMORE
ELSE
LOOP
ENDIF
ENDIF M
ENDIF P
ENDIF N
ENDIF S
ENDDO MQ:GMORE
IF !(MQ:GDEL) = 'J'
STORE 'N' TO MQ:ANS
@ 21,0
@ 22,0
@ 23,0
@ 22,07 SAY 'SKAL DE SLET MARKEREDE RECORDS FJERNES ? SÅ TAST J (JA)'
@ 23,07 SAY 'HVIS DU FORTRYDER FORETAGNE SLETNINGER SÅ TAST RETUR !'
@ 23,75 GET MQ:ANS
READ
IF !(MQ:ANS) = 'J'
@ 21,07 SAY '>>> DER SLETTES RECORDS NU, VENT ! <<<'
PACK
ELSE
@ 21,07 SAY '>>> MARKERINGER FJERNES, VENT ! <<<'
RECALL ALL
ENDIF
RELEASE MQ:ANS
ENDIF MQ:GDEL
RELEASE MQ:CMD,MQ:GMORE,MQ:GDEL,MQ:SLCT
RELEASE MQ:MODE
«eof»