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

ECXTAUTO.m

Go to the documentation of this file. 
  1. ECXTAUTO ;ALB/JAP,BIR/DMA-Background Queuing for Package Extracts ; 17 Mar 95 / 1:04 PM
  1.  ;;3.0;DSS EXTRACTS;**8,24,49**;Dec 22, 1997
  1.  ;generate extract & auto-requeue
  1.  ;
  1. QUE ;entry point from package extracts - determine start and stop date from 727.1
  1.  ;and variables from setup^routine
  1.  S EC=$O(^ECX(727.1,"AF",ECFILE,0))
  1.  S ECDT=$P($$HTFM^XLFDT(ZTDTH,1),".")
  1.  S ECED=$$LASTMON^ECXDEFIN(ECDT)
  1.  S ECSD=$E(ECED,1,5)_"01"
  1.  I '$D(ECNODE) S ECNODE=7
  1.  ;get station number; ecinst is defined only for prosthetics
  1.  ;automatic requeue can be setup only for site's with 1 primary prosthetics division
  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.  ;check if currently running
  1.  I $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R" D RUNMSG,REQUE Q
  1.  ;check if date range has been extracted
  1.  ;get last date for all extracts except prosthetics
  1.  I ECGRP'="PRO" D
  1.  .S ECLDT=$P($G(^ECX(728,1,ECNODE)),U,ECPIECE)
  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.  ;if last run date doesn't exist don't allow auto requeue to continue
  1.  I ECLDT="" S ZTREQ="@" Q
  1.  ;if last run date is last day of previous fy don't allow auto requeue to continue
  1.  S X=$$CYFY^ECXUTL1(DT)
  1.  I ECLDT=$$FMADD^XLFDT($P(X,U,3),-1) S ZTREQ="@" Q
  1.  ;otherwise continue to check data range
  1.  S ECFDT=$$FMADD^XLFDT(ECLDT,1)
  1.  I ECFDT>ECED D ERROR,REQUE Q
  1.  ;do specific extract using appropriate fiscal year logic
  1.  S ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
  1.  S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
  1.  S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1
  1.  L +^ECX(727,0) S EC=$P(^ECX(727,0),U,3)+1,$P(^(0),U,3,4)=EC_U_EC L -^ECX(727,0)
  1.  S ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$E(ECED,1,7)
  1.  S ^ECX(727,EC,"HEAD")=ECHEAD
  1.  S ^ECX(727,EC,"FILE")=ECFILE
  1.  S ^ECX(727,EC,"GRP")=ECGRP
  1.  S ^ECX(727,EC,"VER")=$G(ECVER)_U_ECXLOGIC
  1.  S ^ECX(727,EC,"DIV")=ECXINST
  1.  S DA=EC,DIK="^ECX(727," D IX^DIK K DIK,DA
  1.  S ECRN=0,ECXYM=$$ECXYM^ECXUTL(ECED),EC23=ECXYM_U_EC
  1.  S ECXSTART=$P($$HTE^XLFDT($H),":",1,2),ECXNOW=$H
  1.  D @ECRTN
  1.  ;set last date for all extracts except prosthetics
  1.  S:(ECGRP'="PRO") $P(^ECX(728,1,ECNODE),U,ECPIECE)=$P(ECED,".")
  1.  ;set last date for prosthetics
  1.  I ECGRP="PRO" D
  1.  .S J=$O(^ECX(728,0))
  1.  .S $P(^ECX(728,J,1,ECXINST,0),U,2)=$P(ECED,".")
  1.  S TIME=$P($$HTE^XLFDT($H),":",1,2)
  1.  S $P(^ECX(727,$P(EC23,U,2),0),U,6)=ECRN
  1.  ;set piece 3 and 4 of the zero node
  1.  S ECLAST=$O(^ECX(ECFILE,99999999),-1),ECTOTAL=$P(^ECX(ECFILE,0),U,4)+ECRN,$P(^(0),U,3,4)=ECLAST_U_ECTOTAL K ECLAST,ECTOTAL
  1.  D MSG
  1.  S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)=""
  1.  D REQUE
  1.  Q
  1.  ;
  1. REQUE ;reque job for next time
  1.  S EC=$O(^ECX(727.1,"AF",ECFILE,0))
  1.  S ECFDT=$$HTFM^XLFDT(ZTDTH)
  1.  S ECFDT=$$NEXTMON^ECXDEFIN(ECFDT)
  1.  ;do not allow october extract to start from auto-requeue
  1.  I $E(ECFDT,4,5)="10" D  Q
  1.  .D FYMSG
  1.  .S $P(^ECX(727.1,ECDA,0),"^",6)=""
  1.  .S ZTREQ="@"
  1.  S ZTDTH=$$FMTH^XLFDT(ECFDT)
  1.  D REQ^%ZTLOAD
  1.  Q
  1.  ;
  1. MSG ; send message to mail group 'DSS-ECGRP'
  1.  S XMSUB=ECINST_" - "_ECPACK_" AUTO-REQUEUE EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
  1.  K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
  1.  S ECMSG(1,0)="The BACKGROUND DSS-"_ECPACK_" extract (#"_$P(EC23,U,2)_") for "_ECSDN
  1.  S ECMSG(2,0)="through "_ECEDN_" was begun on "_$P(ECXSTART,"@")_" at "_$P(ECXSTART,"@",2)
  1.  S ECMSG(3,0)="and completed on "_$P(TIME,"@")_" at "_$P(TIME,"@",2)_"."
  1.  S ECMSG(4,0)=" "
  1.  S ECMSG(5,0)="A total of "_ECRN_" records were written."
  1.  S ECMSG(6,0)=" "
  1.  S ECMSG(7,0)="Extract time was [HH:MM:SS] "_$$HDIFF^XLFDT($H,ECXNOW,3)
  1.  S ECMSG(8,0)=" "
  1.  S X=$E(ECXLOGIC,5) S X=$S((X="")!(X=" "):"",1:"revision "_X_" of ")
  1.  S ECMSG(9,0)="The data was extracted using "_X_"fiscal year "_$E(ECXLOGIC,1,4)_" logic."
  1.  S ECMSG(10,0)=" "
  1.  S XMTEXT="ECMSG(" D ^XMD
  1.  Q
  1.  ;
  1. ERROR ; send message when job was queued to extract data already extracted
  1.  S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED)
  1.  S XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE",XMDUZ="DSS SYSTEM"
  1.  K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
  1.  S ECMSG(1,0)="The "_ECPACK_" extract was automatically requeued to extract"
  1.  S ECMSG(2,0)="data for "_ECSDN_" through "_ECEDN_"."
  1.  S ECMSG(3,0)="Data for this range of dates has already been extracted."
  1.  S ECMSG(4,0)=" "
  1.  S ECMSG(5,0)="The extract was NOT generated, but has been requeued to run"
  1.  S ECMSG(6,0)="next month. "
  1.  S XMTEXT="ECMSG(" D ^XMD
  1.  Q
  1.  ;
  1. FYMSG ; send message for october extract
  1.  S Y=$E(ECFDT,1,5)_"00" D DD^%DT
  1.  S XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE",XMDUZ="DSS SYSTEM"
  1.  K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
  1.  S ECMSG(1,0)="There was an attempt to automatically requeue the "_ECPACK
  1.  S ECMSG(2,0)="extract for the month of "_Y_"."
  1.  S ECMSG(3,0)=" "
  1.  S ECMSG(4,0)="The extract was NOT generated.  The first extract of the new fiscal"
  1.  S ECMSG(5,0)="year will need to be queued to run after any required fiscal year"
  1.  S ECMSG(6,0)="update is installed."
  1.  S XMTEXT="ECMSG(" D ^XMD
  1.  Q
  1.  ;
  1. RUNMSG ;
  1.  S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED)
  1.  S XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE",XMDUZ="DSS SYSTEM"
  1.  K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
  1.  S ECMSG(1,0)="The "_ECPACK_" extract was automatically requeued to extract"
  1.  S ECMSG(2,0)="data for "_ECSDN_" through "_ECEDN_"."
  1.  S ECMSG(3,0)="But a "_ECHEAD_" extract appears to be currently running."
  1.  S ECMSG(4,0)=" "
  1.  S ECMSG(5,0)="The requeued extract was NOT generated, but has been requeued"
  1.  S ECMSG(6,0)="for next month."
  1.  S XMTEXT="ECMSG(" D ^XMD
  1.  Q