XTLKTOKN.m

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

XTLKTOKN  ;IHS/OHPRD/ACC,SFISC/JC - CONVERT INPUT LINE TO TOKENS ;07/22/93  15:51

 +1       ;;7.3;TOOLKIT;;Apr 25, 1995

 +2       ; XTLKX IS PASSED IN AND SHOULD NOT BE KILLED

 +3       ; XTLKWT IS PASSED OUT AND SHOULD NOT BE KILLED

 +4        KILL XTLKWT

 +5        IF '$DATA(XTLKX)

               QUIT 

           IF XTLKX?.E1C.E

               QUIT 

 +6        SET XTLKSWB=""

           SET XTLKST="SKIP"

           SET XTLKI=0

           SET XTLKXLEN=$LENGTH(XTLKX)

CHLOOP     SET XTLKI=XTLKI+1

           IF XTLKI>XTLKXLEN

               GOTO EXIT

 +1        SET XTLKC=$EXTRACT(XTLKX,XTLKI)

 +2        SET XTLKOST=XTLKST

 +3        IF XTLKOST="SKIP"

               IF (XTLKC'?1P!("'~"[XTLKC&(($EXTRACT(XTLKX,XTLKI+1)?1U)!("'~"[$EXTRACT(XTLKX,XTLKI+1)))))

                   SET XTLKST="SCAN"

                   SET XTLKWS=XTLKI

 +4        IF XTLKOST="SCAN"

               IF XTLKC?1P

                   IF "-'~"'[XTLKC

                       SET XTLKEND=0

                       DO ENDWORD

                       SET XTLKST="SKIP"

 +5        GOTO CHLOOP

EXIT       IF XTLKST="SCAN"

               SET XTLKEND=1

               DO ENDWORD

 +1        KILL XTLKSWB,XTLKOST,XTLKST,XTLKXLEN,XTLKC,XTLKWF,XTLKWS,XTLKWD,XTLKWD2,XTLKWL,XTLKEND,XTLKI,XTLKJ,XTLKQ

 +2        QUIT 

ENDWORD    SET XTLKWL=XTLKI-XTLKWS

           SET XTLKWD=$EXTRACT(XTLKX,XTLKWS,XTLKI-1)

 +1        IF XTLKWL=1

               SET XTLKSWB=XTLKSWB_XTLKWD

               IF XTLKEND

                   SET XTLKWD=XTLKSWB

                   DO STOREWD

 +2        IF XTLKWL>1

               DO STOREWD

               IF XTLKSWB'=""

                   SET XTLKWD=XTLKSWB

                   SET XTLKSWB=""

                   DO STOREWD

 +3        QUIT 

STOREWD   ;

 +1        IF XTLKWD'?.E1U.E

               QUIT 

 +2        SET XTLKJ=$SELECT($EXTRACT(XTLKWD)="'":2,$EXTRACT(XTLKWD,1,2)="~'":3,1:1)

RMQ        SET XTLKJ=$FIND(XTLKWD,"'",XTLKJ)

           IF XTLKJ

               SET XTLKWD=$EXTRACT(XTLKWD,1,XTLKJ-2)_$EXTRACT(XTLKWD,XTLKJ,255)

               SET XTLKJ=XTLKJ-1

               GOTO RMQ

 +1        NEW XTLKL

           SET XTLKL=$LENGTH(XTLKWD)

 +2        IF XTLKWD'["-"

               SET XTLKWT(XTLKWD)=""

               QUIT 

 +3        SET XTLKWD2=""

           FOR XTLKJ=1:1

               SET XTLKWF=$PIECE(XTLKWD,"-",XTLKJ)

               IF XTLKWF=""

                   QUIT 

               IF $LENGTH(XTLKWF)>2

                   QUIT 

               SET XTLKWD2=XTLKWD2_XTLKWF

 +4        IF XTLKWF=""

               SET XTLKWT(XTLKWD2)=""

               QUIT 

 +5        SET XTLKWD2=XTLKWD

           FOR XTLKJ=1:1

               SET XTLKWF=$PIECE(XTLKWD2,"-",XTLKJ)

               IF XTLKWF=""

                   QUIT 

               SET XTLKWT(XTLKWF)=""

 +6        QUIT