SRSLOOK1.m

SRSLOOK1 ;B'HAM ISC/MAM - ICD DIAGNOSIS LOOK-UP ; 17 MAR 1992 8:45 am

 ;;3.0; Surgery ;;24 Jun 93

START S SRSOUT=0 W @IOF,!!,"Based on the free-text procedure name entered, the computer will attempt to",!,"match the appropriate ICD Diagnosis Code."

 W !!,"Do you want to select the ICD Diagnosis Code now ?  YES// " R SRYN:DTIME I '$T!(SRYN["^") K SRICDD Q

 S SRYN=$E(SRYN) I "YyNn"'[SRYN D HELP G START

 I "Yy"'[SRYN K SRICDD Q

 W @IOF,!,"Looking for potential ICD Diagnosis Codes based on the entire ",!,"free-text procedure name...",! K DIC S DIC=80,DIC(0)="QEMZ",X=SRDIAG D ^DIC I Y>0 S SRICDD=+Y Q

 S SRYN="Y" I $P(SRDIAG," ",2)'="" D FIRST I SRSOUT S SRSOUT=0 Q

 I $D(SRICDD) Q

 K DIC,X,Y S X="",DIC=80,DIC(0)="QEAMZ",DIC("A")="Select Principal Diagnosis Code (ICD Diagnosis): " W ! D ^DIC I Y>0 S SRICDD=+Y

 Q

HELP W !!,"Enter 'YES' to utilize the computer for selecting the correct ICD Diagnosis ",!,"code based on your free-text procedure name, or if you'd like to select ",!,"the code on your"

 W " own.  Enter 'NO' to skip entering the CPT code and go on",!,"to the next prompt.",!!,"Press RETURN to continue  " R X:DTIME

 Q

FIRST ; search on first word of text

 I $P(SRDIAG," ")["REPAIR" D REPAIR Q

 W !!,SRDIAG,!!,"Do you want to search for the correct CPT code based on the first word",!,"of your free-text procedure name ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q

 S SRYN=$E(SRYN)

 I "YyNn"'[SRYN W !!,"Enter 'YES' to search for the appropriate ICD Diagnosis code based on the first ",!,"word of your free-text procedure name.  Enter 'NO' to select a CPT code on ",!,"your own." G FIRST

 I "Yy"[SRYN W !!,"Looking for potential ICD Diagnosis Codes based on the first word ",!,"in your text...",! K DIC S DIC=80,DIC(0)="QEMZ",X=$P(SRDIAG," ") D ^DIC I Y>0 S SRICDD=+Y Q

 Q

REPAIR ; search on remainder of text without 'REPAIR'

 S SRDIAG1=SRDIAG,SRDIAG=$P(SRDIAG," ",2,200) W !!,"Searching ICD Diagnosis Codes to match with "_SRDIAG_"..."

 K DIC S DIC=80,X=SRDIAG,DIC(0)="QEMZ" D ^DIC I Y>0 S SRSCPT=+Y

 S SRDIAG=SRDIAG1 K SRDIAG1

 Q

SRSLOOK1  ;B'HAM ISC/MAM - ICD DIAGNOSIS LOOK-UP ; 17 MAR 1992 8:45 am

 +1       ;;3.0; Surgery ;;24 Jun 93

START      SET SRSOUT=0

           WRITE @IOF,!!,"Based on the free-text procedure name entered, the computer will attempt to",!,"match the appropriate ICD Diagnosis Code."

 +1        WRITE !!,"Do you want to select the ICD Diagnosis Code now ?  YES// "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               KILL SRICDD

               QUIT 

 +2        SET SRYN=$EXTRACT(SRYN)

           IF "YyNn"'[SRYN

               DO HELP

               GOTO START

 +3        IF "Yy"'[SRYN

               KILL SRICDD

               QUIT 

 +4        WRITE @IOF,!,"Looking for potential ICD Diagnosis Codes based on the entire ",!,"free-text procedure name...",!

           KILL DIC

           SET DIC=80

           SET DIC(0)="QEMZ"

           SET X=SRDIAG

           DO ^DIC

           IF Y>0

               SET SRICDD=+Y

               QUIT 

 +5        SET SRYN="Y"

           IF $PIECE(SRDIAG," ",2)'=""

               DO FIRST

               IF SRSOUT

                   SET SRSOUT=0

                   QUIT 

 +6        IF $DATA(SRICDD)

               QUIT 

 +7        KILL DIC,X,Y

           SET X=""

           SET DIC=80

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Select Principal Diagnosis Code (ICD Diagnosis): "

           WRITE !

           DO ^DIC

           IF Y>0

               SET SRICDD=+Y

 +8        QUIT 

HELP       WRITE !!,"Enter 'YES' to utilize the computer for selecting the correct ICD Diagnosis ",!,"code based on your free-text procedure name, or if you'd like to select ",!,"the code on your"

 +1        WRITE " own.  Enter 'NO' to skip entering the CPT code and go on",!,"to the next prompt.",!!,"Press RETURN to continue  "

           READ X:DTIME

 +2        QUIT 

FIRST     ; search on first word of text

 +1        IF $PIECE(SRDIAG," ")["REPAIR"

               DO REPAIR

               QUIT 

 +2        WRITE !!,SRDIAG,!!,"Do you want to search for the correct CPT code based on the first word",!,"of your free-text procedure name ? YES// "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRSOUT=1

               QUIT 

 +3        SET SRYN=$EXTRACT(SRYN)

 +4        IF "YyNn"'[SRYN

               WRITE !!,"Enter 'YES' to search for the appropriate ICD Diagnosis code based on the first ",!,"word of your free-text procedure name.  Enter 'NO' to select a CPT code on ",!,"your own."

               GOTO FIRST

 +5        IF "Yy"[SRYN

               WRITE !!,"Looking for potential ICD Diagnosis Codes based on the first word ",!,"in your text...",!

               KILL DIC

               SET DIC=80

               SET DIC(0)="QEMZ"

               SET X=$PIECE(SRDIAG," ")

               DO ^DIC

               IF Y>0

                   SET SRICDD=+Y

                   QUIT 

 +6        QUIT 

REPAIR    ; search on remainder of text without 'REPAIR'

 +1        SET SRDIAG1=SRDIAG

           SET SRDIAG=$PIECE(SRDIAG," ",2,200)

           WRITE !!,"Searching ICD Diagnosis Codes to match with "_SRDIAG_"..."

 +2        KILL DIC

           SET DIC=80

           SET X=SRDIAG

           SET DIC(0)="QEMZ"

           DO ^DIC

           IF Y>0

               SET SRSCPT=+Y

 +3        SET SRDIAG=SRDIAG1

           KILL SRDIAG1

 +4        QUIT