PSO7E545 ;WILM/BDB - Environment routine for patch PSO*7*545 ;12/3/2018
;;7.0;OUTPATIENT PHARMACY;**545**;DEC 1997;Build 270
;
ENV ;
N HANDPSO,TITLE,MISTART,MIEXP
S XPDABORT=$$KRNCHK Q:$G(XPDABORT)
S HANDPSO="PSO70684-INSTALL"
S MISTART=$P($G(^XTMP(HANDPSO,0)),"^",2),MIEXP=0
I MISTART,($$FMDIFF^XLFDT($$DT^XLFDT,MISTART)>7) S MIEXP=1
S TITLE="REFRESH DOJ/DEA MIGRATION DATA"
L +^XTMP(HANDPSO):0 I '$T D Q
. D BMES^XPDUTL(TITLE_" job is still running. Halting...")
. D MES^XPDUTL("")
. S XPDABORT=1 ; Do not install this transport global and KILL it from ^XTMP.
I $$PATCH^XPDUTL("PSO*7.0*545") D Q ; Don't require DEA migration if previously installed
. L -^XTMP(HANDPSO)
I '$D(^XTMP(HANDPSO))!($G(^XTMP(HANDPSO,"STATUS"))'="Install Completed")!$G(MIEXP) D L -^XTMP(HANDPSO) Q
. D BMES^XPDUTL("**************************** WARNING ****************************")
. D BMES^XPDUTL(" The DEA Migration has not run to completion within the last 7")
. D BMES^XPDUTL(" days. Please run the DEA Migration using the DEA Migration ")
. D BMES^XPDUTL(" Report [PSO DEA MIGRATION REPORT] option and entering 'YES'")
. D BMES^XPDUTL(" at the prompt 'Do you want to re-run the DEA Migration?'")
. D BMES^XPDUTL(" >>>> Installation aborted <<<<")
. D BMES^XPDUTL("*****************************************************************")
. S XPDABORT=1 ; Do not install this transport global and KILL it from ^XTMP.
;
L -^XTMP(HANDPSO)
Q
;
KRNCHK() ; Is PRDEA^XUSER routine present?
S XPDABORT=0
I $L($T(PRDEA^XUSER))<2 S XPDABORT=1 D
. D MES^XPDUTL("Patch XU*8.0*689 is required.")
. D BMES^XPDUTL("Please install XU*8.0*689 before installing this patch.")
Q XPDABORT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7E545 1744 printed Sep 23, 2025@19:59:50 Page 2
PSO7E545 ;WILM/BDB - Environment routine for patch PSO*7*545 ;12/3/2018
+1 ;;7.0;OUTPATIENT PHARMACY;**545**;DEC 1997;Build 270
+2 ;
ENV ;
+1 NEW HANDPSO,TITLE,MISTART,MIEXP
+2 SET XPDABORT=$$KRNCHK
if $GET(XPDABORT)
QUIT
+3 SET HANDPSO="PSO70684-INSTALL"
+4 SET MISTART=$PIECE($GET(^XTMP(HANDPSO,0)),"^",2)
SET MIEXP=0
+5 IF MISTART
IF ($$FMDIFF^XLFDT($$DT^XLFDT,MISTART)>7)
SET MIEXP=1
+6 SET TITLE="REFRESH DOJ/DEA MIGRATION DATA"
+7 LOCK +^XTMP(HANDPSO):0
IF '$TEST
Begin DoDot:1
+8 DO BMES^XPDUTL(TITLE_" job is still running. Halting...")
+9 DO MES^XPDUTL("")
+10 ; Do not install this transport global and KILL it from ^XTMP.
SET XPDABORT=1
End DoDot:1
QUIT
+11 ; Don't require DEA migration if previously installed
IF $$PATCH^XPDUTL("PSO*7.0*545")
Begin DoDot:1
+12 LOCK -^XTMP(HANDPSO)
End DoDot:1
QUIT
+13 IF '$DATA(^XTMP(HANDPSO))!($GET(^XTMP(HANDPSO,"STATUS"))'="Install Completed")!$GET(MIEXP)
Begin DoDot:1
+14 DO BMES^XPDUTL("**************************** WARNING ****************************")
+15 DO BMES^XPDUTL(" The DEA Migration has not run to completion within the last 7")
+16 DO BMES^XPDUTL(" days. Please run the DEA Migration using the DEA Migration ")
+17 DO BMES^XPDUTL(" Report [PSO DEA MIGRATION REPORT] option and entering 'YES'")
+18 DO BMES^XPDUTL(" at the prompt 'Do you want to re-run the DEA Migration?'")
+19 DO BMES^XPDUTL(" >>>> Installation aborted <<<<")
+20 DO BMES^XPDUTL("*****************************************************************")
+21 ; Do not install this transport global and KILL it from ^XTMP.
SET XPDABORT=1
End DoDot:1
LOCK -^XTMP(HANDPSO)
QUIT
+22 ;
+23 LOCK -^XTMP(HANDPSO)
+24 QUIT
+25 ;
KRNCHK() ; Is PRDEA^XUSER routine present?
+1 SET XPDABORT=0
+2 IF $LENGTH($TEXT(PRDEA^XUSER))<2
SET XPDABORT=1
Begin DoDot:1
+3 DO MES^XPDUTL("Patch XU*8.0*689 is required.")
+4 DO BMES^XPDUTL("Please install XU*8.0*689 before installing this patch.")
End DoDot:1
+5 QUIT XPDABORT
