AICDTOKN.m

AICDTOKN ; IHS/OHPRD/ACC - CONVERT INPUT LINE TO TOKENS ;

 ;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991

 ; AICDX IS PASSED IN AND SHOULD NOT BE KILLED

 ; AICDWT IS PASSED OUT AND SHOULD NOT BE KILLED

 K AICDWT

 Q:'$D(AICDX)  Q:AICDX?.E1C.E

 S AICDSWB="",AICDST="SKIP",AICDI=0,AICDXLEN=$L(AICDX)

CHLOOP S AICDI=AICDI+1 G:AICDI>AICDXLEN EXIT

 S AICDC=$E(AICDX,AICDI)

 S AICDOST=AICDST

 I AICDOST="SKIP",(AICDC'?1P!("'~"[AICDC&(($E(AICDX,AICDI+1)?1U)!("'~"[$E(AICDX,AICDI+1))))) S AICDST="SCAN",AICDWS=AICDI

 I AICDOST="SCAN",AICDC?1P,"-'~"'[AICDC S AICDEND=0 D ENDWORD S AICDST="SKIP"

 G CHLOOP

EXIT I AICDST="SCAN" S AICDEND=1 D ENDWORD

 K AICDSWB,AICDOST,AICDST,AICDXLEN,AICDC,AICDWF,AICDWS,AICDWD,AICDWD2,AICDWL,AICDEND,AICDI,AICDJ,AICDQ

 Q

ENDWORD S AICDWL=AICDI-AICDWS,AICDWD=$E(AICDX,AICDWS,AICDI-1)

 I AICDWL=1 S AICDSWB=AICDSWB_AICDWD I AICDEND S AICDWD=AICDSWB D STOREWD

 I AICDWL>1 D STOREWD I AICDSWB'="" S AICDWD=AICDSWB,AICDSWB="" D STOREWD

 Q

STOREWD ;

 Q:AICDWD'?.E1U.E

 S AICDJ=$S($E(AICDWD)="'":2,$E(AICDWD,1,2)="~'":3,1:1)

RMQ S AICDJ=$F(AICDWD,"'",AICDJ) I AICDJ S AICDWD=$E(AICDWD,1,AICDJ-2)_$E(AICDWD,AICDJ,255),AICDJ=AICDJ-1 G RMQ

 I AICDWD'["-" S AICDWT(AICDWD)="" Q

 S AICDWD2="" F AICDJ=1:1 S AICDWF=$P(AICDWD,"-",AICDJ) Q:AICDWF=""  Q:$L(AICDWF)>2  S AICDWD2=AICDWD2_AICDWF

 I AICDWF="" S AICDWT(AICDWD2)="" Q

 S AICDWD2=AICDWD F AICDJ=1:1 S AICDWF=$P(AICDWD2,"-",AICDJ) Q:AICDWF=""  S AICDWT(AICDWF)=""

 Q

AICDTOKN  ; IHS/OHPRD/ACC - CONVERT INPUT LINE TO TOKENS ;

 +1       ;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991

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

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

 +4        KILL AICDWT

 +5        IF '$DATA(AICDX)

               QUIT 

           IF AICDX?.E1C.E

               QUIT 

 +6        SET AICDSWB=""

           SET AICDST="SKIP"

           SET AICDI=0

           SET AICDXLEN=$LENGTH(AICDX)

CHLOOP     SET AICDI=AICDI+1

           IF AICDI>AICDXLEN

               GOTO EXIT

 +1        SET AICDC=$EXTRACT(AICDX,AICDI)

 +2        SET AICDOST=AICDST

 +3        IF AICDOST="SKIP"

               IF (AICDC'?1P!("'~"[AICDC&(($EXTRACT(AICDX,AICDI+1)?1U)!("'~"[$EXTRACT(AICDX,AICDI+1)))))

                   SET AICDST="SCAN"

                   SET AICDWS=AICDI

 +4        IF AICDOST="SCAN"

               IF AICDC?1P

                   IF "-'~"'[AICDC

                       SET AICDEND=0

                       DO ENDWORD

                       SET AICDST="SKIP"

 +5        GOTO CHLOOP

EXIT       IF AICDST="SCAN"

               SET AICDEND=1

               DO ENDWORD

 +1        KILL AICDSWB,AICDOST,AICDST,AICDXLEN,AICDC,AICDWF,AICDWS,AICDWD,AICDWD2,AICDWL,AICDEND,AICDI,AICDJ,AICDQ

 +2        QUIT 

ENDWORD    SET AICDWL=AICDI-AICDWS

           SET AICDWD=$EXTRACT(AICDX,AICDWS,AICDI-1)

 +1        IF AICDWL=1

               SET AICDSWB=AICDSWB_AICDWD

               IF AICDEND

                   SET AICDWD=AICDSWB

                   DO STOREWD

 +2        IF AICDWL>1

               DO STOREWD

               IF AICDSWB'=""

                   SET AICDWD=AICDSWB

                   SET AICDSWB=""

                   DO STOREWD

 +3        QUIT 

STOREWD   ;

 +1        IF AICDWD'?.E1U.E

               QUIT 

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

RMQ        SET AICDJ=$FIND(AICDWD,"'",AICDJ)

           IF AICDJ

               SET AICDWD=$EXTRACT(AICDWD,1,AICDJ-2)_$EXTRACT(AICDWD,AICDJ,255)

               SET AICDJ=AICDJ-1

               GOTO RMQ

 +1        IF AICDWD'["-"

               SET AICDWT(AICDWD)=""

               QUIT 

 +2        SET AICDWD2=""

           FOR AICDJ=1:1

               SET AICDWF=$PIECE(AICDWD,"-",AICDJ)

               IF AICDWF=""

                   QUIT 

               IF $LENGTH(AICDWF)>2

                   QUIT 

               SET AICDWD2=AICDWD2_AICDWF

 +3        IF AICDWF=""

               SET AICDWT(AICDWD2)=""

               QUIT 

 +4        SET AICDWD2=AICDWD

           FOR AICDJ=1:1

               SET AICDWF=$PIECE(AICDWD2,"-",AICDJ)

               IF AICDWF=""

                   QUIT 

               SET AICDWT(AICDWF)=""

 +5        QUIT