Retro1.org codex

*DECK     CSUCDB
      PROC CSUCDB(INW,OUTW1,OUTW2,ERR); 
# TITLE - CONVERT DISPLAY CODE DECIMAL TO BINARY                       #
      BEGIN 
# 
**    CSUCDB - CONVERT DECIMAL TO BINARY. 
* 
*     J.C. LEE     82/01/02 
*     D.K. ENDO    82/06/03 
* 
*     THIS PROCEDURE CONVERTS A LEFT JUSTIFIED DISPLAY CODE VALUE TO
*     BINARY.  IF THE VALUE IS NOT A DECIMAL NUMBER THEN AN ERROR 
*     STATUS IS RETURNED. 
* 
*     PROC CSUCDB 
* 
*     ENTRY        1. INW = INPUT WORD, LEFT JUSTIFIED. 
* 
*     EXIT         1. OUTW1 = OUTPUT BINARY VALUE.
*                  2. OUTW2 = OUTPUT RIGHT JUSTIFIED DC.
*                  3. ERR   = ERROR INDICATOR.
* 
*     METHOD
* 
*     FOR EACH CHARACTER BEGINNING ON THE LEFT, IF IT IS A CHARACTER
*     CHARACTER CONVERT IT TO BINARY ELSE, SET COMPLETE FLAG AND IF 
*     CHARACTER IS NOT A ZERO BYTE THEN SET ERROR FLAG.  IF THE 
*     COMPLETE FLAG IS NOT SET THEN, ADD CURRENT DIGIT TO VALUE.
* 
# 
      DEF DC$0       #O"33"#;          # DISPLAY-CODED 0               #
      DEF DC$9       #O"44"#;          # DISPLAY-CODED 9               #
 
      ITEM INW        U;               # INPUT WORD, LEFT-JUSTIFIED    #
      ITEM OUTW1      I;               # OUTPUT BINARY VALUE           #
      ITEM OUTW2      I;               # OUTPUT RIGHT-JUSTIFIED DC     #
      ITEM ERR        B;               # ERROR INDICATOR               #
      ITEM COMPLETE   B;               # CONVERSION DONE INDICATOR     #
      ITEM DIGIT      I;               # ONE DISPLAY-CODED CHARACTER   #
      ITEM I          I;               # TEMPORARY VARIABLE            #
CONTROL EJECT;
      ERR = FALSE;
      OUTW1 = 0;
      OUTW2 = 0;
      COMPLETE = FALSE;                # CONVERSION NOT DONE YET       #
 
      FOR I=0 STEP 1 WHILE I LS 10
                     AND NOT COMPLETE 
      DO
        BEGIN                          # PROCESS A DISPLAY-CODED CHAR  #
        DIGIT = C<I,1>INW;
 
        IF DIGIT GQ DC$0
          AND DIGIT LQ DC$9 
        THEN                           # DIGIT IS BETWEEN 0 AND 9      #
          DIGIT = DIGIT - O"33";
 
        ELSE                           # NOT A DECIMAL NUMBER          #
          BEGIN 
          COMPLETE = TRUE;
          IF (DIGIT NQ 0) AND (DIGIT NQ O"55")
          THEN                         # ERROR IF NOT END OF FIELD     #
            ERR = TRUE; 
          END 
 
        IF NOT COMPLETE 
        THEN
          BEGIN 
          OUTW2 = OUTW2*O"100" + DIGIT ;  # DECIMAL VALUE IN CHAR      #
          OUTW1 = OUTW1*10 + DIGIT;    # CONVERT TO BINARY VALUE       #
          END 
        END 
      RETURN; 
      END 
TERM