source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOTEXP1.m@ 1005

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

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1PSOTEXP1 ;BIR/LE-Tally Missing Expiration Dates ;06/14/06
2 ;;7.0;OUTPATIENT PHARMACY;**250,268**;DEC 1997;Build 9
3 ;External references ^DPT supported by DBIA 10035
4 N NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
5 S NAMSP=$$NAMSP
6 S JOBN="TALLY MISSING EXPIRATION DATES"
7 S PATCH="PSO*7*250"
8 ;
9 L +^XTMP(NAMSP):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T D Q
10 . D BMES^XPDUTL(JOBN_" job is already running. Halting...")
11 . D MES^XPDUTL("")
12 . D QUIT
13 ;
14 I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,JOBN_", "_PATCH,90) ;90 day life
15 S QUIT=0
16 ;
17 I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D Q
18 . W !!,*7,"This job has been run before to completion on "
19 . W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
20 . W "If you want to run it again, the global subscript ^XTMP('PSOTEXP1') must be",!
21 . W "deleted prior to doing so.",!!
22 . D QUIT
23 ;
24 ;ques 2, if running from mumps prompt
25 I '$D(XPDQUES("POS2")) D I 'ZTDTH D QUIT Q
26 . K DIR
27 . S DIR("A")=" Enter when to Queue the "_JOBN_" job to run in date@time format "
28 . S DIR("B")="NOW"
29 . S DIR(0)="D^::%DT"
30 . S DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 021506@3:30p"
31 . D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
32 . S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
33 ;
34 ;ques 2, if running from kids install
35 I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
36 ;
37 D BMES^XPDUTL("=============================================================")
38 D MES^XPDUTL("Queuing background job for "_JOBN_"...")
39 D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
40 D MES^XPDUTL("==============================================================")
41 I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
42 ;
43 S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
44 ;
45 I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
46 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
47 E D
48 . S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
49 ;
50 S ZTRTN="EN^PSOTEXP1",ZTIO=""
51 S ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
52 S ZTSAVE("JOBN")=""
53 L -^XTMP(NAMSP)
54 D ^%ZTLOAD
55 D:$D(ZTSK)
56 . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
57 . D BMES^XPDUTL("")
58 D BMES^XPDUTL("")
59 K XPDQUES
60 Q
61QUIT ;
62 L -^XTMP(NAMSP)
63 Q
64EN ;
65 N PATCH,NAMSP S NAMSP=$$NAMSP,PATCH="PSO*7*250",JOBN="TALLY MISSING EXPIRATION DATES"
66 ;if can't get Lock, then already running.
67 L +^XTMP(NAMSP):3 I '$T D Q
68 . S:$D(ZTQUEUED) ZTREQ="@"
69 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
70 ;
71 N PSOSTART,Y,PSOS1,RXP,PSOV7,PSOARR,PSOISS,PSOEXP,PSOSTA,PSOACT,PSOINST,CC,RXE,DFN,PSODRUG,PSOINACT
72 ;
73 D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
74 I '$G(DT) S DT=$$DT^XLFDT
75 S RXP=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",4)
76 ;get date that PSO v7 was installed
77 S PSOV7=$S($P($G(^PS(59.7,1,49.99)),"^",7):$P(^PS(59.7,1,49.99),"^",7),1:$P($G(^PS(59.7,1,49.99)),"^",4))
78 S:PSOV7["." PSOV7=$P(PSOV7,".",1)
79 ;
80 ;^XTMP(NAMSP,INSTITUTION)=tot missing expiration dates on or before v7 install^tot missing expiration dates after v7 install^total missing expiration dates^tot past expiration date minus 1 day
81 ;
82 S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
83 S:'$G(PSOINST) PSOINST="9999999999"
84 S PSOACT=",0,1,2,3,4,5,10,16,",PSOINACT=",11,12,13,14,15,"
85 N STOP K ^XTMP(NAMSP,0,"STOP") S STOP=0 S:RXP="" RXP=0
86 F CC=1:1 S RXP=$O(^PSRX(RXP)) Q:'RXP!(RXP'?1N.NN) D Q:STOP
87 . I $D(^XTMP(NAMSP,0,"STOP")) D Q
88 . . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
89 . K PSOARR D GETS^DIQ(52,RXP_",",".01;2;6;1;20;26;100","I","PSOARR")
90 . S DFN=$G(PSOARR(52,RXP_",",2,"I")),PSODRUG=$G(PSOARR(52,RXP_",",6,"I")),PSOSTA=$G(PSOARR(52,RXP_",",100,"I"))
91 . S PSOISS=$G(PSOARR(52,RXP_",",1,"I"))
92 . ;--- eliminate bad Rx's
93 . Q:DFN=""!(PSODRUG="")
94 . Q:'$D(^DPT(DFN))!('$D(^PSDRUG(PSODRUG)))
95 . Q:$G(PSOISS)=""
96 . ;---
97 . S RXE=$G(PSOARR(52,RXP_",",".01","I")),PSOEXP=$G(PSOARR(52,RXP_",",26,"I"))
98 . ;save last date & fill info
99 . S $P(^XTMP(NAMSP,0,"LAST"),"^",3,5)=$G(PSOISS)_"^"_RXP
100 . D SET
101 G STP:STOP
102 S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
103 D MAIL
104STP ;
105 L -^XTMP(NAMSP)
106 I $D(^XTMP(NAMSP,0,"STOP")) S ^XTMP(NAMSP,0,"ZAUDIT",$H)="STOPPED ON"_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
107 S:$D(ZTQUEUED) ZTREQ="@"
108 K JOBN
109 ;I '$D(^XTMP(NAMSP,0,"STOP")) K ^XTMP(NAMSP)
110 Q
111 ;
112SET ;Data collected and stored:
113 ; Piece 1 - Pre-install v7 active Rx's with null expiration date
114 ; Piece 2 - Pre-install v7 inactive Rx's with null expiration date
115 ; Piece 3 - Post-install v7 active Rx's with null expiration
116 ; Piece 4 - Post-install v7 inactive Rx's with null expiration
117 ; Piece 5 - total Rx's with null expiration date
118 ; Piece 6 - total active Rx's with expire date of t-1 day
119 ;
120 I PSOEXP="" D Q
121 . I PSOISS'>PSOV7 D
122 . . S:PSOACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",1)=$P($G(^XTMP(NAMSP,PSOINST)),"^",1)+1
123 . . S:PSOINACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",2)=$P($G(^XTMP(NAMSP,PSOINST)),"^",2)+1
124 . I PSOISS>PSOV7 D
125 . . S:PSOACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",3)=$P($G(^XTMP(NAMSP,PSOINST)),"^",3)+1
126 . . S:PSOINACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",4)=$P($G(^XTMP(NAMSP,PSOINST)),"^",4)+1
127 . S $P(^XTMP(NAMSP,PSOINST),"^",5)=$P($G(^XTMP(NAMSP,PSOINST)),"^",5)+1
128 .;S ^XTMP("PSOTEXP1","MISS",RXP)=PSOINST_"^"_PSOISS_"^"_PSOV7_"^"_PSOEXP_"^"_$S($G(PSOSTA)'="":PSOSTA,1:"*")_"^"_$P($G(^PSRX(RXP,0)),"^")
129 ; normal daily job expires all rx's with yesterday's date, so looking for anything before yesterday.
130 I (PSOEXP<(DT-1))&(PSOACT[(","_PSOSTA_",")) S $P(^XTMP(NAMSP,PSOINST),"^",6)=$P($G(^XTMP(NAMSP,PSOINST)),"^",6)+1
131 ;.S ^XTMP("PSOTEXP1","PAST",$S($G(PSOSTA)'="":PSOSTA,1:"*"),PSOEXP,RXP)=PSOINST_"^"_PSOISS_"^"_PSOV7_"^"_PSOEXP_"^"_PSOSTA_"^"_$P($G(^PSRX(RXP,0)),"^")
132 Q
133 ;
134STATUS ;show status of job running
135 I $$ST D
136 . W !,"Currently processing:"
137 . I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
138 . . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
139 . W !?5,"Date being processed > ",$$FMTE^XLFDT($P(^XTMP($$NAMSP,0,"LAST"),"^",3))
140 . W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
141 . ;W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
142 E D
143 .I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
144 .. W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
145 Q
146 ;
147STOP ;stop job command
148 I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
149 . W !,"TALLY MISSING EXPIRATION DATES Job - set to STOP Soon"
150 . W !!,"Check Status to be sure it has stopped and is not running..."
151 . W !," (D STATUS^PSOTEXP1)"
152 Q
153ST() ;status
154 L +^XTMP($$NAMSP):3 I $T D Q 0
155 . L -^XTMP($$NAMSP)
156 . W !,"*** NOT CURRENTLY RUNNING! ***",!
157 Q 1
158INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
159 N BEGDT,PURGDT
160 S BEGDT=$$NOW^XLFDT()
161 S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
162 S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
163 Q
164NAMSP() ;
165 Q $T(+0)
166 ;
167MAIL ;
168 N PSOEND,PSOEND2,PSOTEXT,XMY,LIN,DATA,J,L,PSOINST,M,LEN
169 S LIN="",$P(LIN," ",80)="",LEN=80
170 D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
171 S PSOEND2=$$FMTE^XLFDT(%,"1PS")
172 I $G(DUZ) S XMY(DUZ)=""
173 S XMDUZ=PATCH_" "_JOBN
174 S XMSUB="Outpatient Pharmacy "_PATCH_" "_JOBN
175 S XMY("ELLZEY.LINDA@FORUM.VA.GOV")=""
176 S XMY("WHITE.ELAINE@FORUM.VA.GOV")=""
177 S XMY("WILLIAMSON.ERIC@FORUM.VA.GOV")=""
178 I $O(XMY(""))="" Q ; no recipients for mail message
179 S PSOTEXT(1)="The "_JOBN_" job for the Outpatient Pharmacy"
180 S PSOTEXT(2)="patch ("_PATCH_") started "_PSOSTART
181 S PSOTEXT(3)="and completed "_PSOEND_"."
182 S PSOTEXT(4)=" "
183 S PSOTEXT(5)="Excel comma delimited data below, five headings, one data line"
184 S PSOTEXT(6)="Note that an institution of 999999999 denotes one was not found during run."
185 S PSOTEXT(7)=",,,,,,Total Active Rx's"
186 S PSOTEXT(8)=",Before v7 Install,Before v7 Install,After v7 Install,After v7 Install,,With"
187 S PSOTEXT(9)=",Tot Active Rx's,Tot Inactive,Tot Active,Tot Inactive,Total Rx's,Expiration"
188 S PSOTEXT(10)=",Missing Expired,Rx's Missing,Rx's Missing,Rx's Missing,Missing,Date of T-1"
189 S PSOTEXT(11)="Institution,Date,Expired Date,Expired Date,Expired Date,Expired Date,Day"
190 S PSOINST=0,L=12
191 F S PSOINST=$O(^XTMP(NAMSP,PSOINST)) Q:PSOINST=""!(PSOINST'?1N.NN) D
192 . S DATA=^XTMP(NAMSP,PSOINST),DATA=$TR(DATA,"^",",")
193 . S PSOTEXT(L)=$E((PSOINST_","_DATA_LIN),1,LEN),L=L+1
194 S L=L+1,PSOTEXT(L)=" "
195 ;
196 S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
197 Q
Note: See TracBrowser for help on using the repository browser.