Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSO7L684

PSO7L684.m

Go to the documentation of this file. 
  1. PSO7L684 ;DAL/JCH - MIGRATION REPORT UTILITIES ;07/10/2022
  1.  ;;7.0;OUTPATIENT PHARMACY;**684,545**;DEC 1997;Build 270
  1.  ;
  1.  Q
  1.  ;
  1. REMIG ; Task DEA Migration
  1.  N ZTRTN,ZTDESC,ZTIO,ZTSAVE,PSOTDTH
  1.  N HANDPSO,TITLE,LIFE,BEGDT,PURGDT,ZTDTH
  1.  S HANDPSO="PSO70684-INSTALL",TITLE="PSO DEA Migration"
  1.  S LIFE=90
  1.  ;
  1.  S PSOTDTH=$$GETSTART() I PSOTDTH'?7N0.1".".N D  Q
  1.  . D BMES^XPDUTL(" ** DEA Migration NOT Queued! ** ")
  1.  ;
  1.  S BEGDT=PSOTDTH,PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
  1.  ;
  1.  S ZTSAVE("DUZ")="",ZTSAVE("ZTDTH")="",ZTDTH=PSOTDTH
  1.  S ZTRTN="PRE^PSO7P684",ZTIO="",ZTDESC=TITLE D ^%ZTLOAD
  1.  I '$D(ZTSK) D  Q
  1.  . D BMES^XPDUTL("")
  1.  . D MES^XPDUTL("There was a problem queueing this task")
  1.  . D MES^XPDUTL("*** Task NOT Queued! ***")
  1.  . K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1.  ;
  1.  D:$D(ZTSK)
  1.  . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
  1.  . D INITXTMP^PSO7E684(HANDPSO,TITLE,LIFE)
  1.  . S ^XTMP(HANDPSO,0)=PURGDT_"^"_BEGDT_"^"_TITLE
  1.  . S ^XTMP(HANDPSO,"STATUS")="Start of Install (Interactive)"
  1.  . L -^XTMP(HANDPSO)
  1.  ;
  1.  D BMES^XPDUTL("")
  1.  Q
  1.  ;
  1. GETSTART() ; Prompt for time to start DEA Migration
  1.  ; Minimum time to start: 5 minutes into future.
  1.  ; Maximum time to start: 72 hours into future.
  1.  ;
  1.  N DIR,X,Y,MIBEG,MIEND,MIDEF
  1.  S MIBEG=$$FMADD^XLFDT($$NOW^XLFDT(),,,4)
  1.  S MIEND=$$FMADD^XLFDT($$NOW^XLFDT(),,24)
  1.  S MIDEF=$P($$FMTE^XLFDT($$FMADD^XLFDT($$NOW^XLFDT(),,,10),2),":",1,2)
  1.  S DIR(0)="DA^"_MIBEG_":"_MIEND_":%DT"
  1.  S DIR("?",1)="The DEA Migration must be scheduled a minimum of 5 minutes"
  1.  S DIR("?",2)="later than the current date/time, and no more than 24 hours"
  1.  S DIR("?",3)="later than the current date/time.",DIR("?",4)=""
  1.  S DIR("?")="Enter '^' to exit without queueing."
  1.  S DIR("??")="^D MSDTHLP^PSO7E684"
  1.  S DIR("A")="Date/Time to Queue the DEA Migration: ",DIR("B")=MIDEF
  1.  D ^DIR
  1.  Q Y
  1.  ;
  1. ASKRPTSCH(MIRESET) ; Ask if user still wants to run report even though migration is scheduled to run in the future
  1.  N MISCHDT,MISCHM,PSOAST
  1.  S $P(PSOAST,"*",74)="*"
  1.  S MISCHDT=$P($G(^XTMP("PSO70684-INSTALL",0)),"^",2)
  1.  Q:'MISCHDT 1
  1.  I $$FMDIFF^XLFDT($$DT^XLFDT,MISCHDT)>1!($$FMDIFF^XLFDT($$NOW^XLFDT,MISCHDT,2)>60) D  Q 1
  1.  . S ^XTMP(HANDPSO,"STATUS")="Migration Halted"
  1.  . S MIRESET=1
  1.  L -^XTMP(HANDPSO)
  1.  N DIR
  1.  S MISCHM=" at "_$$FMTE^XLFDT(MISCHDT)
  1.  S DIR("A",1)=PSOAST
  1.  S DIR("A",2)=" A new DEA Migration is scheduled to run"_$G(MISCHM)_"."
  1.  S DIR("A",3)=" The current DEA Migration report data will be obsolete after "
  1.  S DIR("A",4)="               the scheduled migration runs."
  1.  S DIR("A",5)=PSOAST
  1.  S DIR("A",6)=""
  1.  S DIR("B")="N"
  1.  S DIR(0)="Y",DIR("A")="Do you want to print the obsolete DEA Migration Report" D ^DIR S PSOPRINT=+$G(Y)
  1.  Q $S(PSOPRINT>0:1,1:0)
  1.  ;
  1. ASKSCH2(HANDPSO) ; Ask user if they really want obsolete report data, if they just scheduled the migration refresh
  1.  N MIGSTAT
  1.  S MIGSTAT=$G(^XTMP(HANDPSO,"STATUS"))
  1.  I $G(MIGSTAT)["Start of Install" S PSOPRINT=$$ASKRPTSCH()
  1.  Q PSOPRINT
  1.  ;
  1. RPTDTHD(PSOPRINT,HANDPSO) ; Report Pre-Header; Display Date/Time current report data was last compiled/migrated.
  1.  N STATUS,LASTRUN,PHANDLE,LASTMSG
  1.  S STATUS=$G(^XTMP(HANDPSO,"STATUS"))
  1.  S PHANDLE=$O(^XTMP("PSODEAWB"_"-"_($H+1)),-1)
  1.  S LASTRUN=$G(^XTMP(PHANDLE,"COMPLETE"))
  1.  Q:'$G(LASTRUN)
  1.  S LASTMSG=" *** Now printing DEA Migration data from "_$$FMTE^XLFDT(LASTRUN)_" ***"
  1.  W !!,LASTMSG
  1.  Q