'CORAL' L25
 
 
   'COMMON' ('INTEGER''PROCEDURE' RADASC('LOCATION''BYTE','LOCATION''BYTE','LOCATION''BYTE','VALUE''INTEGER'));
   'SEGMENT' RJSSUB
   'BEGIN'
 
 
       'INTEGER''PROCEDURE' RADASC ('LOCATION''BYTE' A,B,C;
       'VALUE''INTEGER' D );
       'BEGIN'
 
           'COMMENT' THEN OBJECT OF THIS PROGRAM IS TO GENERATE
                     THREE ASCII CHARACTERS FROM A RAD50 INPUT
                     IF THE INPUT CODE CANNOT BE TRANSLATED
                     CORRECTLY AN ERROR MARKER IS SET AS THE
                     ANSWER TO THIS PROCEDURE IE IF ANSWER IS
                     POSITIVE THEN CORRECT TRANSLATION HAS TAKEN
                     PLACE. THE FAIL ANSWER IS -1. WHEN A FAIL
                     OCCURS ALL THE REPLY ASCII CHARACTERS MUST
                     BE SUSPECTED
                     AUTHOR R J SPRIGGS 25/5/78;
           'BYTE''ARRAY' REFCHARS[0:40] := " ","A","B","C","D","E","F","G","H",
           "I","J","K","L",
           "M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","$",".","?",
           "0","1","2","3","4","5","6","7","8","9",-1;
           'LONG' INVALUE,SUBVAL,HOLDVALUE;
           'INTEGER' FINALSTATUS;
           INVALUE:=D; (HOLD INPUT VALUE)
           'IF'INVALUE<0 
           'THEN' INVALUE:=INVALUE+65536; (CORRECT SCALING VALUE)
           FINALSTATUS:=0; (SET MARKER INDICATING NO FAILS SO FAR)
           HOLDVALUE:=INVALUE/1600; (EXTRACT VALUE OF FIRST ASCII VALUE)
           SUBVAL:=HOLDVALUE*1600; (SET UP REMOVAL VALUE OF FIRST ACSII CODE)
           INVALUE:=INVALUE-SUBVAL; (REMOVE FIRST CHAR CODE VALUE FROM INPUT SUBSET)
           'IF'HOLDVALUE>39 
           'THEN'
           'BEGIN'
 
               'COMMENT'WE ARE NOW IN AN ERROR CONDITION
                         AND THE ASSUMPTION I TAKE IS THAT THE FIRST CODE IS A SPACE
                         AND I SET A MARKER INDICATING A FAULT HAS OCCURED;
               FINALSTATUS:=-1; (SET ERROR MARKER)
               HOLDVALUE:=0; (ASSUME FIRST CHAR IS A SPACE)
           'END';
           A:=REFCHARS[HOLDVALUE]; (HOLD FIRST DECODED ASCII CHARACTER)
           HOLDVALUE:=INVALUE/40; (HOLD 2ND EXTRACTION POSITION VALUE)
           SUBVAL:=HOLDVALUE*40; (SET UP REMOVAL VALUE OF SECOND ASCII CODE)
           B:=REFCHARS[HOLDVALUE]; (LOAD OUT 2ND ASCII CODE)
           HOLDVALUE:=INVALUE-SUBVAL; (HOLD 3RD EXTRACTION POSITION VALUE)
           C:=REFCHARS[HOLDVALUE]; (LOAD OUT 3RD ASCII CODE)
           'ANSWER'FINALSTATUS; (INDICATE FAIL/SUCCESS STATUS OF PROCESS)
       'END'OF RADASC PROCEDURE;
   'END';
   'FINISH'