Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCUTOKN

APCUTOKN.m

Go to the documentation of this file.
  1. APCUTOKN ; CONVERT INPUT LINE TO TOKENS ; [ 08/21/86 10:52 AM ]
  1. K WT
  1. S SWB="",STATE="SKIP",I=0,LLEN=$L(L)
  1. CHLOOP S I=I+1 G:I>LLEN EXIT
  1. S C=$E(L,I)
  1. S OSTATE=STATE
  1. I OSTATE="SKIP",(C'?1P!("'~"[C&(($E(L,I+1)?1U)!("'~"[$E(L,I+1))))) S STATE="SCAN",WS=I
  1. I OSTATE="SCAN",C?1P,"-'~"'[C S END=0 D ENDWORD S STATE="SKIP"
  1. G CHLOOP
  1. EXIT I STATE="SCAN" S END=1 D ENDWORD
  1. K SWB,OSTATE,STATE,LLEN,C,J,WF,WS,WD,WD2,WL,END,Q
  1. Q
  1. ENDWORD S WL=I-WS,WD=$E(L,WS,I-1)
  1. I WL=1 S SWB=SWB_WD I END S WD=SWB D STOREWD
  1. I WL>1 D STOREWD I SWB'="" S WD=SWB,SWB="" D STOREWD
  1. Q
  1. STOREWD ;
  1. S J=$S($E(WD)="'":2,$E(WD,1,2)="~'":3,1:1)
  1. RMQ S J=$F(WD,"'",J) I J S WD=$E(WD,1,J-2)_$E(WD,J,255),J=J-1 G RMQ
  1. I WD'["-" S WT(WD)="" Q
  1. S WD2="" F J=1:1 S WF=$P(WD,"-",J) Q:WF="" Q:$L(WF)>2 S WD2=WD2_WF
  1. I WF="" S WT(WD2)="" Q
  1. S WD2=WD F J=1:1 S WF=$P(WD2,"-",J) Q:WF="" S WT(WF)=""
  1. Q