1 | PSOPOST8 ;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
|
---|
23 | RES ;
|
---|
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...")
|
---|
28 | GETLIST ; 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 | ;
|
---|
38 | MAIL ;
|
---|
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 | ;
|
---|
61 | MAIL2 ;
|
---|
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 | ;
|
---|
76 | GETPT ; GET PATIENT INFORMATION
|
---|
77 | D PID^VADPT
|
---|
78 | S PSOTXT=$P($G(^DPT(DFN,0)),"^",1)_" ("_$G(VA("BID"))_")"
|
---|
79 | Q
|
---|
80 | ;
|
---|
81 | GETPA ;
|
---|
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 | ;
|
---|
86 | GETIVUD ;
|
---|
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 | ;
|
---|
92 | END ;
|
---|
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 | ;
|
---|