%EXTERNALROUTINE XSTRAN(%STRING(63) S)
%EXTERNALROUTINESPEC DEFINE(%STRING(63) SA)
%EXTERNALROUTINESPEC COPY(%STRING(63) SB)
%EXTERNALROUTINESPEC FORTE(%STRING(63) SD)
%EXTERNALROUTINESPEC DESTROY(%STRING(63) SE)
%EXTERNALROUTINESPEC CLEAR(%STRING(63) SF)
%EXTERNALROUTINESPEC SEND(%STRING(63) SG)
%EXTERNALROUTINESPEC CLOSEF(%INTEGERNAME PX)
%EXTERNALROUTINESPEC INIT
%EXTERNALROUTINESPEC PARSE
%EXTERNALROUTINESPEC TERM
%ROUTINESPEC ANALYSE (%STRING(20) XA,XB,XC,XD)
%STRING(20) A,B,C,D,NULL
%STRING(20) STRANPD,STRANMBR,FORTPD
%STRING(20) OBJECTPD,BASENAME,PARMS,FORLIST
%STRING(80) SIN
%INTEGER I,ERROR,NL,FPARM
      %ON %EVENT 9 %START
         SELECTINPUT(0)
         CLOSESTREAM(20)
         CLEAR("20")
         DESTROY(BASENAME."C")
         DESTROY("XTNULL")
         %STOP
         %FINISH
      NULL=""
      ERROR=0
      NL=10
      %IF S-> A.(",").B.(",").C.(",").D %THEN ANALYSE(A,B,C,D) %C
      %ELSE %START
         %IF S->A.(",").B.(",").C %THEN ANALYSE(A,B,C,NULL) %C
         %ELSE %START
            %IF S->A.(",").B %THEN ANALYSE(A,B,NULL,NULL) %C
            %ELSE ANALYSE(S,NULL,NULL,NULL)
         %FINISH
      %FINISH
      %IF ERROR=0 %THEN %START
         COPY (STRANPD."_".STRANMBR.",".STRANMBR)
         DEFINE("ST20,XTEMP")
         SELECTOUTPUT(20)
         PRINTSTRING(BASENAME."    ")
         NEWLINE
         SELECTOUTPUT(0)
         CLOSESTREAM(20)
         CLEAR("20")
         DEFINE("FT05,XTEMP")
         INIT
         PARSE
         TERM
         FPARM=5
         CLOSEF(FPARM)
         DESTROY("XTEMP")
         %IF PARMS#"" %THEN SEND ("LPT")
         CLEAR("")
         DESTROY(STRANMBR)
         %IF PARMS="LF" %THEN FORLIST=".LP"    %C
               %ELSE FORLIST="XTNULL"
         DEFINE("ST20,".BASENAME."C")
         SELECTINPUT(20)

         %CYCLE
            SKIPSYMBOL %WHILE NEXTSYMBOL=NL
            SIN=""
            %WHILE NEXTSYMBOL#NL %CYCLE
                 READSYMBOL(I)
                 SIN=SIN.TOSTRING(I)
                 %REPEAT
         SIN->("FORTE ").A.(",").B.(",").C

         %IF PARMS#"NF" %THEN %START
            FORTE(A.",".B.",".FORLIST)
            COPY(B.",".OBJECTPD."_".B)
            DESTROY(B)
            %FINISH
         COPY(A.",".FORTPD."_".A)
         DESTROY(A)
         %REPEAT
         %FINISH %ELSE %START
         DEFINE("ST20,.OUT")
         PRINTSTRING("  XSTRAN  INVALID PARAMETERS ")
         NEWLINE
         %FINISH
      %ROUTINE ANALYSE(%STRING (20) YA,YB,YC,YD)
      %STRING(20) X,Y
      %INTEGER SLEN
      %IF YA-> STRANPD.("_").STRANMBR %AND STRANPD # ""  %C
               %AND STRANMBR # "" %THEN %START
         SLEN=LENGTH(STRANMBR)
         %IF SLEN>2       %C 
           %AND FROMSTRING(STRANMBR,SLEN-1,SLEN) = "FS" %C
            %THEN BASENAME=FROMSTRING(STRANMBR,1,SLEN-2)   %C
            %ELSE BASENAME=STRANMBR
          %IF YB#""  %THEN FORTPD=YB %ELSE FORTPD=STRANPD
          %IF YC#"" %THEN OBJECTPD=YC %ELSE OBJECTPD=STRANPD
          %IF YD="NF" %OR YD="LF" %THEN PARMS=YD   %C
          %ELSE %START
             %IF YD#"" %THEN PARMS="LS" %ELSE PARMS=""
             %FINISH
      %FINISH %ELSE ERROR=1
      %END
%END
%ENDOFFILE