[613] | 1 | SPNICD1 ;SAN/WDE/Report of PT's with particular ICD9's
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**14**;01/02/1997
|
---|
| 3 | EN ;prompt user for ICD's that they want to look for
|
---|
| 4 | K SPNICD
|
---|
| 5 | S SPNEXIT=0
|
---|
| 6 | D REG I SPNEXIT=1 D ZAP Q
|
---|
| 7 | D ASK I SPNEXIT=1 D ZAP Q
|
---|
| 8 | I SPNANS=1 D RANGE I SPNEXIT=1 D ZAP Q
|
---|
| 9 | I SPNANS=2 D SINGLE I SPNEXIT=1 D ZAP Q
|
---|
| 10 | D DATE I SPNEXIT=1 D ZAP Q
|
---|
| 11 | D DEV I SPNEXIT=1 D ZAP Q
|
---|
| 12 | D BEG I SPNEXIT=1 D ZAP K SPNEXIT Q
|
---|
| 13 | Q
|
---|
| 14 | ;-----------------------------------------------------------------
|
---|
| 15 | ASK ;see if they want a range..
|
---|
| 16 | W !,"Would you like to sort on a Range of ICD9 codes"
|
---|
| 17 | S %=2 D YN^DICN
|
---|
| 18 | I %[0 W !?10,"Enter Y or Yes if you want to sort on a range of ICD9 codes.",!?10,"Enter N or No if you want to look for specific ICD9 codes." G ASK
|
---|
| 19 | I %<1 S SPNEXIT=1 Q
|
---|
| 20 | S SPNANS=%
|
---|
| 21 | Q
|
---|
| 22 | ;-----------------------------------------------------------------
|
---|
| 23 | REG W !!,"Do you want patients in the Registry only"
|
---|
| 24 | S %=1 D YN^DICN
|
---|
| 25 | I %[0 D G REG
|
---|
| 26 | . W !?10,"Enter Y or Yes if you want just patients in the Registry,"
|
---|
| 27 | . W !?10,"Or enter N or No to include all Patients."
|
---|
| 28 | I %<1 S SPNEXIT=1 Q
|
---|
| 29 | S SPNIN=$S(%=1:"JUST",1:"ALL")
|
---|
| 30 | Q
|
---|
| 31 | ;------------------------------------------------------------------
|
---|
| 32 | RANGE ;tag allow user to input a range start and end icd's
|
---|
| 33 | ;Note the set up of spnary its the value
|
---|
| 34 | S DIC(0)="AEQMNZ",DIC("A")="Starting ICD9 Code: "
|
---|
| 35 | S DIC="^ICD9("
|
---|
| 36 | D ^DIC I Y<1 S SPNEXIT=1 Q
|
---|
| 37 | I Y>1 S SPNRAN1=$P(Y,U,2)
|
---|
| 38 | S DIC("A")="Ending ICD9 code: "
|
---|
| 39 | D ^DIC I Y<1 S SPNEXIT=1 Q
|
---|
| 40 | I Y>1 S SPNRAN2=$P(Y,U,2)
|
---|
| 41 | I SPNRAN2<SPNRAN1 W !," Your ending value is lower then your starting value !!" S SPNEXIT=1 Q
|
---|
| 42 | Q
|
---|
| 43 | ;------------------------------------------------------------------
|
---|
| 44 | SINGLE ;tag allows uses to input single code to search for
|
---|
| 45 | S DIC(0)="AEQMNZ",DIC("A")="What ICD9's would you like to look for? "
|
---|
| 46 | S DIC="^ICD9("
|
---|
| 47 | F D Q:Y<1
|
---|
| 48 | .D ^DIC
|
---|
| 49 | .Q:Y<1
|
---|
| 50 | .S SPNARY($P(Y,U,2))=Y
|
---|
| 51 | .Q
|
---|
| 52 | I $D(SPNARY)=0 S SPNEXIT=1 Q
|
---|
| 53 | Q
|
---|
| 54 | ;------------------------------------------------------------------
|
---|
| 55 | DEV ;Toss in the device call later
|
---|
| 56 | S SPNLEXIT=""
|
---|
| 57 | S ZTSAVE("SPN*")=""
|
---|
| 58 | D DEVICE^SPNPRTMT("JUMPIN^SPNICD1","ICD9 Code Search",.ZTSAVE) Q:SPNLEXIT
|
---|
| 59 | TASK ;
|
---|
| 60 | I SPNIO="Q" D ZAP S SPNEXIT=1 Q ;queued from spnprtmt
|
---|
| 61 | Q
|
---|
| 62 | DATE ;
|
---|
| 63 | K %DT
|
---|
| 64 | S X1=DT,X2=-15 D C^%DTC S Y=X X ^DD("DD") S %DT("B")=$P(Y,"@",1)
|
---|
| 65 | S %DT("A")="Enter an Admission STARTING date: "
|
---|
| 66 | S %DT="AE"
|
---|
| 67 | D ^%DT I Y=-1 W !,"Option aborted!" S SPNEXIT=1 Q
|
---|
| 68 | S SPNSTRT=Y
|
---|
| 69 | ;ending date
|
---|
| 70 | S %DT("A")="Enter an Admission ENDING date: "
|
---|
| 71 | S %DT(0)=SPNSTRT
|
---|
| 72 | S X1=SPNSTRT,X2=15 D C^%DTC S Y=X X ^DD("DD") S %DT("B")=$P(Y,"@",1)
|
---|
| 73 | S %DT="AE"
|
---|
| 74 | D ^%DT I Y=-1 W !,"Option aborted!" S SPNEXIT=1 Q
|
---|
| 75 | S SPNEND=Y_.2359
|
---|
| 76 | Q
|
---|
| 77 | ZAP ;kill of vars and end the routine
|
---|
| 78 | K SPNPTF,SPNSTRT,SPNARY,SPNADDT,SPNX,SPNY,%,SPNEND,SPNSTRT,%DT,SPNRAN1,DIC,DIR,%,X,Y
|
---|
| 79 | K X1,X2,X,Y,SPNCNT,SPNZ,SPNTAB,SPNSSN,SPNREG,SPNRAN2,SPNAN1,SPNPA,SPNLVL,SPNIN,SPNDFN,SPNDATA,SPNANS,SPNAM,J,I
|
---|
| 80 | K ^UTILITY($J)
|
---|
| 81 | Q
|
---|
| 82 | ;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
---|
| 83 | BEG ;Start looping through the af xfr of the PTF file
|
---|
| 84 | JUMPIN K ^UTILITY($J)
|
---|
| 85 | S SPNADDT=SPNSTRT,SPNCNT=0
|
---|
| 86 | F S SPNADDT=$O(^DGPT("AF",SPNADDT)) Q:(SPNADDT="")!('+SPNADDT) Q:SPNADDT>SPNEND S SPNCNT=SPNCNT+1 D
|
---|
| 87 | .I $E(IOST,1)["C" I SPNCNT#10=0 W "."
|
---|
| 88 | .S SPNPTF="",SPNPTF=$O(^DGPT("AF",SPNADDT,SPNPTF)) Q:SPNPTF=""
|
---|
| 89 | .D TEST
|
---|
| 90 | .Q
|
---|
| 91 | D ^SPNICD2 D ZAP Q
|
---|
| 92 | Q
|
---|
| 93 | TEST ;test pt in 154 then icds
|
---|
| 94 | S SPNDFN=$P($G(^DGPT(SPNPTF,0)),U,1)
|
---|
| 95 | I SPNIN="JUST" Q:$D(^SPNL(154,SPNDFN,0))=0 ;NOT IN 154
|
---|
| 96 | S SPNDATA=$G(^DGPT(SPNPTF,70))
|
---|
| 97 | ;spnans=1 range spnasn=2 just the ones entered
|
---|
| 98 | S SPNX=0 S SPNX=$G(^DGPT(SPNPTF,70)) Q:SPNX=""
|
---|
| 99 | S SPNY=0 F A=10,16,17,18,19,20,21,22,23,24 S SPNY=$P(SPNDATA,U,A) I +SPNY D
|
---|
| 100 | .S SPNZ=$P(^ICD9(SPNY,0),U,1)
|
---|
| 101 | .I SPNANS=1 I (SPNZ>SPNRAN1) I (SPNZ<SPNRAN2) S ^UTILITY($J,SPNDFN,SPNPTF)=SPNDATA
|
---|
| 102 | .I SPNANS=2 I $D(SPNARY(SPNZ)) S ^UTILITY($J,SPNDFN,SPNPTF)=SPNDATA
|
---|
| 103 | .Q
|
---|
| 104 | Q
|
---|