VistA-WorldVistAEHR/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQ.../XTLKTOKN.m

31 lines
1.4 KiB
Mathematica

XTLKTOKN ;IHS/OHPRD/ACC,SFISC/JC - CONVERT INPUT LINE TO TOKENS ;07/22/93 15:51
;;7.3;TOOLKIT;;Apr 25, 1995
; XTLKX IS PASSED IN AND SHOULD NOT BE KILLED
; XTLKWT IS PASSED OUT AND SHOULD NOT BE KILLED
K XTLKWT
Q:'$D(XTLKX) Q:XTLKX?.E1C.E
S XTLKSWB="",XTLKST="SKIP",XTLKI=0,XTLKXLEN=$L(XTLKX)
CHLOOP S XTLKI=XTLKI+1 G:XTLKI>XTLKXLEN EXIT
S XTLKC=$E(XTLKX,XTLKI)
S XTLKOST=XTLKST
I XTLKOST="SKIP",(XTLKC'?1P!("'~"[XTLKC&(($E(XTLKX,XTLKI+1)?1U)!("'~"[$E(XTLKX,XTLKI+1))))) S XTLKST="SCAN",XTLKWS=XTLKI
I XTLKOST="SCAN",XTLKC?1P,"-'~"'[XTLKC S XTLKEND=0 D ENDWORD S XTLKST="SKIP"
G CHLOOP
EXIT I XTLKST="SCAN" S XTLKEND=1 D ENDWORD
K XTLKSWB,XTLKOST,XTLKST,XTLKXLEN,XTLKC,XTLKWF,XTLKWS,XTLKWD,XTLKWD2,XTLKWL,XTLKEND,XTLKI,XTLKJ,XTLKQ
Q
ENDWORD S XTLKWL=XTLKI-XTLKWS,XTLKWD=$E(XTLKX,XTLKWS,XTLKI-1)
I XTLKWL=1 S XTLKSWB=XTLKSWB_XTLKWD I XTLKEND S XTLKWD=XTLKSWB D STOREWD
I XTLKWL>1 D STOREWD I XTLKSWB'="" S XTLKWD=XTLKSWB,XTLKSWB="" D STOREWD
Q
STOREWD ;
Q:XTLKWD'?.E1U.E
S XTLKJ=$S($E(XTLKWD)="'":2,$E(XTLKWD,1,2)="~'":3,1:1)
RMQ S XTLKJ=$F(XTLKWD,"'",XTLKJ) I XTLKJ S XTLKWD=$E(XTLKWD,1,XTLKJ-2)_$E(XTLKWD,XTLKJ,255),XTLKJ=XTLKJ-1 G RMQ
N XTLKL S XTLKL=$L(XTLKWD)
I XTLKWD'["-" S XTLKWT(XTLKWD)="" Q
S XTLKWD2="" F XTLKJ=1:1 S XTLKWF=$P(XTLKWD,"-",XTLKJ) Q:XTLKWF="" Q:$L(XTLKWF)>2 S XTLKWD2=XTLKWD2_XTLKWF
I XTLKWF="" S XTLKWT(XTLKWD2)="" Q
S XTLKWD2=XTLKWD F XTLKJ=1:1 S XTLKWF=$P(XTLKWD2,"-",XTLKJ) Q:XTLKWF="" S XTLKWT(XTLKWF)=""
Q