SRSLOOK.m

SRSLOOK ;B'HAM ISC/MAM - CPT LOOK-UP ; 16 MAR 1992 1:00 pm

 ;;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 CPT Code."

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

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

 I "Yy"'[SRYN K SRSCPT Q

 W @IOF,!,"Looking for potential CPT Codes based on the entire free-text procedure name...",! K DIC S DIC=81,DIC(0)="QEMZ",DIC("S")="I '$P(^ICPT(Y,0),""^"",4)",X=SRSOP D ^DIC I Y>0 S SRSCPT=+Y Q

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

 I $D(SRSCPT) Q

CPT K DIC,X,Y S X="",DIC=81,DIC("S")="I '$P(^ICPT(Y,0),""^"",4)",DIC(0)="QEAMZ",DIC("A")="Select Principal Operation Code (CPT): " W ! D ^DIC I Y>0 S SRSCPT=+Y

 Q

HELP W !!,"Enter 'YES' to utilize the computer for selecting the correct CPT 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(SRSOP," ")["REPAIR" D REPAIR Q

 W !!,SRSOP,!!,"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 CPT 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 CPT Codes based on the first word in your text...",! K DIC S DIC=81,DIC("S")="I '$P(^ICPT(Y,0),""^"",4)",DIC(0)="QEMZ",X=$P(SRSOP," ") D ^DIC I Y>0 S SRSCPT=+Y Q

 Q

REPAIR ; search on remainder of text without 'REPAIR'

 S SRSOP1=SRSOP,SRSOP=$P(SRSOP," ",2,200) W !!,"Searching CPT Codes to match with "_SRSOP_"..."

 K DIC S DIC=81,DIC("S")="I '$P(^ICPT(Y,0),""^"",4)",X=SRSOP,DIC(0)="QEMZ" D ^DIC I Y>0 S SRSCPT=+Y

 S SRSOP=SRSOP1 K SRSOP1

 Q

SRSLOOK   ;B'HAM ISC/MAM - CPT LOOK-UP ; 16 MAR 1992 1:00 pm

 +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 CPT Code."

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

           READ SRYN:DTIME

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

               KILL SRSCPT

               QUIT 

 +2        SET SRYN=$EXTRACT(SRYN)

           IF "YyNn"'[SRYN

               DO HELP

               GOTO START

 +3        IF "Yy"'[SRYN

               KILL SRSCPT

               QUIT 

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

           KILL DIC

           SET DIC=81

           SET DIC(0)="QEMZ"

           SET DIC("S")="I '$P(^ICPT(Y,0),""^"",4)"

           SET X=SRSOP

           DO ^DIC

           IF Y>0

               SET SRSCPT=+Y

               QUIT 

 +5        SET SRYN="Y"

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

               DO FIRST

               IF SRSOUT

                   SET SRSOUT=0

                   QUIT 

 +6        IF $DATA(SRSCPT)

               QUIT 

CPT        KILL DIC,X,Y

           SET X=""

           SET DIC=81

           SET DIC("S")="I '$P(^ICPT(Y,0),""^"",4)"

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Select Principal Operation Code (CPT): "

           WRITE !

           DO ^DIC

           IF Y>0

               SET SRSCPT=+Y

 +1        QUIT 

HELP       WRITE !!,"Enter 'YES' to utilize the computer for selecting the correct CPT 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(SRSOP," ")["REPAIR"

               DO REPAIR

               QUIT 

 +2        WRITE !!,SRSOP,!!,"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 CPT 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 CPT Codes based on the first word in your text...",!

               KILL DIC

               SET DIC=81

               SET DIC("S")="I '$P(^ICPT(Y,0),""^"",4)"

               SET DIC(0)="QEMZ"

               SET X=$PIECE(SRSOP," ")

               DO ^DIC

               IF Y>0

                   SET SRSCPT=+Y

                   QUIT 

 +6        QUIT 

REPAIR    ; search on remainder of text without 'REPAIR'

 +1        SET SRSOP1=SRSOP

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

           WRITE !!,"Searching CPT Codes to match with "_SRSOP_"..."

 +2        KILL DIC

           SET DIC=81

           SET DIC("S")="I '$P(^ICPT(Y,0),""^"",4)"

           SET X=SRSOP

           SET DIC(0)="QEMZ"

           DO ^DIC

           IF Y>0

               SET SRSCPT=+Y

 +3        SET SRSOP=SRSOP1

           KILL SRSOP1

 +4        QUIT