PSOPOST8 ;BIR/EJW-Post install routine - patch PSO*7*129 ;11/14/02
;;7.0;OUTPATIENT PHARMACY;**129,268**;DEC 1997;Build 9
;External reference to ^DPT supported by DBIA 10035
;External reference to ^XUSEC supported by DBIA 10076
; 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
S ZTDTH=""
I $D(ZTQUEUED) S ZTDTH=$H
L +^XTMP("PSOPOST7"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D Q
.I ZTDTH="" D BMES^XPDUTL("** The clean up job from patch PSO*7*115 is still running. **")
.D BMES^XPDUTL("A MailMan message is now being generated with instructions on running this")
.D BMES^XPDUTL("post-install at a later date/time. Halting...")
.S MSG="LIST IN USE" D MAIL2
L -^XTMP("PSOPOST7")
I ZTDTH="" D
.D BMES^XPDUTL("The background job to list reset ^PS(55 entries must be queued.")
.D BMES^XPDUTL("If no start date/time is entered when prompted, the background job will be")
.D BMES^XPDUTL("queued to run NOW.")
.D BMES^XPDUTL(" ")
.D BMES^XPDUTL("Queuing background job to list entries reset into ^PS(55")
S ZTRTN="RES^PSOPOST8",ZTIO="",ZTDESC="Background job to list entries reset into PS(55" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
Q
RES ;
I '$G(DT) S DT=$$DT^XLFDT
I '$D(^XTMP("PSOPOST7")) S MSG="NO ENTRIES TO LIST" D MAIL2 Q
D NOW^%DTC S ^XTMP("PSOTIMEX","START")=%
D BMES^XPDUTL("Creating list of reset ^PS(55 entries...")
GETLIST ; PROCESS ENTRIES FROM ^XTMP("PSOPOST7" GLOBAL
K ^TMP($J,"PSOPOST8")
S PSOJOB="" F S PSOJOB=$O(^XTMP("PSOPOST7",PSOJOB)) Q:PSOJOB="" D
.S PSOSQ="" F S PSOSQ=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ)) Q:PSOSQ="" D
..I PSOSQ="IV"!(PSOSQ="UD") D GETIVUD Q
..S NAM=$P($G(^DPT(PSOSQ,0)),"^",1) I NAM="" S NAM="UNKNOWN"
..S PSOSQ1="" F S PSOSQ1=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1)) Q:PSOSQ1="" D
...I PSOSQ1="P,A" D GETPA Q
...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)=""
;
MAIL ;
D NOW^%DTC S PSOTIMEB=%
S Y=$G(^XTMP("PSOTIMEX","START")) D DD^%DT S PSOTIMEA=Y
S Y=$G(PSOTIMEB) D DD^%DT S PSOTIMEB=Y
S XMDUZ="Patch PSO*7*129",XMY(DUZ)="",XMSUB="PHARMACY PATIENT File (#55) listing of rebuilt entries"
F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSNMGR",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
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)_"."
S PSOTEXT(4)=" "
S PSOTEXT(5)="Listing of cross-references reset by patch PSO*7*115"
S CNT=5
S NAM="" F S NAM=$O(^TMP($J,"PSOPOST8",NAM)) Q:NAM="" D
.S DFN="" F S DFN=$O(^TMP($J,"PSOPOST8",NAM,DFN)) Q:DFN="" D
..D GETPT S CNT=CNT+1,PSOTEXT(CNT)=" ",CNT=CNT+1,PSOTEXT(CNT)=PSOTXT
..S PSOSQ="" F S PSOSQ=$O(^TMP($J,"PSOPOST8",NAM,DFN,PSOSQ)) Q:PSOSQ="" D
...I PSOSQ="UD" S CNT=CNT+1,PSOTEXT(CNT)=" UNIT DOSE STOP DATE CROSS-REFERENCE REBUILT" Q
...I PSOSQ="IV" S CNT=CNT+1,PSOTEXT(CNT)=" IV STOP DATE CROSS-REFERENCE REBUILT" Q
...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
...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
S CNT=CNT+1,PSOTEXT(CNT)=" ",PSOTEXT(CNT+1)="** END OF LIST **"
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD
G END
Q
;
MAIL2 ;
S XMDUZ="Patch PSO*7*129",XMY(DUZ)="",XMSUB="PHARMACY PATIENT File (#55) "_$G(MSG)
F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSNMGR",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
K PSOTEXT
S PSOTEXT(1)="Patch PSO*7*129 PHARMACY PATIENT File (#55) - nothing to list.",PSOTEXT(2)=" "
I $G(MSG)["IN USE" D
.S PSOTEXT(3)="The post-install job for patch PSO*7*115 is still running."
.S PSOTEXT(4)="Please run this job later by running ^PSOPOST8 from programmers mode."
I MSG["NO ENT" D
.S PSOTEXT(3)="No ^XTMP(""PSOPOST7"" entries exist from post-install job for PSO*7*115."
S PSOTEXT(5)=" "
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD
G END
Q
;
GETPT ; GET PATIENT INFORMATION
D PID^VADPT
S PSOTXT=$P($G(^DPT(DFN,0)),"^",1)_" ("_$G(VA("BID"))_")"
Q
;
GETPA ;
S PSODT="" F S PSODT=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1,PSODT)) Q:PSODT="" D
.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)=""
Q
;
GETIVUD ;
S PSOSQ1="" F S PSOSQ1=$O(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1)) Q:PSOSQ1="" D
.S NAM=$P($G(^DPT(PSOSQ1,0)),"^",1) I NAM="" S NAM="UNKNOWN"
.S ^TMP($J,"PSOPOST8",NAM,PSOSQ1,PSOSQ)=""
Q
;
END ;
K ^TMP($J,"PSOPOST8")
K PSOTIMEA,PSOTIMEB,XMDUZ,XMSUB,PSOTEXT,XMTEXT,PSOCXPDA,CNT,DFN,MSG,NAM,PSODT,PSOJOB,PSOSQ,PSOSQ1,PSOTXT
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPOST8 5132 printed Sep 23, 2025@20:09:23 Page 2
PSOPOST8 ;BIR/EJW-Post install routine - patch PSO*7*129 ;11/14/02
+1 ;;7.0;OUTPATIENT PHARMACY;**129,268**;DEC 1997;Build 9
+2 ;External reference to ^DPT supported by DBIA 10035
+3 ;External reference to ^XUSEC supported by DBIA 10076
+4 ; 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
+5 SET ZTDTH=""
+6 IF $DATA(ZTQUEUED)
SET ZTDTH=$HOROLOG
+7 LOCK +^XTMP("PSOPOST7"):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$TEST
Begin DoDot:1
+8 IF ZTDTH=""
DO BMES^XPDUTL("** The clean up job from patch PSO*7*115 is still running. **")
+9 DO BMES^XPDUTL("A MailMan message is now being generated with instructions on running this")
+10 DO BMES^XPDUTL("post-install at a later date/time. Halting...")
+11 SET MSG="LIST IN USE"
DO MAIL2
End DoDot:1
QUIT
+12 LOCK -^XTMP("PSOPOST7")
+13 IF ZTDTH=""
Begin DoDot:1
+14 DO BMES^XPDUTL("The background job to list reset ^PS(55 entries must be queued.")
+15 DO BMES^XPDUTL("If no start date/time is entered when prompted, the background job will be")
+16 DO BMES^XPDUTL("queued to run NOW.")
+17 DO BMES^XPDUTL(" ")
+18 DO BMES^XPDUTL("Queuing background job to list entries reset into ^PS(55")
End DoDot:1
+19 SET ZTRTN="RES^PSOPOST8"
SET ZTIO=""
SET ZTDESC="Background job to list entries reset into PS(55"
DO ^%ZTLOAD
KILL ZTDTH,ZTRTN,ZTIO,ZTDESC
+20 if $DATA(ZTSK)&('$DATA(ZTQUEUED))
WRITE !!,"Task Queued !",!
+21 QUIT
RES ;
+1 IF '$GET(DT)
SET DT=$$DT^XLFDT
+2 IF '$DATA(^XTMP("PSOPOST7"))
SET MSG="NO ENTRIES TO LIST"
DO MAIL2
QUIT
+3 DO NOW^%DTC
SET ^XTMP("PSOTIMEX","START")=%
+4 DO BMES^XPDUTL("Creating list of reset ^PS(55 entries...")
GETLIST ; PROCESS ENTRIES FROM ^XTMP("PSOPOST7" GLOBAL
+1 KILL ^TMP($JOB,"PSOPOST8")
+2 SET PSOJOB=""
FOR
SET PSOJOB=$ORDER(^XTMP("PSOPOST7",PSOJOB))
if PSOJOB=""
QUIT
Begin DoDot:1
+3 SET PSOSQ=""
FOR
SET PSOSQ=$ORDER(^XTMP("PSOPOST7",PSOJOB,PSOSQ))
if PSOSQ=""
QUIT
Begin DoDot:2
+4 IF PSOSQ="IV"!(PSOSQ="UD")
DO GETIVUD
QUIT
+5 SET NAM=$PIECE($GET(^DPT(PSOSQ,0)),"^",1)
IF NAM=""
SET NAM="UNKNOWN"
+6 SET PSOSQ1=""
FOR
SET PSOSQ1=$ORDER(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1))
if PSOSQ1=""
QUIT
Begin DoDot:3
+7 IF PSOSQ1="P,A"
DO GETPA
QUIT
+8 SET PSORX=""
FOR
SET PSORX=$ORDER(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1,PSORX))
if PSORX=""
QUIT
SET PSORXP=$PIECE($GET(^PSRX(PSORX,0)),"^",1)
IF PSORXP'=""
SET ^TMP($JOB,"PSOPOST8",NAM,PSOSQ,"P",PSORXP)=""
End DoDot:3
End DoDot:2
End DoDot:1
+9 ;
MAIL ;
+1 DO NOW^%DTC
SET PSOTIMEB=%
+2 SET Y=$GET(^XTMP("PSOTIMEX","START"))
DO DD^%DT
SET PSOTIMEA=Y
+3 SET Y=$GET(PSOTIMEB)
DO DD^%DT
SET PSOTIMEB=Y
+4 SET XMDUZ="Patch PSO*7*129"
SET XMY(DUZ)=""
SET XMSUB="PHARMACY PATIENT File (#55) listing of rebuilt entries"
+5 FOR PSOCXPDA=0:0
SET PSOCXPDA=$ORDER(^XUSEC("PSNMGR",PSOCXPDA))
if 'PSOCXPDA
QUIT
SET XMY(PSOCXPDA)=""
+6 KILL PSOTEXT
SET PSOTEXT(1)="Patch PSO*7*129 PHARMACY PATIENT File (#55) job is complete."
SET PSOTEXT(2)="It started on "_$GET(PSOTIMEA)_"."
SET PSOTEXT(3)="It ended on "_$GET(PSOTIMEB)_"."
+7 SET PSOTEXT(4)=" "
+8 SET PSOTEXT(5)="Listing of cross-references reset by patch PSO*7*115"
+9 SET CNT=5
+10 SET NAM=""
FOR
SET NAM=$ORDER(^TMP($JOB,"PSOPOST8",NAM))
if NAM=""
QUIT
Begin DoDot:1
+11 SET DFN=""
FOR
SET DFN=$ORDER(^TMP($JOB,"PSOPOST8",NAM,DFN))
if DFN=""
QUIT
Begin DoDot:2
+12 DO GETPT
SET CNT=CNT+1
SET PSOTEXT(CNT)=" "
SET CNT=CNT+1
SET PSOTEXT(CNT)=PSOTXT
+13 SET PSOSQ=""
FOR
SET PSOSQ=$ORDER(^TMP($JOB,"PSOPOST8",NAM,DFN,PSOSQ))
if PSOSQ=""
QUIT
Begin DoDot:3
+14 IF PSOSQ="UD"
SET CNT=CNT+1
SET PSOTEXT(CNT)=" UNIT DOSE STOP DATE CROSS-REFERENCE REBUILT"
QUIT
+15 IF PSOSQ="IV"
SET CNT=CNT+1
SET PSOTEXT(CNT)=" IV STOP DATE CROSS-REFERENCE REBUILT"
QUIT
+16 IF PSOSQ="P"
SET PSORX=""
FOR
SET PSORX=$ORDER(^TMP($JOB,"PSOPOST8",NAM,DFN,PSOSQ,PSORX))
if PSORX=""
QUIT
SET CNT=CNT+1
SET PSOTEXT(CNT)=" ""P"" CROSS-REFERENCE REBUILT FOR RX#: "_PSORX
+17 IF PSOSQ="P,A"
SET PSORX=""
FOR
SET PSORX=$ORDER(^TMP($JOB,"PSOPOST8",NAM,DFN,PSOSQ,PSORX))
if PSORX=""
QUIT
SET CNT=CNT+1
SET PSOTEXT(CNT)=" ""P"",""A"" CROSS-REFERENCE REBUILT FOR RX#: "_PSORX
End DoDot:3
End DoDot:2
End DoDot:1
+18 SET CNT=CNT+1
SET PSOTEXT(CNT)=" "
SET PSOTEXT(CNT+1)="** END OF LIST **"
+19 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
+20 GOTO END
+21 QUIT
+22 ;
MAIL2 ;
+1 SET XMDUZ="Patch PSO*7*129"
SET XMY(DUZ)=""
SET XMSUB="PHARMACY PATIENT File (#55) "_$GET(MSG)
+2 FOR PSOCXPDA=0:0
SET PSOCXPDA=$ORDER(^XUSEC("PSNMGR",PSOCXPDA))
if 'PSOCXPDA
QUIT
SET XMY(PSOCXPDA)=""
+3 KILL PSOTEXT
+4 SET PSOTEXT(1)="Patch PSO*7*129 PHARMACY PATIENT File (#55) - nothing to list."
SET PSOTEXT(2)=" "
+5 IF $GET(MSG)["IN USE"
Begin DoDot:1
+6 SET PSOTEXT(3)="The post-install job for patch PSO*7*115 is still running."
+7 SET PSOTEXT(4)="Please run this job later by running ^PSOPOST8 from programmers mode."
End DoDot:1
+8 IF MSG["NO ENT"
Begin DoDot:1
+9 SET PSOTEXT(3)="No ^XTMP(""PSOPOST7"" entries exist from post-install job for PSO*7*115."
End DoDot:1
+10 SET PSOTEXT(5)=" "
+11 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
+12 GOTO END
+13 QUIT
+14 ;
GETPT ; GET PATIENT INFORMATION
+1 DO PID^VADPT
+2 SET PSOTXT=$PIECE($GET(^DPT(DFN,0)),"^",1)_" ("_$GET(VA("BID"))_")"
+3 QUIT
+4 ;
GETPA ;
+1 SET PSODT=""
FOR
SET PSODT=$ORDER(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1,PSODT))
if PSODT=""
QUIT
Begin DoDot:1
+2 SET PSORX=""
FOR
SET PSORX=$ORDER(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1,PSODT,PSORX))
if PSORX=""
QUIT
SET PSORXP=$PIECE($GET(^PSRX(PSORX,0)),"^",1)
IF PSORXP'=""
SET ^TMP($JOB,"PSOPOST8",NAM,PSOSQ,"P,A",PSORXP)=""
End DoDot:1
+3 QUIT
+4 ;
GETIVUD ;
+1 SET PSOSQ1=""
FOR
SET PSOSQ1=$ORDER(^XTMP("PSOPOST7",PSOJOB,PSOSQ,PSOSQ1))
if PSOSQ1=""
QUIT
Begin DoDot:1
+2 SET NAM=$PIECE($GET(^DPT(PSOSQ1,0)),"^",1)
IF NAM=""
SET NAM="UNKNOWN"
+3 SET ^TMP($JOB,"PSOPOST8",NAM,PSOSQ1,PSOSQ)=""
End DoDot:1
+4 QUIT
+5 ;
END ;
+1 KILL ^TMP($JOB,"PSOPOST8")
+2 KILL PSOTIMEA,PSOTIMEB,XMDUZ,XMSUB,PSOTEXT,XMTEXT,PSOCXPDA,CNT,DFN,MSG,NAM,PSODT,PSOJOB,PSOSQ,PSOSQ1,PSOTXT
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
+5 ;
