source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOTPPOS.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: 9.5 KB
Line 
1PSOTPPOS ;BIR/RTR-Patch 145 Post Install routine ;07/27/03
2 ;;7.0;OUTPATIENT PHARMACY;**145**;DEC 1997
3 ;Reference to SDPHARM supported by DBIA 4193
4 ;Reference to SDPBE supported by DBIA 4194
5 ;Reference to DIC(19 supported by DBIA 2246
6 ;Reference to DIC(4 supported by DBIA 2251
7 ;
8 G FILE
9 N PSOTPLLZ,PSOTPFLG
10 S PSOTPFLG=0
11 S PSOTPLLZ="" F S PSOTPLLZ=$O(^PS(53,"B","NON-VA",PSOTPLLZ)) Q:PSOTPLLZ="" D
12 .I $P($G(^PS(53,PSOTPLLZ,0)),"^")="NON-VA" S $P(^(0),"^",6)=5,PSOTPFLG=PSOTPFLG+1
13 I '$G(PSOTPFLG) D BMES^XPDUTL("Could not find a NON-VA entry in the RX PATIENT STATUS file.") D MES^XPDUTL("Please contact National Vista Support!")
14 I $G(PSOTPFLG)>1 D BMES^XPDUTL("Found multiple entries of NON-VA in the RX PATIENT STATUS file.") D MES^XPDUTL("Please contact National Vista Support!")
15 ;
16FILE ;Populate TPB file
17 ;N VARIABLE
18 ;S ZTDTH=""
19 ;I $D(ZTQUEUED) S ZTDTH=$H
20 L +^XTMP("SDPSO145"):0 I '$T D Q
21 .D BMES^XPDUTL("Post-Init for patch PSO*7*145 is already running. Halting..")
22 ;I ZTDTH="" D
23 ;.D BMES^XPDUTL("Auto-Populate TPB ELIGIBILITY (#52.91) File.")
24 ;.D BMES^XPDUTL("If no start date/time is entered when prompted, the background job will ")
25 ;.D MES^XPDUTL("be queued to run NOW.")
26 ;.D GETDATE
27 ;.D BMES^XPDUTL("Queuing background job to populate TPB ELIGIBILITY (#52.91) File.")
28 ;S ZTDTH=@XPDGREF@("PSOPINIT")
29 I '$G(^XTMP("SDPSO145","PSOTINIT")) D BMES^XPDUTL("Install aborted, cannot determine post-install task time..") Q
30 S ZTDTH=$G(^XTMP("SDPSO145","PSOTINIT")) L -^XTMP("SDPSO145")
31 S ZTRTN="START^PSOTPPOS",ZTIO="",ZTDESC="Populate TPB ELIGIBILITY FILE" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
32 I $D(ZTSK)&('$D(ZTQUEUED)) D BMES^XPDUTL("Task Queued!")
33 Q
34START ;Build TPC Eligibility file
35 I '$G(DT) S DT=$$DT^XLFDT
36 S U="^"
37 N PSOACTRX,PSOENRLD,PSOLPQT,PSONODAD,PSOTG1,PSOTG2,PSOTG3,PSOETOT,PSOITOT,PSOTLOCK,PSOTPSNM,PSOSTATI
38 S (PSOETOT,PSOITOT)=0
39 S PSOTLOCK=0
40 L +^XTMP("SDPSO145"):0 I '$T S PSOTLOCK=1 D MAIL S:$D(ZTQUEUED) ZTREQ="@" Q
41 K ^XTMP("SDPSO145")
42 S X1=DT,X2=+60 D C^%DTC S ^XTMP("SDPSO145",0)=$G(X)_"^"_DT K X1,X2
43 D NOW^%DTC S Y=% D DD^%DT S ^XTMP("SDPSO145","START")=$G(Y)
44 D ^SDPHARM
45 D ^SDPBE
46 I '$D(^XTMP("SDPSO145","PAT")) G PASS
47 S PSOTG1="" F S PSOTG1=$O(^XTMP("SDPSO145","PAT","E",PSOTG1)) Q:PSOTG1="" D
48 .I $D(^PS(52.91,PSOTG1,0)) Q ;Multiple Installs check
49 .S PSOLPQT=0
50 .S PSOTG2="" F S PSOTG2=$O(^XTMP("SDPSO145","PAT","E",PSOTG1,PSOTG2)) Q:PSOTG2=""!(PSOLPQT) S PSOTG3="" F S PSOTG3=$O(^XTMP("SDPSO145","PAT","E",PSOTG1,PSOTG2,PSOTG3)) Q:PSOTG3=""!(PSOLPQT) D
51 ..S PSONODAD=$G(^XTMP("SDPSO145","PAT","E",PSOTG1,PSOTG2,PSOTG3))
52 ..I $P($G(^PS(52.91,PSOTG1,0)),"^",5),'PSONODAD D Q ;Entry exists, if this date is sooner, replace, if you get a Station Number
53 ...I PSOTG3'<$P($G(^PS(52.91,PSOTG1,0)),"^",5) Q
54 ...I PSOTG2=$P($G(^PS(52.91,PSOTG1,0)),"^",8) K DIE,DA,DR S DIE="^PS(52.91,",DA=PSOTG1,DR="4////"_PSOTG3 D ^DIE K DIE,DA,DR Q
55 ...K PSOTPSNM,PSOSTATI,DIC,DIQ,DD,DR S DIC=4,DR="99",DA=+PSOTG2,DIQ(0)="I",DIQ="PSOSTATI" D EN^DIQ1 S PSOTPSNM=$G(PSOSTATI(4,+PSOTG2,99,"I")) K DIC,DIQ,DR,DA,PSOSTATI
56 ...I $G(PSOTPSNM)="" K PSOTPSNM Q
57 ...K DA,DIE,DR S DIE="^PS(52.91,",DA=PSOTG1,DR="4////"_PSOTG3_";6////"_PSOTPSNM_";7////"_PSOTG2 D ^DIE K DA,DIE,DR
58 ...K PSOTPSNM
59 ..I $D(^PS(52.91,PSOTG1,0)),'PSONODAD D Q
60 ...I PSOTG2=$P($G(^PS(52.91,PSOTG1,0)),"^",8) K DIE,DA,DR S DIE="^PS(52.91,",DA=PSOTG1,DR="4////"_PSOTG3 D ^DIE K DIE,DA,DR Q
61 ...K PSOTPSNM,PSOSTATI,DIC,DIQ,DD,DR S DIC=4,DR="99",DA=+PSOTG2,DIQ(0)="I",DIQ="PSOSTATI" D EN^DIQ1 S PSOTPSNM=$G(PSOSTATI(4,+PSOTG2,99,"I")) K DIC,DIQ,DR,DA,PSOSTATI
62 ...I $G(PSOTPSNM)="" K PSOTPSNM Q
63 ...K DA,DIE,DR S DIE="^PS(52.91,",DA=PSOTG1,DR="4////"_PSOTG3_";6////"_PSOTPSNM_";7////"_PSOTG2 D ^DIE K DA,DIE,DR
64 ...K PSOTPSNM
65 ..I $D(^PS(52.91,PSOTG1,0)) Q
66 ..K PSOENRLD S PSOENRLD=$$ENR^PSOTPCRX(PSOTG1,3030725) I '$G(PSOENRLD) S ^XTMP("SDPSO145","NOTEN",PSOTG1)="",PSOLPQT=1 Q
67 ..K PSOACTRX S PSOACTRX=$$RX^PSOTPCRX(PSOTG1) I $G(PSOACTRX) D EWL^PSOTPCRX S PSOLPQT=1 Q
68 ..K PSOTPSNM
69 ..K PSOSTATI,DIC,DIQ,DD,DR S DIC=4,DR="99",DA=+PSOTG2,DIQ(0)="I",DIQ="PSOSTATI" D EN^DIQ1 S PSOTPSNM=$G(PSOSTATI(4,+PSOTG2,99,"I")) K DIC,DIQ,DR,DA,PSOSTATI
70 ..I $G(PSOTPSNM)="" S ^XTMP("SDPSO145","PROB1",PSOTG1)="" K PSOTPSNM Q
71 ..I '$D(^PS(52.91,PSOTG1,0)) K DIC S DIC="^PS(52.91,",DIC(0)="L",(X,DINUM)=PSOTG1,DIC("DR")="1////"_DT_";5////"_"E"_";6////"_PSOTPSNM_";7////"_PSOTG2 S:'$G(PSONODAD) DIC("DR")=DIC("DR")_";4////"_PSOTG3 D
72 ...K DD,DO D FILE^DICN K DD,DO,DIE,X,DINUM
73 ...I Y'>0 S ^XTMP("SDPSO145","PROB",PSOTG1)="" Q
74 ...S PSOETOT=PSOETOT+1
75 ...K ^XTMP("SDPSO145","PROB",PSOTG1)
76 ...K ^XTMP("SDPSO145","PROB1",PSOTG1)
77 ;LOOP THROUGH SCHEDULING XTMP HERE
78 D SCH^PSOTPCRX
79PASS ;
80 S ^XTMP("SDPSO145","ELIG")=+$G(PSOETOT)
81 S ^XTMP("SDPSO145","INEL")=+$G(PSOITOT)
82 D EN^PSO145PS
83 D NOW^%DTC S Y=% D DD^%DT S ^XTMP("SDPSO145","STOP")=$G(Y) K Y
84 ;***need HL7 routine name (moved to phase 2)
85 ;I '$$PATCH^XPDUTL("PSO*7.0*145") S ZTRTN="NAME^EXTRACT",ZTIO="",ZTDESC="TPB EIGIBILITY FILE EXTRACT",ZTDTH=$H D ^%ZTLOAD K ZTRTN,ZTIO,ZTDESC,ZTDTH
86 D MAIL
87 L -^XTMP("SDPSO145")
88 K DA,DIE,DR S DA=$O(^DIC(19,"B","PSO TPB PATIENT ENTER/EDIT",0)) I DA S DIE="^DIC(19,",DR="2////"_"@" D ^DIE K DIE,DA,DR
89 S:$D(ZTQUEUED) ZTREQ="@"
90 Q
91MAIL ;
92 N PSOTUCI,PSOTUCI1,XMTEXT,XMSUB,XMDUZ,XMY,PSOMLIN,PSOMLINN,PSOTDEL,PSOMNAME,PSOMLLP,PSOMLCT,PSOSTEXT,PSOQTIME,X,Y,%
93 S PSOMLINN="" S PSOMLIN=$P($G(^XMB(1,1,"XUS")),"^",17) I PSOMLIN'>0 S PSOMLIN=$G(DUZ(2))
94 I PSOMLIN S PSOMLINN=$P($G(^DIC(4,PSOMLIN,0)),"^")
95 S XMSUB=$S($G(PSOMLINN)="":"Unknown Institution",1:$G(PSOMLINN)_" ("_$G(PSOMLIN)_")")_" TPB FILE BUILD"
96 S XMDUZ="Patch PSO*7*145 Post Install" I $G(DUZ) S XMY(DUZ)=""
97 X ^%ZOSF("UCI") S PSOTUCI=$P($G(Y),",") S PSOTUCI1=$P($G(^%ZOSF("PROD")),",") I PSOTUCI=PSOTUCI1 D
98 .S XMY("TEMPLETON,SHANNON@FORUM.VA.GOV")=""
99 .S XMY("BROCKERT,JUDITH@FORUM.VA.GOV")=""
100 .S XMY("CHOW,ANGELA@FORUM.VA.GOV")=""
101 .S XMY("RUZBACKI,RON@FORUM.VA.GOV")=""
102 .S XMY("BARRON,LUANNE@FORUM.VA.GOV")=""
103 .S XMY("WASHINGTON,JANET P@FORUM.VA.GOV")=""
104 I $G(PSOTLOCK) D G MAILX
105 .D NOW^%DTC S Y=% X ^DD("DD") S PSOQTIME=Y
106 .K PSOSTEXT S PSOSTEXT(1)="The TPB ELIGIBILITY file building, and other post-install functions of",PSOSTEXT(2)="patch PSO*7*145, queued to run at "_$G(PSOQTIME)_",",PSOSTEXT(3)="was NOT run, because the XTMP patient global was locked."
107 .S PSOSTEXT(4)="This Post-Install may have been queued by another user. Please contact",PSOSTEXT(5)="Customer Support."
108 S PSOSTEXT(1)="The Post-Init from Patch PSO*7.0*145 is complete. The TPB ELIGIBILITY",PSOSTEXT(2)="File (#52.91) has been populated.",PSOSTEXT(3)=" "
109 S PSOSTEXT(4)="The job started at "_$G(^XTMP("SDPSO145","START")),PSOSTEXT(5)="The job ended at "_$G(^XTMP("SDPSO145","STOP")),PSOSTEXT(6)=" "
110 S PSOSTEXT(7)="Total number of eligible patients added to file = "_$G(^XTMP("SDPSO145","ELIG")),PSOSTEXT(8)="Total number of ineligible patients added to file = "_$G(^XTMP("SDPSO145","INEL")),PSOSTEXT(9)=" "
111 S PSOMLCT=10
112 S PSOTDEL="" F S PSOTDEL=$O(^XTMP("SDPSO145","PROB",PSOTDEL)) Q:PSOTDEL="" I $D(^PS(52.91,PSOTDEL,0)) K ^XTMP("SDPSO145","PROB",PSOTDEL)
113 S PSOTDEL="" F S PSOTDEL=$O(^XTMP("SDPDO145","PROB1",PSOTDEL)) Q:PSOTDEL="" I $D(^PS(52.91,PSOTDEL,0)) K ^XTMP("SDPSO145","PROB1",PSOTDEL)
114 I $O(^XTMP("SDPSO145","PROB",0)) D
115 .S PSOSTEXT(PSOMLCT)="The following patients qualify for the Transitional Pharmacy",PSOMLCT=PSOMLCT+1,PSOSTEXT(PSOMLCT)="Benefit, but were unable to be added to the file for unknown reasons:",PSOMLCT=PSOMLCT+1
116 .S PSOMLLP="" F S PSOMLLP=$O(^XTMP("SDPSO145","PROB",PSOMLLP)) Q:PSOMLLP="" D
117 ..D PNM
118 ..S PSOSTEXT(PSOMLCT)=$G(PSOMNAME)_$G(^XTMP("SDPSO145","PROB",PSOMLLP)),PSOMLCT=PSOMLCT+1
119 I PSOMLCT>10 S PSOSTEXT(PSOMLCT)=" ",PSOMLCT=PSOMLCT+1
120 I $O(^XTMP("SDPSO145","PROB1",0)) D
121 .S PSOSTEXT(PSOMLCT)="The following patients qualify for the Transitional Pharmacy",PSOMLCT=PSOMLCT+1,PSOSTEXT(PSOMLCT)="Benefit, but were unable to be added to the file because a Station Number",PSOMLCT=PSOMLCT+1
122 .S PSOSTEXT(PSOMLCT)="could not be found for the Institution associated with the patient:",PSOMLCT=PSOMLCT+1
123 .S PSOMLLP="" F S PSOMLLP=$O(^XTMP("SDPSO145","PROB1",PSOMLLP)) Q:PSOMLLP="" D
124 ..D PNM
125 ..S PSOSTEXT(PSOMLCT)=$G(PSOMNAME)_$G(^XTMP("SDPSO145","PROB1",PSOMLLP)),PSOMLCT=PSOMLCT+1
126MAILX ;
127 I $O(XMY(""))'="" S XMTEXT="PSOSTEXT(" N DIFROM D ^XMD
128 K PSOSTEXT,XMTEXT,XMSUB,XMDUZ,XMY
129 Q
130GETDATE ;
131 N PSONOW,PSOTODAY,X,Y,PSOSAVEY,PSOSAVEX,PSOXXX
132 S ZTDTH="",PSONOW=0
133 D NOW^%DTC S (Y,PSOTODAY)=% D DD^%DT
134 D BMES^XPDUTL("At the following prompt, enter a starting date@time")
135 D MES^XPDUTL("or enter NOW to queue the job immediately.")
136 D BMES^XPDUTL("If this prompting is during patch installation, you may not see what you type.")
137 W ! K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Queue TPB Eligibility File building job for what Date@Time: "
138 D ^%DT K %DT I $D(DTOUT)!(Y<0) W "Task will be queued to run NOW" S ZTDTH=$H,PSONOW=1
139 S PSOSAVEY=Y
140 I 'PSONOW,PSOSAVEY>0 D
141 .S Y=PSOSAVEY D DD^%DT
142 .S PSOSAVEX=Y
143 I 'PSONOW,$G(PSOSAVEY)<0 K PSOXXX,PSOSAVEX,PSOSAVEY,X,Y,PSONOW,PSOTODAY G GETDATE
144ASK ;
145 D BMES^XPDUTL("Task will be queued to run "_$S(PSONOW:"NOW",1:PSOSAVEX)_". Is that correct? ")
146 R PSOXXX:300 S:'$T!($G(PSOXXX)="") PSOXXX="Y" S PSOXXX=$$UP^XLFSTR(PSOXXX) I PSOXXX'="Y",PSOXXX'="YES",PSOXXX'="N",PSOXXX'="NO" W "Enter Y or N" G ASK
147 I PSOXXX'="Y",PSOXXX'="YES" K PSOXXX,PSOSAVEX,PSOSAVEY,X,Y,PSONOW,PSOTODAY G GETDATE
148 I PSOSAVEY>0,ZTDTH="" S ZTDTH=PSOSAVEY
149 I ZTDTH="" S ZTDTH=$H
150 Q
151PNM ;
152 N DFN,VADM,VA,VAERR
153 K PSOMNANE,VADM
154 S DFN=+$G(PSOMLLP) I 'DFN Q
155 D DEM^VADPT I $G(VADM(1))="" K VADM Q
156 S PSOMNAME=$G(VADM(1))
157 K VADM
158 K VA,VAERR S DFN=+$G(PSOMLLP) D PID^VADPT6
159 S PSOMNAME=PSOMNAME_" "_"("_$G(VA("BID"))_")"
160 K VA,VAERR
161 Q
Note: See TracBrowser for help on using the repository browser.