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