Retro1.org codex

*DECK NXDCB 
USETEXT NIPDEF
PROC NXDCB(DCWORD,BINWORD,ERROR);  # CONVERT DISPLAY CODE TO BINARY    #
STARTIMS; 
 #
*1DC  NXDCB 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        NXDCB               C. BITTNER          83/04/01 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        THIS PROCEDURE CONVERTS A DISPLAY CODE NUMBER TO 
*        BINARY FORMAT. 
* 
*     3. METHOD USED
*        VALIDATE EACH DIGIT - CHECK IF IN RANGE BETWEEN
*        0 AND 9.  IF O"00" FOUND - WHOLE NUMBER HAS BEEN 
*        CONVERTED, ELSE MASK IN THE DIGIT INTO THE 
*        BINARY WORD. 
* 
*     4. ENTRY PARAMETERS 
*        DCWORD - DISPLAY CODE NUMBER 
* 
*     5. EXIT PARAMETERS
*        BINWORD - OUTPUT WORD IN BINARY
*        ERROR - ERROR IN PARAMETER FLAG
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED 
*        NIPDEF 
* 
*     7. ROUTINES CALLED
*        XTRACE - TRACE PROCEDURE CALL
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        NONE 
* 
 #
STOPIMS;
 
# 
      INPUT PARAMETERS
# 
      ITEM DCWORD U;         # DISPLAY CODE WORD                       #
 
# 
      OUTPUT PARAMETERS 
# 
      ITEM BINWORD I;        # OUTPUT WORD IN BINARY                   #
      ITEM ERROR B;          # ERROR IN PARAMETER FLAG                 #
      ITEM DONE B;           # DONE FLAG - LAST DIGIT CONVERTED        #
 
# 
      EXTERNAL VARIABLES
# 
      XREF PROC XTRACE;      # TRACE PROCEDURE CALL                    #
 
# 
      INTERNAL VARIABLES
# 
      ITEM NUM I;            # DISPLAY CODE DIGIT                      #
      ITEM J;                # LOOP PARAMETER                          #
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("NXDCB");
      CONTROL FI; 
 
      BINWORD = 0;
      DONE = FALSE; 
      ERROR = FALSE;
      FOR J=0 STEP 1 WHILE J LS WC  AND NOT ERROR  AND NOT DONE 
      DO
        BEGIN 
        NUM = C<J,1>DCWORD; 
        IF (NUM GQ O"33" AND NUM LQ O"44" ) 
        THEN
          BEGIN 
          BINWORD = (BINWORD * 10) + (NUM - O"33"); 
          END 
        ELSE
          IF NUM EQ O"00" 
          THEN
            DONE = TRUE;
          ELSE
            ERROR = TRUE; 
        END 
      END 
TERM