PSO7L684 ;DAL/JCH - MIGRATION REPORT UTILITIES ;07/10/2022
;;7.0;OUTPATIENT PHARMACY;**684,545**;DEC 1997;Build 270
;
Q
;
REMIG ; Task DEA Migration
N ZTRTN,ZTDESC,ZTIO,ZTSAVE,PSOTDTH
N HANDPSO,TITLE,LIFE,BEGDT,PURGDT,ZTDTH
S HANDPSO="PSO70684-INSTALL",TITLE="PSO DEA Migration"
S LIFE=90
;
S PSOTDTH=$$GETSTART() I PSOTDTH'?7N0.1".".N D Q
. D BMES^XPDUTL(" ** DEA Migration NOT Queued! ** ")
;
S BEGDT=PSOTDTH,PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
;
S ZTSAVE("DUZ")="",ZTSAVE("ZTDTH")="",ZTDTH=PSOTDTH
S ZTRTN="PRE^PSO7P684",ZTIO="",ZTDESC=TITLE D ^%ZTLOAD
I '$D(ZTSK) D Q
. D BMES^XPDUTL("")
. D MES^XPDUTL("There was a problem queueing this task")
. D MES^XPDUTL("*** Task NOT Queued! ***")
. K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
;
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D INITXTMP^PSO7E684(HANDPSO,TITLE,LIFE)
. S ^XTMP(HANDPSO,0)=PURGDT_"^"_BEGDT_"^"_TITLE
. S ^XTMP(HANDPSO,"STATUS")="Start of Install (Interactive)"
. L -^XTMP(HANDPSO)
;
D BMES^XPDUTL("")
Q
;
GETSTART() ; Prompt for time to start DEA Migration
; Minimum time to start: 5 minutes into future.
; Maximum time to start: 72 hours into future.
;
N DIR,X,Y,MIBEG,MIEND,MIDEF
S MIBEG=$$FMADD^XLFDT($$NOW^XLFDT(),,,4)
S MIEND=$$FMADD^XLFDT($$NOW^XLFDT(),,24)
S MIDEF=$P($$FMTE^XLFDT($$FMADD^XLFDT($$NOW^XLFDT(),,,10),2),":",1,2)
S DIR(0)="DA^"_MIBEG_":"_MIEND_":%DT"
S DIR("?",1)="The DEA Migration must be scheduled a minimum of 5 minutes"
S DIR("?",2)="later than the current date/time, and no more than 24 hours"
S DIR("?",3)="later than the current date/time.",DIR("?",4)=""
S DIR("?")="Enter '^' to exit without queueing."
S DIR("??")="^D MSDTHLP^PSO7E684"
S DIR("A")="Date/Time to Queue the DEA Migration: ",DIR("B")=MIDEF
D ^DIR
Q Y
;
ASKRPTSCH(MIRESET) ; Ask if user still wants to run report even though migration is scheduled to run in the future
N MISCHDT,MISCHM,PSOAST
S $P(PSOAST,"*",74)="*"
S MISCHDT=$P($G(^XTMP("PSO70684-INSTALL",0)),"^",2)
Q:'MISCHDT 1
I $$FMDIFF^XLFDT($$DT^XLFDT,MISCHDT)>1!($$FMDIFF^XLFDT($$NOW^XLFDT,MISCHDT,2)>60) D Q 1
. S ^XTMP(HANDPSO,"STATUS")="Migration Halted"
. S MIRESET=1
L -^XTMP(HANDPSO)
N DIR
S MISCHM=" at "_$$FMTE^XLFDT(MISCHDT)
S DIR("A",1)=PSOAST
S DIR("A",2)=" A new DEA Migration is scheduled to run"_$G(MISCHM)_"."
S DIR("A",3)=" The current DEA Migration report data will be obsolete after "
S DIR("A",4)=" the scheduled migration runs."
S DIR("A",5)=PSOAST
S DIR("A",6)=""
S DIR("B")="N"
S DIR(0)="Y",DIR("A")="Do you want to print the obsolete DEA Migration Report" D ^DIR S PSOPRINT=+$G(Y)
Q $S(PSOPRINT>0:1,1:0)
;
ASKSCH2(HANDPSO) ; Ask user if they really want obsolete report data, if they just scheduled the migration refresh
N MIGSTAT
S MIGSTAT=$G(^XTMP(HANDPSO,"STATUS"))
I $G(MIGSTAT)["Start of Install" S PSOPRINT=$$ASKRPTSCH()
Q PSOPRINT
;
RPTDTHD(PSOPRINT,HANDPSO) ; Report Pre-Header; Display Date/Time current report data was last compiled/migrated.
N STATUS,LASTRUN,PHANDLE,LASTMSG
S STATUS=$G(^XTMP(HANDPSO,"STATUS"))
S PHANDLE=$O(^XTMP("PSODEAWB"_"-"_($H+1)),-1)
S LASTRUN=$G(^XTMP(PHANDLE,"COMPLETE"))
Q:'$G(LASTRUN)
S LASTMSG=" *** Now printing DEA Migration data from "_$$FMTE^XLFDT(LASTRUN)_" ***"
W !!,LASTMSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7L684 3396 printed Sep 23, 2025@19:59:53 Page 2
PSO7L684 ;DAL/JCH - MIGRATION REPORT UTILITIES ;07/10/2022
+1 ;;7.0;OUTPATIENT PHARMACY;**684,545**;DEC 1997;Build 270
+2 ;
+3 QUIT
+4 ;
REMIG ; Task DEA Migration
+1 NEW ZTRTN,ZTDESC,ZTIO,ZTSAVE,PSOTDTH
+2 NEW HANDPSO,TITLE,LIFE,BEGDT,PURGDT,ZTDTH
+3 SET HANDPSO="PSO70684-INSTALL"
SET TITLE="PSO DEA Migration"
+4 SET LIFE=90
+5 ;
+6 SET PSOTDTH=$$GETSTART()
IF PSOTDTH'?7N0.1".".N
Begin DoDot:1
+7 DO BMES^XPDUTL(" ** DEA Migration NOT Queued! ** ")
End DoDot:1
QUIT
+8 ;
+9 SET BEGDT=PSOTDTH
SET PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
+10 ;
+11 SET ZTSAVE("DUZ")=""
SET ZTSAVE("ZTDTH")=""
SET ZTDTH=PSOTDTH
+12 SET ZTRTN="PRE^PSO7P684"
SET ZTIO=""
SET ZTDESC=TITLE
DO ^%ZTLOAD
+13 IF '$DATA(ZTSK)
Begin DoDot:1
+14 DO BMES^XPDUTL("")
+15 DO MES^XPDUTL("There was a problem queueing this task")
+16 DO MES^XPDUTL("*** Task NOT Queued! ***")
+17 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+18 ;
+19 if $DATA(ZTSK)
Begin DoDot:1
+20 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+21 DO INITXTMP^PSO7E684(HANDPSO,TITLE,LIFE)
+22 SET ^XTMP(HANDPSO,0)=PURGDT_"^"_BEGDT_"^"_TITLE
+23 SET ^XTMP(HANDPSO,"STATUS")="Start of Install (Interactive)"
+24 LOCK -^XTMP(HANDPSO)
End DoDot:1
+25 ;
+26 DO BMES^XPDUTL("")
+27 QUIT
+28 ;
GETSTART() ; Prompt for time to start DEA Migration
+1 ; Minimum time to start: 5 minutes into future.
+2 ; Maximum time to start: 72 hours into future.
+3 ;
+4 NEW DIR,X,Y,MIBEG,MIEND,MIDEF
+5 SET MIBEG=$$FMADD^XLFDT($$NOW^XLFDT(),,,4)
+6 SET MIEND=$$FMADD^XLFDT($$NOW^XLFDT(),,24)
+7 SET MIDEF=$PIECE($$FMTE^XLFDT($$FMADD^XLFDT($$NOW^XLFDT(),,,10),2),":",1,2)
+8 SET DIR(0)="DA^"_MIBEG_":"_MIEND_":%DT"
+9 SET DIR("?",1)="The DEA Migration must be scheduled a minimum of 5 minutes"
+10 SET DIR("?",2)="later than the current date/time, and no more than 24 hours"
+11 SET DIR("?",3)="later than the current date/time."
SET DIR("?",4)=""
+12 SET DIR("?")="Enter '^' to exit without queueing."
+13 SET DIR("??")="^D MSDTHLP^PSO7E684"
+14 SET DIR("A")="Date/Time to Queue the DEA Migration: "
SET DIR("B")=MIDEF
+15 DO ^DIR
+16 QUIT Y
+17 ;
ASKRPTSCH(MIRESET) ; Ask if user still wants to run report even though migration is scheduled to run in the future
+1 NEW MISCHDT,MISCHM,PSOAST
+2 SET $PIECE(PSOAST,"*",74)="*"
+3 SET MISCHDT=$PIECE($GET(^XTMP("PSO70684-INSTALL",0)),"^",2)
+4 if 'MISCHDT
QUIT 1
+5 IF $$FMDIFF^XLFDT($$DT^XLFDT,MISCHDT)>1!($$FMDIFF^XLFDT($$NOW^XLFDT,MISCHDT,2)>60)
Begin DoDot:1
+6 SET ^XTMP(HANDPSO,"STATUS")="Migration Halted"
+7 SET MIRESET=1
End DoDot:1
QUIT 1
+8 LOCK -^XTMP(HANDPSO)
+9 NEW DIR
+10 SET MISCHM=" at "_$$FMTE^XLFDT(MISCHDT)
+11 SET DIR("A",1)=PSOAST
+12 SET DIR("A",2)=" A new DEA Migration is scheduled to run"_$GET(MISCHM)_"."
+13 SET DIR("A",3)=" The current DEA Migration report data will be obsolete after "
+14 SET DIR("A",4)=" the scheduled migration runs."
+15 SET DIR("A",5)=PSOAST
+16 SET DIR("A",6)=""
+17 SET DIR("B")="N"
+18 SET DIR(0)="Y"
SET DIR("A")="Do you want to print the obsolete DEA Migration Report"
DO ^DIR
SET PSOPRINT=+$GET(Y)
+19 QUIT $SELECT(PSOPRINT>0:1,1:0)
+20 ;
ASKSCH2(HANDPSO) ; Ask user if they really want obsolete report data, if they just scheduled the migration refresh
+1 NEW MIGSTAT
+2 SET MIGSTAT=$GET(^XTMP(HANDPSO,"STATUS"))
+3 IF $GET(MIGSTAT)["Start of Install"
SET PSOPRINT=$$ASKRPTSCH()
+4 QUIT PSOPRINT
+5 ;
RPTDTHD(PSOPRINT,HANDPSO) ; Report Pre-Header; Display Date/Time current report data was last compiled/migrated.
+1 NEW STATUS,LASTRUN,PHANDLE,LASTMSG
+2 SET STATUS=$GET(^XTMP(HANDPSO,"STATUS"))
+3 SET PHANDLE=$ORDER(^XTMP("PSODEAWB"_"-"_($HOROLOG+1)),-1)
+4 SET LASTRUN=$GET(^XTMP(PHANDLE,"COMPLETE"))
+5 if '$GET(LASTRUN)
QUIT
+6 SET LASTMSG=" *** Now printing DEA Migration data from "_$$FMTE^XLFDT(LASTRUN)_" ***"
+7 WRITE !!,LASTMSG
+8 QUIT
