|
|
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: 4864 (0x1300)
Types: TextFile
Names: »BRUKAT.GET«
└─⟦c2fe28dee⟧ Bits:30008867 CORN 2 851210 CORN 3Z (RC org. database?)
└─⟦this⟧ »BRUKAT.GET«
* brukat.GET - GET PROGRAM
STORE ' T ' TO MQ:SLCT
STORE T TO MQ:GMORE
STORE 'N' TO MQ:GDEL
DO WHILE MQ:GMORE
ERASE
STORE ' GET ' TO MQ:MODE
* DISPLAY CURRENT RECORD
IF &MQ:SLCT
DO brukat.OUT
ENDIF
STORE ' ' TO MQ:CMD
@ 21,10 SAY ' ENTER N FOR NEXT, P FOR PREVIOUS '
@ 22,10 SAY ' S FOR SEARCH, M FOR MORE COMMANDS '
IF MQ:SLCT <> ' T '
@ 23,4 SAY '**'
ENDIF
@ 23,10 SAY ' PRESS RETURN WHEN DONE ' GET MQ:CMD
READ
IF !(MQ:CMD)= 'S'
STORE T TO MQ:SMORE
DO WHILE MQ:SMORE
ERASE
STORE ' SEARCH ' TO MQ:MODE
* GET FIELDS TO SEARCH FOR
@ 01,000 SAY '--------------------'
@ 01,020 SAY '--------------'
@ 01,046 SAY '--------------------'
@ 01,066 SAY '--------------'
@ 02,002 SAY 'RC SAMMENLIGN MEDAR'
@ 02,022 SAY 'BEJDERE I BRUGERKATA'
@ 02,042 SAY 'LOGER OG PERSONALE S'
@ 02,062 SAY 'YSTEM'
@ 03,000 SAY '--------------------'
@ 03,020 SAY '--------------------'
@ 03,040 SAY '--------------------'
@ 03,060 SAY '--------------------'
@ 05,002 SAY 'MEDARBEJDER NUMMER .'
@ 05,022 SAY '.............'
STORE ' ' TO MMANR
@ 05,037 GET MMANR
@ 08,002 SAY 'INITIALER ..........'
@ 08,022 SAY '.............'
@ 10,002 SAY 'AFDELINGS NUMMER ...'
@ 10,022 SAY '.............'
@ 13,000 SAY '--------------------'
@ 13,020 SAY '--------------------'
@ 13,040 SAY '--------------------'
@ 13,060 SAY '--------------------'
@ 21,10 SAY ' PLEASE ENTER VALUES TO SEARCH FOR '
IF MQ:SLCT <> ' T '
@ 23,4 SAY '**'
ENDIF
READ
* EXIT FROM LOOP IF FOUND
GOTO TOP
STORE TRIM(MMANR) TO MQ:KEY
IF MQ:SLCT= ' T '
FIND &MQ:KEY
IF # <> 0
STORE F TO MQ:SMORE
ELSE
@ 22,10 SAY ' NOT FOUND '
@ 23,10 SAY ' TRY AGAIN(Y/N)? '
SET CONSOLE OFF
WAIT TO MQ:DUMMY
SET CONSOLE ON
IF !(MQ:DUMMY) <> 'Y'
STORE F TO MQ:SMORE
ENDIF Y
RELEASE MQ:DUMMY
ENDIF # <> 0
ELSE
LOCATE FOR MANR = MMANR .AND. &MQ:SLCT
IF .NOT. EOF
STORE F TO MQ:SMORE
ELSE
@ 22,10 SAY ' NOT FOUND '
@ 23,10 SAY ' TRY AGAIN(Y/N)? '
SET CONSOLE OFF
WAIT TO MQ:DUMMY
SET CONSOLE ON
IF !(MQ:DUMMY) <> 'Y'
STORE F TO MQ:SMORE
ENDIF Y
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 ' MORE ' TO MQ:MODE
STORE ' ' TO MQ:MMD
@ 21,10 SAY ' ENTER E TO EDIT, D TO DELETE, '
@ 22,10 SAY ' P TO PRINT, C TO dSCAN '
IF MQ:SLCT <> ' T '
@ 23,4 SAY '**'
ENDIF
@ 23,10 SAY ' PRESS RETURN WHEN DONE ' GET MQ:MMD
READ
IF !(MQ:MMD) = 'E'
ERASE
IF MQ:SLCT <> ' T '
@ 23,4 SAY '**'
ENDIF
* EDIT RECORD
DO brukat.ED
ELSE
IF !(MQ:MMD)= 'D'
STORE 'N' TO MQ:ANS
IF MQ:SLCT <> ' T '
@ 23,4 SAY '**'
ENDIF
@ 23,10 SAY ' ARE YOU SURE(Y/N)? '
@ 23,28 GET MQ:ANS
READ
IF !(MQ:ANS)= 'Y'
DELETE
STORE 'Y' TO MQ:GDEL
ENDIF
RELEASE MQ:ANS
ELSE
IF !(MQ:MMD)= 'P'
@ 23,10 SAY ' PLEASE SET UP PRINTER '
STORE ' ' TO MQ:MODE
SET CONSOLE OFF
WAIT
SET CONSOLE ON
SET FORMAT TO PRINT
DO brukat.OUT
SET FORMAT TO SCREEN
ELSE
IF !(MQ:MMD)='C'
GOTO TOP
STORE ' ' TO MQ:SLCT
@ 21,10 SAY 'PLEASE ENTER SELECTION CRITERIA '
@ 22,10 SAY ' DO NOT PRESS RETURN!!! '
@ 23,4 SAY '**'
@ 23,10 GET MQ:SLCT
READ
LOCATE FOR &MQ:SLCT
IF EOF
@ 21,10 SAY 'NO MORE RECORDS CAN BE FOUND '
@ 22,10 SAY 'PLEASE PRESS RETURN TO CONTINUE '
@ 23,4 SAY ' '
STORE ' T ' TO MQ:SLCT
SET CONSOLE OFF
WAIT
SET CONSOLE ON
ELSE
DO brukat.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 = 'Y'
STORE 'N' TO MQ:ANS
@ 23,10 SAY 'WANT TO PERMANENTLY DELETE RECORDS(Y/N)'
@ 23,49 GET MQ:ANS
READ
IF MQ:ANS = 'Y'
PACK
ELSE
RECALL ALL
ENDIF
RELEASE MQ:ANS
ENDIF MQ:GDEL
RELEASE MQ:CMD,MQ:GMORE,MQ:GDEL,MQ:SLCT
RELEASE MQ:MODE
«eof»