source: WorldVistAEHR/trunk/r/SURGERY-SR/SRSLOOK1.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1SRSLOOK1 ;B'HAM ISC/MAM - ICD DIAGNOSIS LOOK-UP ; 17 MAR 1992 8:45 am
2 ;;3.0; Surgery ;;24 Jun 93
3START S SRSOUT=0 W @IOF,!!,"Based on the free-text procedure name entered, the computer will attempt to",!,"match the appropriate ICD Diagnosis Code."
4 W !!,"Do you want to select the ICD Diagnosis Code now ? YES// " R SRYN:DTIME I '$T!(SRYN["^") K SRICDD Q
5 S SRYN=$E(SRYN) I "YyNn"'[SRYN D HELP G START
6 I "Yy"'[SRYN K SRICDD Q
7 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
8 S SRYN="Y" I $P(SRDIAG," ",2)'="" D FIRST I SRSOUT S SRSOUT=0 Q
9 I $D(SRICDD) Q
10 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
11 Q
12HELP 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"
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
15FIRST ; search on first word of text
16 I $P(SRDIAG," ")["REPAIR" D REPAIR Q
17 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
18 S SRYN=$E(SRYN)
19 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
20 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
21 Q
22REPAIR ; search on remainder of text without 'REPAIR'
23 S SRDIAG1=SRDIAG,SRDIAG=$P(SRDIAG," ",2,200) W !!,"Searching ICD Diagnosis Codes to match with "_SRDIAG_"..."
24 K DIC S DIC=80,X=SRDIAG,DIC(0)="QEMZ" D ^DIC I Y>0 S SRSCPT=+Y
25 S SRDIAG=SRDIAG1 K SRDIAG1
26 Q
Note: See TracBrowser for help on using the repository browser.