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

ECXDEFIN.m

Go to the documentation of this file. 
  1. ECXDEFIN ;ALB/JAP,BIR/DMA-Define Extract Formats for Auto Queuing ; 17 Mar 95 / 9:55 AM
  1.  ;;3.0;DSS EXTRACTS;**24**;Dec 22, 1997
  1. EN ;entry point from option
  1.  N OUT,DIC,DIR,DIQ,DIRUT,DTOUT,DUOUT,DA,DR,X,Y,J,JJ
  1.  D MES^XPDUTL(" ")
  1.  D MES^XPDUTL("This option allows you to queue the generation of a specific DSS extract.")
  1.  D MES^XPDUTL("The extract will then be automatically requeued to run next month and")
  1.  D MES^XPDUTL("each subsequent month until the end of the fiscal year.  It will be")
  1.  D MES^XPDUTL("requeued to run on the same day of each month at the same time of day.")
  1.  D MES^XPDUTL(" ")
  1.  S DIC="727.1",DIC(0)="AEQLMZ",ECF=0 D ^DIC
  1.  Q:Y<0  Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  S (DA,ECDA)=+Y,ECDATA=Y(0),ECROU=^ECX(727.1,ECDA,"ROU"),X="SETUP^"_ECROU D @X
  1.  I '$D(ECNODE) S ECNODE=7
  1.  ;don't allow setup if more than 1 primary prosthetics division
  1.  I ECGRP="PRO" D  Q:OUT>1
  1.  .S OUT=0,J=0
  1.  .S ECXDA1=$O(^ECX(728,0))
  1.  .F  S J=$O(^ECX(728,ECXDA1,1,J)) Q:'J  I $D(^ECX(728,ECXDA1,1,J,0)) S OUT=OUT+1
  1.  .I OUT>1 D
  1.  ..D MES^XPDUTL(" ")
  1.  ..D MES^XPDUTL("This DSS site is responsible for Prosthetics data from")
  1.  ..D MES^XPDUTL("more than one Primary Prosthetics Division.  Therefore,")
  1.  ..D MES^XPDUTL("the PRO extract may not be setup for automatic requeue.")
  1.  ..D MES^XPDUTL(" ")
  1.  ..D MES^XPDUTL("Please use the Prosthetics Extract option on the Package")
  1.  ..D MES^XPDUTL("Extracts menu to generate the monthly PRO extract for each")
  1.  ..D MES^XPDUTL("Primary Prosthetics Division.  Exiting...")
  1.  ..D MES^XPDUTL(" ")
  1.  .I $E(IOST)="C" D
  1.  ..S SS=22-$Y F JJ=1:1:SS W !
  1.  ..S DIR(0)="E" W ! D ^DIR K DIR
  1.  ;don't allow setup if extract has never been run or if 1st extract of fiscal year
  1.  I ECGRP'="PRO" D
  1.  .S ECLDT=$P($G(^ECX(728,1,ECNODE)),U,ECPIECE)
  1.  I ECGRP="PRO" D
  1.  .S ECLDT=""
  1.  .S ECXDA1=$O(^ECX(728,0))
  1.  .I $D(^ECX(728,ECXDA1,1,ECXINST,0)) S ECLDT=$P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
  1.  I ECLDT="" D MSG Q
  1.  S X=$$CYFY^ECXUTL1(DT)
  1.  I ECLDT=$$FMADD^XLFDT($P(X,U,3),-1) D MSG Q
  1.  ;check if extract already queued to run
  1.  I $P(ECDATA,"^",6) D  Q
  1.  .F J=1:1 S X=$P($T(WARN+J),";",3,300) Q:X="QUIT"  W !,?5,X
  1.  .S DIR(0)="YA",DIR("A")="Do you wish to proceed? ",DIR("B")="N" K DIRUT,DUOUT,DTOUT
  1.  .D ^DIR K DIR
  1.  .I Y D QUEUE
  1.  D QUEUE
  1.  Q
  1.  ;
  1. QUEUE ;queue thru taskmanager
  1.  N ZTIO,ZTRTN,ZTDESC,ZTDTH,OUT,MONTH
  1.  D MES^XPDUTL(" ")
  1.  S OUT=0
  1.  F  D  Q:OUT
  1.  .D MES^XPDUTL(" ")
  1.  .S %DT="AEXR",%DT(0)=$$NOW^XLFDT+.0002,%DT("A")="Queue to run at what date/time?  "
  1.  .D ^%DT K %DT
  1.  .S ECD=Y
  1.  .I ECD<0 S OUT=1
  1.  .I $E(ECD,6,7)>28 D  Q
  1.  ..D MES^XPDUTL(" ")
  1.  ..D MES^XPDUTL("Monthly extracts must be queued for a date not greater than the 28th.")
  1.  ..D MES^XPDUTL(" ")
  1.  .S OUT=1
  1.  I ECD>DT D
  1.  .S:'$D(ECINST) ECINST=+$P(^ECX(728,1,0),U)
  1.  .S ECXINST=ECINST
  1.  .K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
  1.  .D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
  1.  .;get last date for all extracts except prosthetics
  1.  .I ECGRP'="PRO" D
  1.  ..S ECLDT=$S($D(^ECX(728,1,ECNODE)):$P(^(ECNODE),U,ECPIECE),1:2610624)
  1.  .;get last date for prosthetics
  1.  .I ECGRP="PRO" D
  1.  ..S ECLDT=""
  1.  ..S ECXDA1=$O(^ECX(728,0))
  1.  ..I $D(^ECX(728,ECXDA1,1,ECXINST,0)) S ECLDT=$P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
  1.  .;ecldt should be valid so continue
  1.  .I ECLDT D  Q:'$G(Y)  Q:$D(DIRUT)
  1.  ..S ECFDT=$$LASTMON(ECD)
  1.  ..;change to 1st day of month
  1.  ..S $E(ECFDT,6,7)="01"
  1.  ..S ECDIF=$$FMDIFF^XLFDT(ECFDT,ECLDT)
  1.  ..Q:ECDIF=1
  1.  ..S Y=$E(ECFDT,1,5)_"00" D DD^%DT S MONTH=Y K Y
  1.  ..D MES^XPDUTL(" ")
  1.  ..D MES^XPDUTL("The last date for the "_ECHEAD_" extract was "_$$FMTE^XLFDT(ECLDT)_".")
  1.  ..D MES^XPDUTL(" ")
  1.  ..D MES^XPDUTL("When the extract is run using the queue date/time you supplied, data")
  1.  ..D MES^XPDUTL("for the month of "_MONTH_" will be extracted.")
  1.  ..D MES^XPDUTL(" ")
  1.  ..I ECDIF>1 D MES^XPDUTL("It appears that there is a period of time for which data will not be extracted.")
  1.  ..I ECDIF<0 D MES^XPDUTL("It appears that you may be duplicating previously extracted data.")
  1.  ..D MES^XPDUTL(" ")
  1.  ..S DIR(0)="YA",DIR("A")="Do you wish to proceed? ",DIR("B")="N" K DIRUT,DUOUT,DTOUT
  1.  ..D ^DIR K DIR
  1.  .S ZTRTN="QUE^"_ECROU,ZTDESC=ECPACK_" EXTRACT",ZTIO="",ZTDTH=ECD
  1.  .D ^%ZTLOAD
  1.  .I $G(ZTSK) D
  1.  ..S $P(^ECX(727.1,ECDA,0),"^",6)=1
  1.  ..D MES^XPDUTL(" ")
  1.  ..D MES^XPDUTL("Request queued as Task #"_ZTSK)
  1.  ..D MES^XPDUTL("with automatic monthly requeue.")
  1.  ..D MES^XPDUTL(" ")
  1.  ..I $E(IOST)="C" D
  1.  ...S SS=22-$Y F JJ=1:1:SS W !
  1.  ...S DIR(0)="E" W ! D ^DIR K DIR
  1.  K ECD,ECDA,ECDATA,ECDIF,ECF,ECFDT,ECFILE,ECGRP,ECHEAD,ECLDT,ECPIECE,ECPACK,ECROU,ECINST,ECNODE,ECXDA1,ECXINST
  1.  Q
  1.  ;
  1. WARN ;
  1.  ;;  
  1.  ;;It appears that the extract has already been queued to run.  If you make 
  1.  ;;changes now, there is a possibility that data for a particular date range
  1.  ;;may be omitted from the extract process and not transmitted to AAC.
  1.  ;; 
  1.  ;;Before continuing, you should carefully review the extract history for
  1.  ;;this extract.  You should also verify that this extract is not currently
  1.  ;;queued to run in the future.
  1.  ;;  
  1.  ;;QUIT
  1.  ;
  1. MSG ;
  1.  D MES^XPDUTL(" ")
  1.  I ECLDT="" D
  1.  .D MES^XPDUTL("Automatic requeue may not be setup for a DSS extract")
  1.  .D MES^XPDUTL("which has never been previously generated.")
  1.  I ECLDT D
  1.  .D MES^XPDUTL("Automatic requeue may not be setup to generate the October")
  1.  .D MES^XPDUTL("extract of the current fiscal year.")
  1.  D MES^XPDUTL(" ")
  1.  D MES^XPDUTL("Please use the appropriate option on the Package Extracts")
  1.  D MES^XPDUTL("menu to generate the first monthly "_ECHEAD_" extract of")
  1.  D MES^XPDUTL("the current fiscal year.  Exiting...")
  1.  D MES^XPDUTL(" ")
  1.  I $E(IOST)="C" D
  1.  .S SS=22-$Y F JJ=1:1:SS W !
  1.  .S DIR(0)="E" W ! D ^DIR K DIR
  1.  Q
  1.  ;
  1. NEXTMON(ECXDATE) ;get date for date+(1 month)
  1.  ;input ECXDATE = FM date or date/time [required]
  1.  ;                where day of month is cannot be greater than 28
  1.  ;output returns FM date or date/time; next month, but same day of month
  1.  N DATE,ECXNEXT,X1,X2,X
  1.  S DATE=$P(ECXDATE,".")
  1.  I +$E(DATE,6,7)>28 S $E(DATE,6,7)="28"
  1.  S X1=DATE,X2=30 D C^%DTC
  1.  S ECXNEXT=X
  1.  I $E(ECXNEXT,6,7)'=$E(ECXDATE,6,7) S $E(ECXNEXT,6,7)=$E(ECXDATE,6,7)
  1.  I $P(ECXDATE,".",2) S $P(ECXNEXT,".",2)=$P(ECXDATE,".",2)
  1.  Q ECXNEXT
  1.  ;
  1. LASTMON(ECXDATE) ;get last day of previous month
  1.  ;input ECXDATE = FM date or date/time [required]
  1.  ;output returns FM date; previous month, last day of month
  1.  N DATE,ECXLAST,X1,X2,X
  1.  S DATE=$P(ECXDATE,"."),DATE=$E(DATE,1,5)_"01"
  1.  S X1=DATE,X2=-1 D C^%DTC
  1.  S ECXLAST=X
  1.  Q ECXLAST