source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPOST8.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1PSOPOST8 ;BIR/EJW-Post install routine - patch PSO*7*129 ;11/14/02
2 ;;7.0;OUTPATIENT PHARMACY;**129,268**;DEC 1997;Build 9
3 ;External reference to ^DPT supported by DBIA 10035
4 ;External reference to ^XUSEC supported by DBIA 10076
5 ; POST-INSTALL ROUTINE FOR PATCH PSO*7*129 - TO LIST ENTRIES THAT WERE RESET INTO THE PHARMACY PATIENT FILE (#55) BY PATCH PSO*7*115
6 S ZTDTH=""
7 I $D(ZTQUEUED) S ZTDTH=$H
8 L +^XTMP("PSOPOST7"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D Q
9 .I ZTDTH="" D BMES^XPDUTL("** The clean up job from patch PSO*7*115 is still running. **")
10 .D BMES^XPDUTL("A MailMan message is now being generated with instructions on running this")
11 .D BMES^XPDUTL("post-install at a later date/time. Halting...")
12 .S MSG="LIST IN USE" D MAIL2
13 L -^XTMP("PSOPOST7")
14 I ZTDTH="" D
15 .D BMES^XPDUTL("The background job to list reset ^PS(55 entries must be queued.")
16 .D BMES^XPDUTL("If no start date/time is entered when prompted, the background job will be")
17 .D BMES^XPDUTL("queued to run NOW.")
18 .D BMES^XPDUTL(" ")
19 .D BMES^XPDUTL("Queuing background job to list entries reset into ^PS(55")
20 S ZTRTN="RES^PSOPOST8",ZTIO="",ZTDESC="Background job to list entries reset into PS(55" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
21 W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
22 Q
23RES ;
24 I '$G(DT) S DT=$$DT^XLFDT
25 I '$D(^XTMP("PSOPOST7")) S MSG="NO ENTRIES TO LIST" D MAIL2 Q
26 D NOW^%DTC S ^XTMP("PSOTIMEX","START")=%
27 D BMES^XPDUTL("Creating list of reset ^PS(55 entries...")
28GETLIST ; PROCESS ENTRIES FROM ^XTMP("PSOPOST7" GLOBAL
29 K ^TMP($J,"PSOPOST8")
30 S PSOJOB="" F S PSOJOB=$O(^XTMP("PSOPOST7",PSOJOB)) Q:PSOJOB="" D
31 .S PSOSQ="" F S PSOSQ=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ)) Q:PSOSQ="" D
32 ..I PSOSQ="IV"!(PSOSQ="UD") D GETIVUD Q
33 ..S NAM=$P($G(^DPT(PSOSQ,0)),"^",1) I NAM="" S NAM="UNKNOWN"
34 ..S PSOSQ1="" F S PSOSQ1=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1)) Q:PSOSQ1="" D
35 ...I PSOSQ1="P,A" D GETPA Q
36 ...S PSORX="" F S PSORX=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1,PSORX)) Q:PSORX="" S PSORXP=$P($G(^PSRX(PSORX,0)),"^",1) I PSORXP'="" S ^TMP($J,"PSOPOST8",NAM,PSOSQ,"P",PSORXP)=""
37 ;
38MAIL ;
39 D NOW^%DTC S PSOTIMEB=%
40 S Y=$G(^XTMP("PSOTIMEX","START")) D DD^%DT S PSOTIMEA=Y
41 S Y=$G(PSOTIMEB) D DD^%DT S PSOTIMEB=Y
42 S XMDUZ="Patch PSO*7*129",XMY(DUZ)="",XMSUB="PHARMACY PATIENT File (#55) listing of rebuilt entries"
43 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSNMGR",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
44 K PSOTEXT S PSOTEXT(1)="Patch PSO*7*129 PHARMACY PATIENT File (#55) job is complete.",PSOTEXT(2)="It started on "_$G(PSOTIMEA)_".",PSOTEXT(3)="It ended on "_$G(PSOTIMEB)_"."
45 S PSOTEXT(4)=" "
46 S PSOTEXT(5)="Listing of cross-references reset by patch PSO*7*115"
47 S CNT=5
48 S NAM="" F S NAM=$O(^TMP($J,"PSOPOST8",NAM)) Q:NAM="" D
49 .S DFN="" F S DFN=$O(^TMP($J,"PSOPOST8",NAM,DFN)) Q:DFN="" D
50 ..D GETPT S CNT=CNT+1,PSOTEXT(CNT)=" ",CNT=CNT+1,PSOTEXT(CNT)=PSOTXT
51 ..S PSOSQ="" F S PSOSQ=$O(^TMP($J,"PSOPOST8",NAM,DFN,PSOSQ)) Q:PSOSQ="" D
52 ...I PSOSQ="UD" S CNT=CNT+1,PSOTEXT(CNT)=" UNIT DOSE STOP DATE CROSS-REFERENCE REBUILT" Q
53 ...I PSOSQ="IV" S CNT=CNT+1,PSOTEXT(CNT)=" IV STOP DATE CROSS-REFERENCE REBUILT" Q
54 ...I PSOSQ="P" S PSORX="" F S PSORX=$O(^TMP($J,"PSOPOST8",NAM,DFN,PSOSQ,PSORX)) Q:PSORX="" S CNT=CNT+1 S PSOTEXT(CNT)=" ""P"" CROSS-REFERENCE REBUILT FOR RX#: "_PSORX
55 ...I PSOSQ="P,A" S PSORX="" F S PSORX=$O(^TMP($J,"PSOPOST8",NAM,DFN,PSOSQ,PSORX)) Q:PSORX="" S CNT=CNT+1 S PSOTEXT(CNT)=" ""P"",""A"" CROSS-REFERENCE REBUILT FOR RX#: "_PSORX
56 S CNT=CNT+1,PSOTEXT(CNT)=" ",PSOTEXT(CNT+1)="** END OF LIST **"
57 S XMTEXT="PSOTEXT(" N DIFROM D ^XMD
58 G END
59 Q
60 ;
61MAIL2 ;
62 S XMDUZ="Patch PSO*7*129",XMY(DUZ)="",XMSUB="PHARMACY PATIENT File (#55) "_$G(MSG)
63 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSNMGR",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
64 K PSOTEXT
65 S PSOTEXT(1)="Patch PSO*7*129 PHARMACY PATIENT File (#55) - nothing to list.",PSOTEXT(2)=" "
66 I $G(MSG)["IN USE" D
67 .S PSOTEXT(3)="The post-install job for patch PSO*7*115 is still running."
68 .S PSOTEXT(4)="Please run this job later by running ^PSOPOST8 from programmers mode."
69 I MSG["NO ENT" D
70 .S PSOTEXT(3)="No ^XTMP(""PSOPOST7"" entries exist from post-install job for PSO*7*115."
71 S PSOTEXT(5)=" "
72 S XMTEXT="PSOTEXT(" N DIFROM D ^XMD
73 G END
74 Q
75 ;
76GETPT ; GET PATIENT INFORMATION
77 D PID^VADPT
78 S PSOTXT=$P($G(^DPT(DFN,0)),"^",1)_" ("_$G(VA("BID"))_")"
79 Q
80 ;
81GETPA ;
82 S PSODT="" F S PSODT=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1,PSODT)) Q:PSODT="" D
83 .S PSORX="" F S PSORX=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1,PSODT,PSORX)) Q:PSORX="" S PSORXP=$P($G(^PSRX(PSORX,0)),"^",1) I PSORXP'="" S ^TMP($J,"PSOPOST8",NAM,PSOSQ,"P,A",PSORXP)=""
84 Q
85 ;
86GETIVUD ;
87 S PSOSQ1="" F S PSOSQ1=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1)) Q:PSOSQ1="" D
88 .S NAM=$P($G(^DPT(PSOSQ1,0)),"^",1) I NAM="" S NAM="UNKNOWN"
89 .S ^TMP($J,"PSOPOST8",NAM,PSOSQ1,PSOSQ)=""
90 Q
91 ;
92END ;
93 K ^TMP($J,"PSOPOST8")
94 K PSOTIMEA,PSOTIMEB,XMDUZ,XMSUB,PSOTEXT,XMTEXT,PSOCXPDA,CNT,DFN,MSG,NAM,PSODT,PSOJOB,PSOSQ,PSOSQ1,PSOTXT
95 S:$D(ZTQUEUED) ZTREQ="@"
96 Q
97 ;
Note: See TracBrowser for help on using the repository browser.