source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNICD1.m@ 1076

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1SPNICD1 ;SAN/WDE/Report of PT's with particular ICD9's
2 ;;2.0;Spinal Cord Dysfunction;**14**;01/02/1997
3EN ;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 ;-----------------------------------------------------------------
15ASK ;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 ;-----------------------------------------------------------------
23REG 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 ;------------------------------------------------------------------
32RANGE ;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 ;------------------------------------------------------------------
44SINGLE ;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 ;------------------------------------------------------------------
55DEV ;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
59TASK ;
60 I SPNIO="Q" D ZAP S SPNEXIT=1 Q ;queued from spnprtmt
61 Q
62DATE ;
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
77ZAP ;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 ;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
83BEG ;Start looping through the af xfr of the PTF file
84JUMPIN 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
93TEST ;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
Note: See TracBrowser for help on using the repository browser.