source: FOIAVistA/tag/r/CONTROLLED_SUBSTANCES-PSD/PSDNMWE.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1PSDNMWE ;DOIFO/CMS - CSM No Visits within 12 Months ;18 Dec 02
2 ;;3.0; CONTROLLED SUBSTANCES;**41,42**;13 Feb 97
3 ;Reference to ^DPT( supported by IA #10035
4 ;Reference to ^PSDRUG( supported by IA #2621
5 ;Reference to ^PSRX( supported by IA #1977
6 Q
7 ;
8ST ;CS Monitoring OPTION ENTRY
9 N PSDODIV,PSDCII,PSDDTN,PSDED,PSDISA,PSDISB,PSDOUT,PSDSD,X,Y,%,%ZIS
10 N DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,ZTIO,ZTSAVE,ZTSK,ZTRTN,ZTDESC
11 W !!,?5,"This report lists released RXs without a visit within 12 months of the"
12 W !,?5,"RX Release date. Excluding RXs released on the same day as a discharge"
13 W !,?5,"and within a user defined discharge date range.",!!
14 W ! D DIV^PSDNMU I '$O(PSDODIV(0))!($G(PSDOUT)) G END
15 S PSDDTN="RX Release" D DATE^PSDNMU I '$G(PSDSD)!($G(PSDOUT)) G END
16 W ! D DISD^PSDNMU I $G(PSDOUT) G END
17 W ! S DIR("A")="Screen for controlled substance RXs"
18 S DIR("B")="Yes",DIR(0)="Y" D ^DIR K DIR I X="^"!($D(DTOUT)) G END
19 I Y=1 W ! D CII^PSDNMU I '+$G(PSDCII)!($G(PSDOUT)) G END
20 I Y'=1 S PSDCII=""
21 ;
22 W ! S DIR("A")="Okay to Continue",DIR("B")="No",DIR(0)="Y" D ^DIR
23 I Y'=1 W " <No report>",! G END
24 W !!,?9,"This report should be queued to run during non-peak hours.",!
25 K IO("Q") S %ZIS="MQ" D ^%ZIS I POP W " <No device selected.>" G END
26 I $D(IO("Q")) D
27 .S ZTRTN="DQ^PSDNMWE",ZTDESC="CS Monitoring - PSDNMWE"
28 .S ZTSAVE("PSDSD")="",ZTSAVE("PSDODIV(")="",ZTSAVE("PSDCII")="",ZTSAVE("PSDED")="",ZTSAVE("PSDISA")="",ZTSAVE("PSDISB")=""
29 .D ^%ZTLOAD W !!?5,"TASK #",$G(ZTSK)," QUEUED!",!
30 I '$D(IO("Q")) U IO D DQ
31 K IOP,IO("Q")
32END Q
33 ;
34HD ;Report heading
35 N PSDD,PSDL,X,Y,%
36 W @IOF,$$CJ^XLFSTR("CS Monitoring - No Visits within 12 months of RX Release Report",IOM)
37 S PSDL="Outpatient Division(s): "
38 S PSDD=0
39 F S PSDD=$O(PSDODIV(PSDD)) Q:'PSDD S PSDL=PSDL_$P($G(PSDODIV(PSDD)),U,2) I $O(PSDODIV(PSDD)) S PSDL=PSDL_", "
40 W !,$$CJ^XLFSTR(PSDL,IOM)
41 W !,$$CJ^XLFSTR("Prescriptions released: "_$P(PSDSD,U,2)_" thru "_$P(PSDED,U,2),IOM)
42 I $G(PSDISA)!($G(PSDISB)) D
43 . S PSDL="Exclude RXs released: "
44 . I $G(PSDISB) S PSDL=PSDL_+PSDISB_" day(s) before "
45 . I $G(PSDISA) S PSDL=PSDL_+PSDISA_" day(s) after "
46 . S PSDL=PSDL_"a discharge date"
47 . W !,$$CJ^XLFSTR(PSDL,IOM)
48 S PSDL="Controlled Substance schedule(s): "
49 F PSDD=1:1:4 I $P(PSDCII,",",PSDD) S PSDL=PSDL_$P(PSDCII,",",PSDD) I $P(PSDCII,",",(PSDD+1)) S PSDL=PSDL_", "
50 I +PSDCII W !,$$CJ^XLFSTR(PSDL,IOM)
51 W !,"Division: ",$E($G(PSDIV),1,13),?25,"Report Run Date: "
52 S PSDPG=PSDPG+1
53 D NOW^%DTC W $$FMTE^XLFDT(%),?70,"PAGE: ",PSDPG
54 W !,$$REPEAT^XLFSTR("=",IOM)
55 QUIT
56 ;
57DQ ;Report Run
58 N D0,DA,DFN,DIC,DIQ,DR
59 N PSDA,PSDD,PSDFD,PSDI,PSDIDT,PSDIV,PSDO,PSDOUT,PSDP,PSDPG,PSDS,PSDRG
60 N PSDUZ,PSDY,PSDX,PSDX0,PSDX2,PSDXOR1,PSDY,X,X1,X2,Y,%,%DT
61 K ^TMP("PSDNMWE",$J)
62 I IOST?1"C-".E W !!,?10,"Compiling report, please wait ..."
63 S PSDFD=+PSDSD
64 F S PSDFD=$O(^PSRX("AL",PSDFD)) Q:('PSDFD)!(PSDFD]+PSDED) D
65 . S PSDX=0
66 . F S PSDX=$O(^PSRX("AL",PSDFD,PSDX)) Q:'PSDX D
67 . . D KVA^VADPT
68 . . S PSDX0=$G(^PSRX(PSDX,0)) I PSDX0']"" Q
69 . . S PSDX2=$G(^PSRX(PSDX,2))
70 . . I '$D(PSDODIV(+$P(PSDX2,U,9))) Q
71 . . S PSDRG=$G(^PSDRUG(+$P(PSDX0,U,6),0))
72 . . I +$G(PSDCII) S PSDP=0 D I 'PSDP Q
73 . . . F PSDY=1:1:4 S PSDA=$P(PSDCII,",",PSDY) I PSDA,$P(PSDRG,U,3)[PSDA S PSDP=1 Q
74 . . I +$G(PSDCII),'PSDP Q
75 . . ;Check Discharge Date
76 . . S DFN=+$P(PSDX0,U,2) D DEM^VADPT
77 . . S VAIP("D")=+$P(PSDFD,".",1),PSDP=0
78 . . I $D(^TMP("PSDNMWE",$J,1,DFN,VAIP("D"))) Q
79 . . D IN5^VADPT D I $G(PSDP) Q
80 . . . I +$G(VAIP(17,2))[VAIP("D") S ^TMP("PSDNMWE",$J,1,DFN,VAIP("D"))="" S PSDP=1 Q
81 . . . I +$G(VAIP(17,2)),$G(PSDISA) D I $G(PSDP) Q
82 . . . . S X1=+$G(VAIP(17,2)),X2=+PSDISA D C^%DTC S PSDD=X
83 . . . . I VAIP("D")'>PSDD S PSDP=1 Q
84 . . . I +$G(VAIP(17,2)),$G(PSDISB) D I $G(PSDP) Q
85 . . . . S X1=+$G(VAIP(17,2)),X2=-PSDISB D C^%DTC S PSDD=X
86 . . . . I VAIP("D")'<PSDD S PSDP=1 Q
87 . . ;
88 . . ;Check Visits within 12 months
89 . . S PSDD="",X1=+PSDFD,X2=-365 D C^%DTC S PSDY=X
90 . . K VASD S VASD("W")=1,VASD("F")=PSDY,VASD("T")=PSDFD
91 . . D SDA^VADPT
92 . . S PSDY=0
93 . . F S PSDY=$O(^UTILITY("VASD",$J,PSDY)) Q:'PSDY D
94 . . . S PSDI=$G(^UTILITY("VASD",$J,PSDY,"I"))
95 . . . I $P(PSDI,U,3)="" K PSDP Q
96 . . . S PSDP=1
97 . . I $G(PSDP)=1!('$O(^UTILITY("VASD",$J,0))) D
98 . . . I +$G(VADM(6)),+$G(VADM(6))']VAIP("D") S PSDD=$P($G(VADM(6)),U,2)
99 . . . S Y=+PSDFD D D^DIQ S PSDA=Y
100 . . . S PSDUZ=$P($G(^DPT(DFN,0)),U,1)_" ("_$E(VA("PID"),5,12)_")"
101 . . . S DIC="^PSRX(",DA=PSDX,DR="3;20",DIQ(0)="E",DIQ="PSDO"
102 . . . K PSDO D EN^DIQ1
103 . . . S ^TMP("PSDNMWE",$J,$S($G(PSDO(52,PSDX,20,"E"))]"":$G(PSDO(52,PSDX,20,"E")),1:"UNKNOWN"),$S($G(PSDO(52,PSDX,3,"E"))]"":$G(PSDO(52,PSDX,3,"E")),1:"UNKNOWN"),PSDUZ,PSDX)=$P(PSDX0,U,1)_U_PSDA_U_$P(PSDRG,U,1)_U_$G(PSDD)
104 D KVA^VADPT
105 ;
106PRT ;Report print
107 S PSDPG=0,PSDOUT=0
108 I '$D(^TMP("PSDNMWE",$J)) D G DQQ
109 . S PSDIV="",PSDPG=0 D HD,PHD
110 . W !!,?10,"<<<< NO DATA FOUND >>>>",!
111 S PSDIV=""
112 F S PSDIV=$O(^TMP("PSDNMWE",$J,PSDIV)) Q:(PSDIV="")!(PSDOUT) D
113 . S PSDPG=0 D HD,PHD
114 . S PSDS=""
115 . F S PSDS=$O(^TMP("PSDNMWE",$J,PSDIV,PSDS)) Q:(PSDS="")!(PSDOUT) D
116 . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
117 . . W !!,?12,"RX PATIENT STATUS: ",PSDS
118 . . S PSDRG=""
119 . . F S PSDRG=$O(^TMP("PSDNMWE",$J,PSDIV,PSDS,PSDRG)) Q:(PSDRG="")!(PSDOUT) D
120 . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
121 . . . W !!,"PATIENT NAME: ",PSDRG
122 . . . S PSDX=0
123 . . . F S PSDX=$O(^TMP("PSDNMWE",$J,PSDIV,PSDS,PSDRG,PSDX)) Q:('PSDX)!(PSDOUT) D
124 . . . . S PSDY=$G(^TMP("PSDNMWE",$J,PSDIV,PSDS,PSDRG,PSDX))
125 . . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
126 . . . . W !,$P(PSDY,U,1),?12,$P(PSDY,U,2),?40,$P(PSDY,U,3)
127 . . . . I $P(PSDY,U,4)]"" W !,?12,"*Date of Death "_$P(PSDY,U,4)_" before RX Release Date!"
128 . I '$G(PSDOUT),$O(^TMP("PSDNMWE",$J,PSDIV))]"" D PAGE
129 ;
130DQQ W ! K PSDCII,PSDODIV,PSDSD,PSDED,PSDISA,PSDISB,^TMP("PSDNMWE",$J) D ^%ZISC Q
131 ;
132PHD ;
133 W !,"RX#",?12,"Release Date",?40,"Drug"
134 W !,$$REPEAT^XLFSTR("_",IOM)
135 Q
136PAGE ;
137 N DIR,DIRUT,DTOUT,DUOUT,X,Y
138 I IOST?1"C-".E S DIR(0)="E" D ^DIR W !
139 I ($D(DTOUT))!($D(DIRUT)) S PSDOUT=1 Q:$G(PSDOUT)=1
140 Q
141 ;
142EOR ;PSDNMWE - CSM No Visits in 12 Months; 18 DEC 02
Note: See TracBrowser for help on using the repository browser.