- 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
- ;
- 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 ;
