PSOPOS13 ;BIR/VRN - Post install routine ;2/29/04
;;7.0;OUTPATIENT PHARMACY;**167**;DEC 1997
;External reference to ^DPT supported by DBIA 10035
;
; POST-INSTALL ROUTINE TO RESET "CMP" XREF TO CORRECT DIVISION FILE 52.5
;
ENV ;
;Verify CMOP Transmissions are shut down
K TSK,TSKNAM
F TSKNAM="PSXR SCHEDULED CS TRANS","PSXR SCHEDULED NON-CS TRANS" K TSK D I $G(TSK(1)) Q
. D OPTSTAT^XUTMOPT(TSKNAM,.TSK)
. Q
I $G(TSK(1)) D Q
. W !!,"Cannot install the patch while the following Tasks are scheduled:"
. W !,"1. PSXR SCHEDULED CS TRANS"
. W !,"2. PSXR SCHEDULED NON-CS TRANS"
. W !!,"Install Aborted!"
. S XPDABORT=2
. Q
;Ask queue date and time
Q:'$G(XPDENV)
W ! K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Queue the Post-Install to run at what Date@Time: "
D ^%DT K %DT I $D(DTOUT)!(Y<0) W !!,"Cannot install the patch without queuing the post-install, install aborted!",! S XPDABORT=2 Q
S @XPDGREF@("PSOQ13")=Y
Q
;
EN ;
S ZTDTH=@XPDGREF@("PSOQ13")
S ZTRTN="START^PSOPOS13",ZTDESC="Background job for to search for invalid division XREF in file 52.5",ZTIO=""
D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
I $D(ZTSK)&('$D(ZTQUEUED)) D BMES^XPDUTL("Task "_ZTSK_" Queued!")
Q
;
START ;
K ^XTMP("PSOPOS13",$J)
L +^XTMP("PSOPOS13"):0 I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
I '$G(DT) S DT=$$DT^XLFDT
I '$D(^XTMP("PSOPOS13")) S X1=DT,X2=+90 D C^%DTC S ^XTMP("PSOPOS13",0)=$G(X)_"^"_DT
S X1=DT,X2=-180 D C^%DTC S PSODT2=X
D NOW^%DTC S ^XTMP("PSOPOS13","PSOTIMEX","START")=%
D BMES^XPDUTL("Re-indexing ""CMP"" XREFs... Sending Mailman message upon completion.")
SRCH ; SEARCH THROUGH "CMP" XREF
N PSODIV,PSOC7
S PSOSTA="" F S PSOSTA=$O(^PS(52.5,"CMP",PSOSTA)) Q:PSOSTA="" D
.S PSODEA="" F S PSODEA=$O(^PS(52.5,"CMP",PSOSTA,PSODEA)) Q:PSODEA="" D
..S PSODV=0 F S PSODV=$O(^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV)) Q:'PSODV D
...S PSODT=(PSODT2-.001) F S PSODT=$O(^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT)) Q:'PSODT D
....S PSODFN="" F S PSODFN=$O(^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT,PSODFN)) Q:PSODFN="" D
.....S PSOIEN="" F S PSOIEN=$O(^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT,PSODFN,PSOIEN)) Q:PSOIEN="" D
......I '$G(^PS(52.5,PSOIEN,0)) K ^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT,PSODFN,PSOIEN) Q
......Q:PSODV=$P(^PS(52.5,PSOIEN,0),"^",6)
......S ^XTMP("PSOPOS13",$J,PSODFN,PSODT,PSODV,PSOIEN)=PSOSTA_"^"_PSODT
......K ^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT,PSODFN,PSOIEN)
......S PSOC7=$P(^PS(52.5,PSOIEN,0),"^",7)
......I PSOC7'="" D SCMPX^PSOCMOP(PSOIEN,PSOC7)
L -^XTMP("PSOPOS13")
D GETLIST
MAIL ;
N CNT,TEXT,XMTEXT
D NOW^%DTC S PSOTIMEB=%
S Y=$G(^XTMP("PSOPOS13","PSOTIMEX","START")) D DD^%DT S PSOTIMEA=Y
S Y=$G(PSOTIMEB) D DD^%DT S PSOTIMEB=Y
S XMDUZ="Patch PSO*7*167",XMY(DUZ)="",XMSUB="PRESCRIPTION SUSPENSE File (#52.5) reset ""CMP"" Xref"
K SP
S $P(SP," ",71)="",LINE=0
D SETLN("Patch PSO*7*167 File (#52.5) ""CMP"" Xref clean-up is complete.")
D SETLN(" ")
D SETLN("It started on "_$G(PSOTIMEA)_".")
D SETLN("It ended on "_$G(PSOTIMEB)_".")
D SETLN(" ")
D SETLN("""CMP"" CROSS-REFERENCES THAT WERE REINDEXED")
S HDR="RX #",$E(HDR,18)="PATIENT NAME",$E(HDR,46)="CMOP STATUS",$E(HDR,59)="SUSPENSE DATE"
D SETLN(HDR)
D SETLN(" ")
S CNT=0
S NAM="" F S NAM=$O(^TMP($J,"PSOPOS14",NAM)) Q:NAM="" D
.S DFN="" F S DFN=$O(^TMP($J,"PSOPOS14",NAM,DFN)) Q:DFN="" D
..D PID^VADPT
..S PSOCQ=""
..F S PSOCQ=$O(^TMP($J,"PSOPOS14",NAM,DFN,PSOCQ)) Q:PSOCQ="" D
...S (PSORX,PSOPOS14,PSOSTAT,PSOSDT)=""
...F S PSORX=$O(^TMP($J,"PSOPOS14",NAM,DFN,PSOCQ,PSORX)) Q:PSORX="" D
....S PSOPOS14=^TMP($J,"PSOPOS14",NAM,DFN,PSOCQ,PSORX)
....S PSOSTAT=$P(PSOPOS14,"^",1)
....S Y=$P(PSOPOS14,"^",2) D DD^%DT
....S PSOSDT=Y
....S TEXT=""
....S $E(TEXT,1,17)=$E(PSORX_SP,1,12)
....S $E(TEXT,18,45)=$E($P($G(^DPT(DFN,0)),"^",1)_SP,1,20)
....S $E(TEXT,46,58)=$E(PSOSTAT_SP,1,11)
....S $E(TEXT,59,70)=$E(PSOSDT_SP,1,20)
....D SETLN(TEXT) S CNT=CNT+1
;
I CNT=0 D SETLN("No invalid Division Cross References")
D SETLN(" ")
D SETLN("** END OF LIST **")
;
S XMTEXT="^XTMP(""PSOPOS15"",$J,""M""," N DIFROM D ^XMD
K PSOTIMEA,PSOTIMEB,XMDUZ,XMSUB,XMTEXT,PSODT2,PSOJOB,^TMP($J,"PSOPOS14"),^XTMP("PSOPOS15",$J,"M")
K PSOPOS14,PSOSTAT,PSOSDT,CNT,DFN,MSG,NAM,PSODT,PSOSQ,PSOSQ1,PSOTXT
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
SETLN(TXT) ; Sets a line in the XTMP global for the Mailman Message
S LINE=$G(LINE)+1
S ^XTMP("PSOPOS15",$J,"M",LINE)=TXT
Q
;
GETLIST ;
K ^TMP($J,"PSOPOS14")
S PSOJOB="" F S PSOJOB=$O(^XTMP("PSOPOS13",PSOJOB)) Q:PSOJOB="" D
.S PSOSQ="" F S PSOSQ=$O(^XTMP("PSOPOS13",PSOJOB,PSOSQ)) Q:PSOSQ="" D
..S NAM=$P($G(^DPT(PSOSQ,0)),"^",1) I NAM="" S NAM="UNKNOWN"
..S PSOSQ1="" F S PSOSQ1=$O(^XTMP("PSOPOS13",PSOJOB,PSOSQ,PSOSQ1)) Q:PSOSQ1="" D
...S PSODIV1="" F S PSODIV1=$O(^XTMP("PSOPOS13",PSOJOB,PSOSQ,PSOSQ1,PSODIV1)) Q:PSODIV1="" D
....S PSORX="" F S PSORX=$O(^XTMP("PSOPOS13",PSOJOB,PSOSQ,PSOSQ1,PSODIV1,PSORX)) Q:PSORX="" D
.....Q:'$D(^PS(52.5,PSORX,0))
.....S PSORX1=$P(^PS(52.5,PSORX,0),"^",1)
.....I PSORX1'="" S PSORXP=$P($G(^PSRX(PSORX1,0)),"^",1)
.....I PSORXP'="" S ^TMP($J,"PSOPOS14",NAM,PSOSQ,"CMP",PSORXP)=^XTMP("PSOPOS13",PSOJOB,PSOSQ,PSOSQ1,PSODIV1,PSORX)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPOS13 5310 printed Sep 23, 2025@20:09:14 Page 2
PSOPOS13 ;BIR/VRN - Post install routine ;2/29/04
+1 ;;7.0;OUTPATIENT PHARMACY;**167**;DEC 1997
+2 ;External reference to ^DPT supported by DBIA 10035
+3 ;
+4 ; POST-INSTALL ROUTINE TO RESET "CMP" XREF TO CORRECT DIVISION FILE 52.5
+5 ;
ENV ;
+1 ;Verify CMOP Transmissions are shut down
+2 KILL TSK,TSKNAM
+3 FOR TSKNAM="PSXR SCHEDULED CS TRANS","PSXR SCHEDULED NON-CS TRANS"
KILL TSK
Begin DoDot:1
+4 DO OPTSTAT^XUTMOPT(TSKNAM,.TSK)
+5 QUIT
End DoDot:1
IF $GET(TSK(1))
QUIT
+6 IF $GET(TSK(1))
Begin DoDot:1
+7 WRITE !!,"Cannot install the patch while the following Tasks are scheduled:"
+8 WRITE !,"1. PSXR SCHEDULED CS TRANS"
+9 WRITE !,"2. PSXR SCHEDULED NON-CS TRANS"
+10 WRITE !!,"Install Aborted!"
+11 SET XPDABORT=2
+12 QUIT
End DoDot:1
QUIT
+13 ;Ask queue date and time
+14 if '$GET(XPDENV)
QUIT
+15 WRITE !
KILL %DT
DO NOW^%DTC
SET %DT="RAEX"
SET %DT(0)=%
SET %DT("A")="Queue the Post-Install to run at what Date@Time: "
+16 DO ^%DT
KILL %DT
IF $DATA(DTOUT)!(Y<0)
WRITE !!,"Cannot install the patch without queuing the post-install, install aborted!",!
SET XPDABORT=2
QUIT
+17 SET @XPDGREF@("PSOQ13")=Y
+18 QUIT
+19 ;
EN ;
+1 SET ZTDTH=@XPDGREF@("PSOQ13")
+2 SET ZTRTN="START^PSOPOS13"
SET ZTDESC="Background job for to search for invalid division XREF in file 52.5"
SET ZTIO=""
+3 DO ^%ZTLOAD
KILL ZTDTH,ZTRTN,ZTIO,ZTDESC
+4 IF $DATA(ZTSK)&('$DATA(ZTQUEUED))
DO BMES^XPDUTL("Task "_ZTSK_" Queued!")
+5 QUIT
+6 ;
START ;
+1 KILL ^XTMP("PSOPOS13",$JOB)
+2 LOCK +^XTMP("PSOPOS13"):0
IF '$TEST
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 IF '$GET(DT)
SET DT=$$DT^XLFDT
+4 IF '$DATA(^XTMP("PSOPOS13"))
SET X1=DT
SET X2=+90
DO C^%DTC
SET ^XTMP("PSOPOS13",0)=$GET(X)_"^"_DT
+5 SET X1=DT
SET X2=-180
DO C^%DTC
SET PSODT2=X
+6 DO NOW^%DTC
SET ^XTMP("PSOPOS13","PSOTIMEX","START")=%
+7 DO BMES^XPDUTL("Re-indexing ""CMP"" XREFs... Sending Mailman message upon completion.")
SRCH ; SEARCH THROUGH "CMP" XREF
+1 NEW PSODIV,PSOC7
+2 SET PSOSTA=""
FOR
SET PSOSTA=$ORDER(^PS(52.5,"CMP",PSOSTA))
if PSOSTA=""
QUIT
Begin DoDot:1
+3 SET PSODEA=""
FOR
SET PSODEA=$ORDER(^PS(52.5,"CMP",PSOSTA,PSODEA))
if PSODEA=""
QUIT
Begin DoDot:2
+4 SET PSODV=0
FOR
SET PSODV=$ORDER(^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV))
if 'PSODV
QUIT
Begin DoDot:3
+5 SET PSODT=(PSODT2-.001)
FOR
SET PSODT=$ORDER(^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT))
if 'PSODT
QUIT
Begin DoDot:4
+6 SET PSODFN=""
FOR
SET PSODFN=$ORDER(^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT,PSODFN))
if PSODFN=""
QUIT
Begin DoDot:5
+7 SET PSOIEN=""
FOR
SET PSOIEN=$ORDER(^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT,PSODFN,PSOIEN))
if PSOIEN=""
QUIT
Begin DoDot:6
+8 IF '$GET(^PS(52.5,PSOIEN,0))
KILL ^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT,PSODFN,PSOIEN)
QUIT
+9 if PSODV=$PIECE(^PS(52.5,PSOIEN,0),"^",6)
QUIT
+10 SET ^XTMP("PSOPOS13",$JOB,PSODFN,PSODT,PSODV,PSOIEN)=PSOSTA_"^"_PSODT
+11 KILL ^PS(52.5,"CMP",PSOSTA,PSODEA,PSODV,PSODT,PSODFN,PSOIEN)
+12 SET PSOC7=$PIECE(^PS(52.5,PSOIEN,0),"^",7)
+13 IF PSOC7'=""
DO SCMPX^PSOCMOP(PSOIEN,PSOC7)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 LOCK -^XTMP("PSOPOS13")
+15 DO GETLIST
MAIL ;
+1 NEW CNT,TEXT,XMTEXT
+2 DO NOW^%DTC
SET PSOTIMEB=%
+3 SET Y=$GET(^XTMP("PSOPOS13","PSOTIMEX","START"))
DO DD^%DT
SET PSOTIMEA=Y
+4 SET Y=$GET(PSOTIMEB)
DO DD^%DT
SET PSOTIMEB=Y
+5 SET XMDUZ="Patch PSO*7*167"
SET XMY(DUZ)=""
SET XMSUB="PRESCRIPTION SUSPENSE File (#52.5) reset ""CMP"" Xref"
+6 KILL SP
+7 SET $PIECE(SP," ",71)=""
SET LINE=0
+8 DO SETLN("Patch PSO*7*167 File (#52.5) ""CMP"" Xref clean-up is complete.")
+9 DO SETLN(" ")
+10 DO SETLN("It started on "_$GET(PSOTIMEA)_".")
+11 DO SETLN("It ended on "_$GET(PSOTIMEB)_".")
+12 DO SETLN(" ")
+13 DO SETLN("""CMP"" CROSS-REFERENCES THAT WERE REINDEXED")
+14 SET HDR="RX #"
SET $EXTRACT(HDR,18)="PATIENT NAME"
SET $EXTRACT(HDR,46)="CMOP STATUS"
SET $EXTRACT(HDR,59)="SUSPENSE DATE"
+15 DO SETLN(HDR)
+16 DO SETLN(" ")
+17 SET CNT=0
+18 SET NAM=""
FOR
SET NAM=$ORDER(^TMP($JOB,"PSOPOS14",NAM))
if NAM=""
QUIT
Begin DoDot:1
+19 SET DFN=""
FOR
SET DFN=$ORDER(^TMP($JOB,"PSOPOS14",NAM,DFN))
if DFN=""
QUIT
Begin DoDot:2
+20 DO PID^VADPT
+21 SET PSOCQ=""
+22 FOR
SET PSOCQ=$ORDER(^TMP($JOB,"PSOPOS14",NAM,DFN,PSOCQ))
if PSOCQ=""
QUIT
Begin DoDot:3
+23 SET (PSORX,PSOPOS14,PSOSTAT,PSOSDT)=""
+24 FOR
SET PSORX=$ORDER(^TMP($JOB,"PSOPOS14",NAM,DFN,PSOCQ,PSORX))
if PSORX=""
QUIT
Begin DoDot:4
+25 SET PSOPOS14=^TMP($JOB,"PSOPOS14",NAM,DFN,PSOCQ,PSORX)
+26 SET PSOSTAT=$PIECE(PSOPOS14,"^",1)
+27 SET Y=$PIECE(PSOPOS14,"^",2)
DO DD^%DT
+28 SET PSOSDT=Y
+29 SET TEXT=""
+30 SET $EXTRACT(TEXT,1,17)=$EXTRACT(PSORX_SP,1,12)
+31 SET $EXTRACT(TEXT,18,45)=$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^",1)_SP,1,20)
+32 SET $EXTRACT(TEXT,46,58)=$EXTRACT(PSOSTAT_SP,1,11)
+33 SET $EXTRACT(TEXT,59,70)=$EXTRACT(PSOSDT_SP,1,20)
+34 DO SETLN(TEXT)
SET CNT=CNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
+36 IF CNT=0
DO SETLN("No invalid Division Cross References")
+37 DO SETLN(" ")
+38 DO SETLN("** END OF LIST **")
+39 ;
+40 SET XMTEXT="^XTMP(""PSOPOS15"",$J,""M"","
NEW DIFROM
DO ^XMD
+41 KILL PSOTIMEA,PSOTIMEB,XMDUZ,XMSUB,XMTEXT,PSODT2,PSOJOB,^TMP($JOB,"PSOPOS14"),^XTMP("PSOPOS15",$JOB,"M")
+42 KILL PSOPOS14,PSOSTAT,PSOSDT,CNT,DFN,MSG,NAM,PSODT,PSOSQ,PSOSQ1,PSOTXT
+43 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+44 QUIT
+45 ;
SETLN(TXT) ; Sets a line in the XTMP global for the Mailman Message
+1 SET LINE=$GET(LINE)+1
+2 SET ^XTMP("PSOPOS15",$JOB,"M",LINE)=TXT
+3 QUIT
+4 ;
GETLIST ;
+1 KILL ^TMP($JOB,"PSOPOS14")
+2 SET PSOJOB=""
FOR
SET PSOJOB=$ORDER(^XTMP("PSOPOS13",PSOJOB))
if PSOJOB=""
QUIT
Begin DoDot:1
+3 SET PSOSQ=""
FOR
SET PSOSQ=$ORDER(^XTMP("PSOPOS13",PSOJOB,PSOSQ))
if PSOSQ=""
QUIT
Begin DoDot:2
+4 SET NAM=$PIECE($GET(^DPT(PSOSQ,0)),"^",1)
IF NAM=""
SET NAM="UNKNOWN"
+5 SET PSOSQ1=""
FOR
SET PSOSQ1=$ORDER(^XTMP("PSOPOS13",PSOJOB,PSOSQ,PSOSQ1))
if PSOSQ1=""
QUIT
Begin DoDot:3
+6 SET PSODIV1=""
FOR
SET PSODIV1=$ORDER(^XTMP("PSOPOS13",PSOJOB,PSOSQ,PSOSQ1,PSODIV1))
if PSODIV1=""
QUIT
Begin DoDot:4
+7 SET PSORX=""
FOR
SET PSORX=$ORDER(^XTMP("PSOPOS13",PSOJOB,PSOSQ,PSOSQ1,PSODIV1,PSORX))
if PSORX=""
QUIT
Begin DoDot:5
+8 if '$DATA(^PS(52.5,PSORX,0))
QUIT
+9 SET PSORX1=$PIECE(^PS(52.5,PSORX,0),"^",1)
+10 IF PSORX1'=""
SET PSORXP=$PIECE($GET(^PSRX(PSORX1,0)),"^",1)
+11 IF PSORXP'=""
SET ^TMP($JOB,"PSOPOS14",NAM,PSOSQ,"CMP",PSORXP)=^XTMP("PSOPOS13",PSOJOB,PSOSQ,PSOSQ1,PSODIV1,PSORX)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
