| [613] | 1 | SRSLOOK ;B'HAM ISC/MAM - CPT LOOK-UP ; 16 MAR 1992 1:00 pm
|
|---|
| 2 | ;;3.0; Surgery ;;24 Jun 93
|
|---|
| 3 | START S SRSOUT=0 W @IOF,!!,"Based on the free-text procedure name entered, the computer will attempt to",!,"match the appropriate CPT Code."
|
|---|
| 4 | W !!,"Do you want to select the CPT Code now ? YES// " R SRYN:DTIME I '$T!(SRYN["^") K SRSCPT Q
|
|---|
| 5 | S SRYN=$E(SRYN) I "YyNn"'[SRYN D HELP G START
|
|---|
| 6 | I "Yy"'[SRYN K SRSCPT Q
|
|---|
| 7 | 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
|
|---|
| 8 | S SRYN="Y" I $P(SRSOP," ",2)'="" D FIRST I SRSOUT S SRSOUT=0 Q
|
|---|
| 9 | I $D(SRSCPT) Q
|
|---|
| 10 | 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
|
|---|
| 11 | Q
|
|---|
| 12 | 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"
|
|---|
| 13 | W !,"own. Enter 'NO' to skip entering the CPT code and go on to the next prompt.",!!,"Press RETURN to continue " R X:DTIME
|
|---|
| 14 | Q
|
|---|
| 15 | FIRST ; search on first word of text
|
|---|
| 16 | I $P(SRSOP," ")["REPAIR" D REPAIR Q
|
|---|
| 17 | 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
|
|---|
| 18 | S SRYN=$E(SRYN)
|
|---|
| 19 | 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
|
|---|
| 20 | 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
|
|---|
| 21 | Q
|
|---|
| 22 | REPAIR ; search on remainder of text without 'REPAIR'
|
|---|
| 23 | S SRSOP1=SRSOP,SRSOP=$P(SRSOP," ",2,200) W !!,"Searching CPT Codes to match with "_SRSOP_"..."
|
|---|
| 24 | 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
|
|---|
| 25 | S SRSOP=SRSOP1 K SRSOP1
|
|---|
| 26 | Q
|
|---|
