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

⟦40ddc8fae⟧ TextFile

    Length: 4992 (0x1380)
    Types: TextFile
    Names: »ORG.GET«

Derivation

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

TextFile


*     ORG.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  ORG.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,001 SAY 'RC  ORGANISATIONS PL'
@ 02,021 SAY 'AN'
@ 02,050 SAY 'DATABASE      BILLED'
@ 02,071 SAY 'O 4.'
@ 03,001 SAY '--------------------'
@ 03,021 SAY '--------------------'
@ 03,041 SAY '--------------------'
@ 03,061 SAY '-------------------'
@ 06,001 SAY 'AFDELINGS NUMMER  ..'
@ 06,021 SAY '..........'
 STORE  '  '  TO  MAFNU
@ 06,034 GET MAFNU
@ 09,001 SAY 'LOKATION  ..........'
@ 09,021 SAY '..........'
@ 11,001 SAY 'AFDELINGS NAVN  ....'
@ 11,021 SAY '..........'
@ 13,001 SAY 'CHEF INITIALER  ....'
@ 13,021 SAY '..........'
@ 15,001 SAY 'OVERORDNET AFDELINGS'
@ 15,022 SAY 'NUMMER ..'
@ 17,000 SAY '--------------------'
@ 17,020 SAY '--------------------'
@ 17,040 SAY '--------------------'
@ 17,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(MAFNU) 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  AFNU  = MAFNU .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  ORG.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  ORG.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 ORG.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»