source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCPBK1.m@ 846

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

initial load of WorldVistAEHR
File size: 9.5 KB
Line 
1PSOCPBK1 ;BIR/EJW,GN-Tally unbilled Automated-release refill copays ;8/10/05 12:50pm
2 ;;7.0;OUTPATIENT PHARMACY;**215**;DEC 1997
3 ;External reference to ^XUSEC supported by DBIA 10076
4 ;External reference to IBARX supported by DBIA 125
5 ;External reference to $$PROD^XUPROD(1) supported by DBIA 4440
6 ;
7 N DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC
8 I '$D(XPDQUES("POS1")) D Q:'ZTDTH
9 .K DIR
10 .S DIR("A")="Enter when to Queue the Tally job to run in date@time format "
11 .S DIR("B")="NOW"
12 .S DIR(0)="D^::%DT"
13 .S DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 081505@3:30p"
14 .D ^DIR I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S ZTDTH="" Q
15 .S ZTDTH=$$FMTH^XLFDT(Y)
16 ;
17 I $D(XPDQUES("POS1")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS1"))
18 ;
19 D BMES^XPDUTL("===================================================")
20 D MES^XPDUTL("Queuing background job to tally unbilled refills...")
21 D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
22 D MES^XPDUTL("===================================================")
23 L +^XTMP($$NAMSP):0 I '$T D Q
24 . I ZTDTH="" D BMES^XPDUTL("Tally job is already running. Halting...")
25 L -^XTMP($$NAMSP)
26 S ZTRTN="EN^PSOCPBK1",ZTIO=""
27 S ZTDESC="Background job to tally unbilled copays for refills via OPAI"
28 D ^%ZTLOAD
29 D:$D(ZTSK)
30 .D BMES^XPDUTL("=========================")
31 .D MES^XPDUTL("Task #"_ZTSK_" Queued!")
32 .D MES^XPDUTL("=========================")
33 .D BMES^XPDUTL("")
34 D BMES^XPDUTL("")
35 K XPDQUES
36 Q
37EN ;
38 N NAMSP S NAMSP=$$NAMSP
39 ;if can't get Lock, then already running.
40 L +^XTMP(NAMSP):3 I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
41 ;if got a lock then must be fresh start, kill possible old Xtmp
42 K ^XTMP(NAMSP)
43 N PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOSTART,PSOEND,PSOVETS,PSOTRX,XIEN
44 N PSOSCMX,PSODFN,PSOREL,PSOAMT,FOUND,V24,PSOTRF,PSOEND2,PSOSTRT2,QQ
45 N PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,LIN,%,X1,XMY,STOP
46 D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
47 S PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
48 I '$G(DT) S DT=$$DT^XLFDT
49 I '$D(^XTMP(NAMSP)) S X1=DT D C^%DTC S ^XTMP(NAMSP,0)=$G(X)_"^"_DT_"^Tally of unbilled copays for refills via OPAI, PSO*7*215"
50 ;
51 ;get 1st occurence of install date of patch PSO*7*156 (OPAI)
52 S XIEN=+$O(^XPD(9.7,"B","PSO*7.0*156",0))
53 S PSODT=+$P($G(^XPD(9.7,XIEN,1)),"^",3)
54 I 'PSODT S ^XTMP(NAMSP,0,.1)="OPAI PATCH PSO*7*156 IS NOT INSTALLED" D MAIL3^PSOCPBK2(^XTMP(NAMSP,0,.1)) Q
55 ;
56 ;check if any division is on v2.4 (OPAI interface)
57 S V24=0
58 F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX D Q:V24
59 . S:+$G(^PS(59,XX,"DISP"))=2.4 V24=1
60 I 'V24 D Q
61 . S ^XTMP(NAMSP,0,.2)="OPAI IS INSTALLED BUT IS NOT TURNED ON"
62 . D MAIL3^PSOCPBK2(^XTMP(NAMSP,0,.2))
63 ;
64 S (PSOTRX,PSOTRF)=1
65 K ^XTMP(NAMSP,0,"STOP") S STOP=0 ;init stop flag to 0
66 F QQ=1:1 S PSODT=$O(^PSRX("AL",PSODT)) Q:'PSODT D Q:STOP
67 .I QQ#100=0,$D(^XTMP(NAMSP,0,"STOP")) K ^XTMP(NAMSP) S STOP=1 Q
68 .S RXP=""
69 .F PSOTRX=PSOTRX+1:1 S RXP=$O(^PSRX("AL",PSODT,RXP)) Q:'RXP D
70 ..;save last date & fill info
71 ..S ^XTMP(NAMSP,0,"LAST")=PSODT_"^"_RXP_"^"_PSOTRX
72 ..S PSODFN=$P($G(^PSRX(RXP,0)),"^",2)
73 ..Q:('PSODFN)!('$D(^DPT(PSODFN,0))) ;quit, no valid DFN info
74 ..D XTYPE
75 ..Q:+PSOSCMX=0 ;quit, Exempt or deceased
76 ..;search refills only, ignore 0=orig fill
77 ..F YY=0:0 S YY=$O(^PSRX("AL",PSODT,RXP,YY)) Q:'YY D ADDBILL
78 Q:STOP
79 ;
80 S PSOCNT=0
81 D TALLY^PSOCPBK2 Q:STOP
82 D TOTAL
83 D MAIL
84 D MAIL2
85 L -^XTMP(NAMSP)
86 S:$D(ZTQUEUED) ZTREQ="@"
87 Q
88 ;
89ADDBILL ;add to billable ^XTMP if ok, quit if not
90 S PSOTRF=PSOTRF+1
91 S PSOREL=$P($G(^PSRX(RXP,1,YY,0)),"^",18)
92 Q:'PSOREL ;not released
93 Q:'YY ;orig fill
94 Q:+$$RXST^IBARXEU(PSODFN,$P(PSOREL,".")) ;Exempt on Rel dte
95 ;check refill
96 Q:$P($G(^PSRX(RXP,1,YY,"IB")),"^",1)'="" ;already billed
97 Q:$P($G(^PSRX(RXP,1,YY,"IB")),"^",2)'="" ;exceeded ann. cap
98 ;
99 ;look for Activity log entry per refill # with the below text
100 S FOUND=0
101 F XX=999:0 S XX=$O(^PSRX(RXP,"A",XX),-1) Q:'XX D Q:FOUND
102 .Q:$P(^PSRX(RXP,"A",XX,0),"^",4)'=YY
103 .Q:^PSRX(RXP,"A",XX,0)'["External Interface Dispensing is Complete"
104 .S FOUND=1
105 Q:'FOUND
106 ;
107 S ^XTMP(NAMSP,PSODFN,RXP,YY)=$P(PSOREL,".") ;add to XTMP to be bill
108 Q
109 ;
110MAIL ;
111 N TOTAMT,PSOCXPDA
112 D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
113 S PSOEND2=$$FMTE^XLFDT(%,"1PS")
114 I $G(DUZ) S XMY(DUZ)=""
115 S XMDUZ="Outpatient Pharmacy",XMSUB="Outpatient Pharmacy Copay Tally"
116 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
117 I $O(XMY(""))="" Q ; no recipients for mail message
118 S PSOTEXT(1)="The Rx copay tally job for the Outpatient Pharmacy patch (PSO*7*215)"
119 S PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
120 I PSOCNT=0 S PSOTEXT(3)="No released unbilled copay fills were found."
121 I PSOCNT>0 D
122 .S TOTAMT=0
123 .F XX="YR2004","YR2005" D
124 ..F YY=1:1:3 S PSOAMT(XX,YY)=PSOCNT(XX,YY)*YY*7,TOTAMT=TOTAMT+PSOAMT(XX,YY)
125 .S PSOTEXT(3)="Auto-Released refills have now been marked as potentials for back billing."
126 .S PSOTEXT(4)="There were "_$FN(PSOCNT,",")_" fills successfully tallied for "_$FN(PSOVETS,",")_" veterans."
127 .S PSOTEXT(5)=" "
128 .S PSOTEXT(6)="Fills eligible for back-billing by year:"
129 .S PSOTEXT(7)="2004 30-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2004",1),6)
130 .S PSOTEXT(7)=PSOTEXT(7)_" $"_$J($FN(PSOAMT("YR2004",1),","),9)
131 .S PSOTEXT(8)="2004 60-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2004",2),6)
132 .S PSOTEXT(8)=PSOTEXT(8)_" $"_$J($FN(PSOAMT("YR2004",2),","),9)
133 .S PSOTEXT(9)="2004 90-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2004",3),6)
134 .S PSOTEXT(9)=PSOTEXT(9)_" $"_$J($FN(PSOAMT("YR2004",3),","),9)
135 .S PSOTEXT(10)=""
136 .S PSOTEXT(11)="2005 30-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2005",1),6)
137 .S PSOTEXT(11)=PSOTEXT(11)_" $"_$J($FN(PSOAMT("YR2005",1),","),9)
138 .S PSOTEXT(12)="2005 60-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2005",2),6)
139 .S PSOTEXT(12)=PSOTEXT(12)_" $"_$J($FN(PSOAMT("YR2005",2),","),9)
140 .S PSOTEXT(13)="2005 90-DAY EQUIVALENT FILLS: "_$J(PSOCNT("YR2005",3),6)
141 .S PSOTEXT(13)=PSOTEXT(13)_" $"_$J($FN(PSOAMT("YR2005",3),","),9)
142 .S PSOTEXT(14)=" =========="
143 .S PSOTEXT(15)=" TOTAL $"_$J($FN(TOTAMT,","),9)
144 .S PSOTEXT(16)=" "
145 .S PSOTEXT(17)="To get a report of patients/prescriptions that were identified as potentially"
146 .S PSOTEXT(18)="billable as part of this Tally, enter D RPT^PSOCPBK2 at the programmer's prompt"
147 S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
148 Q
149 ;
150MAIL2 ;
151 S LIN="",$P(LIN," ",80)=""
152 D NOW^%DTC S PSOTIME=$$FMDIFF^XLFDT(%,$G(PSOS1),2)
153 S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
154 S PSOSTNM=$P($G(^DIC(4,PSOINST,0)),"^")
155 K PSOTEXT
156 S XMY(DUZ)="",PSOTC=0,PSOCNTS=""
157 F J="YR2004","YR2005" F I=1:1:3 D
158 .S PSOTC=PSOTC+PSOCNT(J,I)
159 .S PSOCNTS=PSOCNTS_","_PSOCNT(J,I)
160 S XMY("NAPOLIELLO.GREG@FORUM.VA.GOV")=""
161 S XMY("WHITE.ELAINE@FORUM.VA.GOV")=""
162 S:$$PROD^XUPROD(1) XMY("WILLIAMSON.ERIC@FORUM.VA.GOV")=""
163 S XMDUZ="PSO*7*215 TALLY"
164 S XMSUB="STATION "_$G(PSOINST)
165 S XMSUB=XMSUB_$S($$PROD^XUPROD(1):"(Prod)",1:"(Test)")
166 S XMSUB=XMSUB_" UNBILLED COPAYS FOR PRESCRIPTION REFILLS"
167 S PSOTEXT(1)=" Start time: "_PSOSTRT2
168 S PSOTEXT(2)=" Completed time: "_PSOEND2
169 S PSOTEXT(3)=" Elapsed Time: "_$$ETIME^PSOCPBK2(PSOTIME)
170 S PSOTEXT(4)=""
171 S PSOTEXT(5)=" Total RX's processed: "_$J($FN(PSOTRX,","),8)
172 S PSOTEXT(6)=" Total Refills processed: "_$J($FN(PSOTRF,","),8)
173 S PSOTEXT(7)=" Total billable refills: "_$J($FN(PSOTC,","),8)
174 S PSOTEXT(8)=" Total billable vets: "_$J($FN(PSOVETS,","),8)
175 S PSOTEXT(9)=""
176 S PSOTEXT(10)="Excel comma delimited data below, Two heading, one data line"
177 S PSOTEXT(11)=""
178 S PSOTEXT(12)="Copy and paste any of the 2 heading & 1 data rows into Excel. Then click "
179 S PSOTEXT(13)="'Data', 'Text to Columns..', check 'Delimited', click Next, check 'Comma',"
180 S PSOTEXT(14)="and click Finish"
181 S PSOTEXT(15)=""
182 S PSOTEXT(16)=$E(("Station,Station,,2004,,,2005"_LIN),1,79)
183 S PSOTEXT(17)=$E(("Name,#,30 days,60 days,90 days,30 days,60 days,90 days"_LIN),1,79)
184 S PSOTEXT(18)=$E((PSOSTNM_","_PSOINST_PSOCNTS_LIN),1,79)
185 S PSOTEXT(19)=""
186 S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
187 Q
188 ;
189XTYPE ;
190 N Y,VADM,I,J,X,SAVY,DFN
191 S DFN=PSODFN D DEM^VADPT I +$G(VADM(6)) S PSOSCMX="" Q ; DECEASED
192 S (X,PSOSCMX,SAVY)=""
193 S J=0 F S J=$O(^PS(59,J)) Q:'J I +$G(^(J,"IB")) S X=+^("IB") Q
194 I 'X Q
195 S X=X_"^"_PSODFN D XTYPE^IBARX
196 I $G(Y)'=1 Q
197 S J="" F S J=$O(Y(J)) Q:'J S I="" F S SAVY=I,I=$O(Y(J,I)) Q:I="" S:I>0 PSOSCMX=I
198 I PSOSCMX="",SAVY=0 Q ; INCOME EXEMPT OR SERVICE-CONNECTED
199 I PSOSCMX=2 Q ; NEED TO ASK SC QUESTION
200 Q
201 ;
202TOTAL ;
203 N COUNT,COUNTED
204 I '$D(PSOVETS) S PSOVETS=0
205 N I,J
206 F I=1:1:3 S (PSOCNT("YR2004",I),PSOCNT("YR2005",I))=0
207 S PSODFN=0 F S PSODFN=$O(^XTMP(NAMSP,PSODFN)) Q:'PSODFN D
208 .S COUNTED=0
209 .F J="YR2004","YR2005" F I=1:1:3 S COUNT=$G(^XTMP(NAMSP,PSODFN,J,I)) I COUNT>0 S:'$G(COUNTED) COUNTED=1,PSOVETS=PSOVETS+1 S PSOCNT(J,I)=PSOCNT(J,I)+COUNT
210 F I=1:1:3 S PSOCNT=PSOCNT+PSOCNT("YR2004",I)+PSOCNT("YR2005",I)
211 Q
212 ;
213STATUS ;show status of job running
214 I $$ST D
215 .W !,"Currently processing:"
216 .W !?5,"Released Date > ",+^XTMP($$NAMSP,0,"LAST")
217 .W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",2)
218 .W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",3),!
219 Q
220 ;
221STOP ;stop job command
222 I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
223 .W !,"Outpatient RX Copay Tally Job - set to STOP Soon"
224 .W !!,"Check Status to be sure it has stopped and is not running..."
225 .W !," (D STATUS^PSOCPBK1)"
226 Q
227ST() ;status
228 L +^XTMP($$NAMSP):3 I $T D Q 0
229 .L -^XTMP($$NAMSP)
230 .W !,"*** TALLY NOT CURRENTLY RUNNING! ***",!
231 Q 1
232NAMSP() ;
233 Q $T(+0)
Note: See TracBrowser for help on using the repository browser.