source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPOS13.m@ 1464

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

 ;