DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦d6af5b649⟧ TextFile

    Length: 4864 (0x1300)
    Types: TextFile
    Names: »BRUKAT.GET«

Derivation

└─⟦c2fe28dee⟧ Bits:30008867 CORN 2 851210 CORN 3Z (RC org. database?)
    └─⟦this⟧ »BRUKAT.GET« 

TextFile


*     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»