ECXTAUTO ;ALB/JAP,BIR/DMA-Background Queuing for Package Extracts ; 17 Mar 95 / 1:04 PM
;;3.0;DSS EXTRACTS;**8,24,49**;Dec 22, 1997
;generate extract & auto-requeue
;
QUE ;entry point from package extracts - determine start and stop date from 727.1
;and variables from setup^routine
S EC=$O(^ECX(727.1,"AF",ECFILE,0))
S ECDT=$P($$HTFM^XLFDT(ZTDTH,1),".")
S ECED=$$LASTMON^ECXDEFIN(ECDT)
S ECSD=$E(ECED,1,5)_"01"
I '$D(ECNODE) S ECNODE=7
;get station number; ecinst is defined only for prosthetics
;automatic requeue can be setup only for site's with 1 primary prosthetics division
S:'$D(ECINST) ECINST=+$P(^ECX(728,1,0),U)
S ECXINST=ECINST
K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
;check if currently running
I $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R" D RUNMSG,REQUE Q
;check if date range has been extracted
;get last date for all extracts except prosthetics
I ECGRP'="PRO" D
.S ECLDT=$P($G(^ECX(728,1,ECNODE)),U,ECPIECE)
;get last date for prosthetics
I ECGRP="PRO" D
.S ECLDT=""
.S ECXDA1=$O(^ECX(728,0))
.I $D(^ECX(728,ECXDA1,1,ECXINST,0)) S ECLDT=$P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
;if last run date doesn't exist don't allow auto requeue to continue
I ECLDT="" S ZTREQ="@" Q
;if last run date is last day of previous fy don't allow auto requeue to continue
S X=$$CYFY^ECXUTL1(DT)
I ECLDT=$$FMADD^XLFDT($P(X,U,3),-1) S ZTREQ="@" Q
;otherwise continue to check data range
S ECFDT=$$FMADD^XLFDT(ECLDT,1)
I ECFDT>ECED D ERROR,REQUE Q
;do specific extract using appropriate fiscal year logic
S ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.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)
S ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$E(ECED,1,7)
S ^ECX(727,EC,"HEAD")=ECHEAD
S ^ECX(727,EC,"FILE")=ECFILE
S ^ECX(727,EC,"GRP")=ECGRP
S ^ECX(727,EC,"VER")=$G(ECVER)_U_ECXLOGIC
S ^ECX(727,EC,"DIV")=ECXINST
S DA=EC,DIK="^ECX(727," D IX^DIK K DIK,DA
S ECRN=0,ECXYM=$$ECXYM^ECXUTL(ECED),EC23=ECXYM_U_EC
S ECXSTART=$P($$HTE^XLFDT($H),":",1,2),ECXNOW=$H
D @ECRTN
;set last date for all extracts except prosthetics
S:(ECGRP'="PRO") $P(^ECX(728,1,ECNODE),U,ECPIECE)=$P(ECED,".")
;set last date for prosthetics
I ECGRP="PRO" D
.S J=$O(^ECX(728,0))
.S $P(^ECX(728,J,1,ECXINST,0),U,2)=$P(ECED,".")
S TIME=$P($$HTE^XLFDT($H),":",1,2)
S $P(^ECX(727,$P(EC23,U,2),0),U,6)=ECRN
;set piece 3 and 4 of the zero node
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
D MSG
S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)=""
D REQUE
Q
;
REQUE ;reque job for next time
S EC=$O(^ECX(727.1,"AF",ECFILE,0))
S ECFDT=$$HTFM^XLFDT(ZTDTH)
S ECFDT=$$NEXTMON^ECXDEFIN(ECFDT)
;do not allow october extract to start from auto-requeue
I $E(ECFDT,4,5)="10" D Q
.D FYMSG
.S $P(^ECX(727.1,ECDA,0),"^",6)=""
.S ZTREQ="@"
S ZTDTH=$$FMTH^XLFDT(ECFDT)
D REQ^%ZTLOAD
Q
;
MSG ; send message to mail group 'DSS-ECGRP'
S XMSUB=ECINST_" - "_ECPACK_" AUTO-REQUEUE EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
S ECMSG(1,0)="The BACKGROUND DSS-"_ECPACK_" extract (#"_$P(EC23,U,2)_") for "_ECSDN
S ECMSG(2,0)="through "_ECEDN_" was begun on "_$P(ECXSTART,"@")_" at "_$P(ECXSTART,"@",2)
S ECMSG(3,0)="and completed on "_$P(TIME,"@")_" at "_$P(TIME,"@",2)_"."
S ECMSG(4,0)=" "
S ECMSG(5,0)="A total of "_ECRN_" records were written."
S ECMSG(6,0)=" "
S ECMSG(7,0)="Extract time was [HH:MM:SS] "_$$HDIFF^XLFDT($H,ECXNOW,3)
S ECMSG(8,0)=" "
S X=$E(ECXLOGIC,5) S X=$S((X="")!(X=" "):"",1:"revision "_X_" of ")
S ECMSG(9,0)="The data was extracted using "_X_"fiscal year "_$E(ECXLOGIC,1,4)_" logic."
S ECMSG(10,0)=" "
S XMTEXT="ECMSG(" D ^XMD
Q
;
ERROR ; send message when job was queued to extract data already extracted
S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED)
S XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE",XMDUZ="DSS SYSTEM"
K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
S ECMSG(1,0)="The "_ECPACK_" extract was automatically requeued to extract"
S ECMSG(2,0)="data for "_ECSDN_" through "_ECEDN_"."
S ECMSG(3,0)="Data for this range of dates has already been extracted."
S ECMSG(4,0)=" "
S ECMSG(5,0)="The extract was NOT generated, but has been requeued to run"
S ECMSG(6,0)="next month. "
S XMTEXT="ECMSG(" D ^XMD
Q
;
FYMSG ; send message for october extract
S Y=$E(ECFDT,1,5)_"00" D DD^%DT
S XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE",XMDUZ="DSS SYSTEM"
K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
S ECMSG(1,0)="There was an attempt to automatically requeue the "_ECPACK
S ECMSG(2,0)="extract for the month of "_Y_"."
S ECMSG(3,0)=" "
S ECMSG(4,0)="The extract was NOT generated. The first extract of the new fiscal"
S ECMSG(5,0)="year will need to be queued to run after any required fiscal year"
S ECMSG(6,0)="update is installed."
S XMTEXT="ECMSG(" D ^XMD
Q
;
RUNMSG ;
S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED)
S XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE",XMDUZ="DSS SYSTEM"
K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
S ECMSG(1,0)="The "_ECPACK_" extract was automatically requeued to extract"
S ECMSG(2,0)="data for "_ECSDN_" through "_ECEDN_"."
S ECMSG(3,0)="But a "_ECHEAD_" extract appears to be currently running."
S ECMSG(4,0)=" "
S ECMSG(5,0)="The requeued extract was NOT generated, but has been requeued"
S ECMSG(6,0)="for next month."
S XMTEXT="ECMSG(" D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXTAUTO 5793 printed Nov 22, 2024@17:04:12 Page 2
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
+2 ;generate extract & auto-requeue
+3 ;
QUE ;entry point from package extracts - determine start and stop date from 727.1
+1 ;and variables from setup^routine
+2 SET EC=$ORDER(^ECX(727.1,"AF",ECFILE,0))
+3 SET ECDT=$PIECE($$HTFM^XLFDT(ZTDTH,1),".")
+4 SET ECED=$$LASTMON^ECXDEFIN(ECDT)
+5 SET ECSD=$EXTRACT(ECED,1,5)_"01"
+6 IF '$DATA(ECNODE)
SET ECNODE=7
+7 ;get station number; ecinst is defined only for prosthetics
+8 ;automatic requeue can be setup only for site's with 1 primary prosthetics division
+9 if '$DATA(ECINST)
SET ECINST=+$PIECE(^ECX(728,1,0),U)
+10 SET ECXINST=ECINST
+11 KILL ECXDIC
SET DA=ECINST
SET DIC="^DIC(4,"
SET DIQ(0)="I"
SET DIQ="ECXDIC"
SET DR=".01;99"
+12 DO EN^DIQ1
SET ECINST=$GET(ECXDIC(4,DA,99,"I"))
KILL DIC,DIQ,DA,DR,ECXDIC
+13 ;check if currently running
+14 IF $PIECE(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
DO RUNMSG
DO REQUE
QUIT
+15 ;check if date range has been extracted
+16 ;get last date for all extracts except prosthetics
+17 IF ECGRP'="PRO"
Begin DoDot:1
+18 SET ECLDT=$PIECE($GET(^ECX(728,1,ECNODE)),U,ECPIECE)
End DoDot:1
+19 ;get last date for prosthetics
+20 IF ECGRP="PRO"
Begin DoDot:1
+21 SET ECLDT=""
+22 SET ECXDA1=$ORDER(^ECX(728,0))
+23 IF $DATA(^ECX(728,ECXDA1,1,ECXINST,0))
SET ECLDT=$PIECE(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
End DoDot:1
+24 ;if last run date doesn't exist don't allow auto requeue to continue
+25 IF ECLDT=""
SET ZTREQ="@"
QUIT
+26 ;if last run date is last day of previous fy don't allow auto requeue to continue
+27 SET X=$$CYFY^ECXUTL1(DT)
+28 IF ECLDT=$$FMADD^XLFDT($PIECE(X,U,3),-1)
SET ZTREQ="@"
QUIT
+29 ;otherwise continue to check data range
+30 SET ECFDT=$$FMADD^XLFDT(ECLDT,1)
+31 IF ECFDT>ECED
DO ERROR
DO REQUE
QUIT
+32 ;do specific extract using appropriate fiscal year logic
+33 SET ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
+34 SET $PIECE(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
+35 SET ECSDN=$$FMTE^XLFDT(ECSD)
SET ECEDN=$$FMTE^XLFDT(ECED)
SET ECSD1=ECSD-.1
+36 LOCK +^ECX(727,0)
SET EC=$PIECE(^ECX(727,0),U,3)+1
SET $PIECE(^(0),U,3,4)=EC_U_EC
LOCK -^ECX(727,0)
+37 SET ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$EXTRACT(ECED,1,7)
+38 SET ^ECX(727,EC,"HEAD")=ECHEAD
+39 SET ^ECX(727,EC,"FILE")=ECFILE
+40 SET ^ECX(727,EC,"GRP")=ECGRP
+41 SET ^ECX(727,EC,"VER")=$GET(ECVER)_U_ECXLOGIC
+42 SET ^ECX(727,EC,"DIV")=ECXINST
+43 SET DA=EC
SET DIK="^ECX(727,"
DO IX^DIK
KILL DIK,DA
+44 SET ECRN=0
SET ECXYM=$$ECXYM^ECXUTL(ECED)
SET EC23=ECXYM_U_EC
+45 SET ECXSTART=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
SET ECXNOW=$HOROLOG
+46 DO @ECRTN
+47 ;set last date for all extracts except prosthetics
+48 if (ECGRP'="PRO")
SET $PIECE(^ECX(728,1,ECNODE),U,ECPIECE)=$PIECE(ECED,".")
+49 ;set last date for prosthetics
+50 IF ECGRP="PRO"
Begin DoDot:1
+51 SET J=$ORDER(^ECX(728,0))
+52 SET $PIECE(^ECX(728,J,1,ECXINST,0),U,2)=$PIECE(ECED,".")
End DoDot:1
+53 SET TIME=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
+54 SET $PIECE(^ECX(727,$PIECE(EC23,U,2),0),U,6)=ECRN
+55 ;set piece 3 and 4 of the zero node
+56 SET ECLAST=$ORDER(^ECX(ECFILE,99999999),-1)
SET ECTOTAL=$PIECE(^ECX(ECFILE,0),U,4)+ECRN
SET $PIECE(^(0),U,3,4)=ECLAST_U_ECTOTAL
KILL ECLAST,ECTOTAL
+57 DO MSG
+58 SET $PIECE(^ECX(728,1,ECNODE+.1),U,ECPIECE)=""
+59 DO REQUE
+60 QUIT
+61 ;
REQUE ;reque job for next time
+1 SET EC=$ORDER(^ECX(727.1,"AF",ECFILE,0))
+2 SET ECFDT=$$HTFM^XLFDT(ZTDTH)
+3 SET ECFDT=$$NEXTMON^ECXDEFIN(ECFDT)
+4 ;do not allow october extract to start from auto-requeue
+5 IF $EXTRACT(ECFDT,4,5)="10"
Begin DoDot:1
+6 DO FYMSG
+7 SET $PIECE(^ECX(727.1,ECDA,0),"^",6)=""
+8 SET ZTREQ="@"
End DoDot:1
QUIT
+9 SET ZTDTH=$$FMTH^XLFDT(ECFDT)
+10 DO REQ^%ZTLOAD
+11 QUIT
+12 ;
MSG ; send message to mail group 'DSS-ECGRP'
+1 SET XMSUB=ECINST_" - "_ECPACK_" AUTO-REQUEUE EXTRACT FOR DSS"
SET XMDUZ="DSS SYSTEM"
+2 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+3 SET ECMSG(1,0)="The BACKGROUND DSS-"_ECPACK_" extract (#"_$PIECE(EC23,U,2)_") for "_ECSDN
+4 SET ECMSG(2,0)="through "_ECEDN_" was begun on "_$PIECE(ECXSTART,"@")_" at "_$PIECE(ECXSTART,"@",2)
+5 SET ECMSG(3,0)="and completed on "_$PIECE(TIME,"@")_" at "_$PIECE(TIME,"@",2)_"."
+6 SET ECMSG(4,0)=" "
+7 SET ECMSG(5,0)="A total of "_ECRN_" records were written."
+8 SET ECMSG(6,0)=" "
+9 SET ECMSG(7,0)="Extract time was [HH:MM:SS] "_$$HDIFF^XLFDT($HOROLOG,ECXNOW,3)
+10 SET ECMSG(8,0)=" "
+11 SET X=$EXTRACT(ECXLOGIC,5)
SET X=$SELECT((X="")!(X=" "):"",1:"revision "_X_" of ")
+12 SET ECMSG(9,0)="The data was extracted using "_X_"fiscal year "_$EXTRACT(ECXLOGIC,1,4)_" logic."
+13 SET ECMSG(10,0)=" "
+14 SET XMTEXT="ECMSG("
DO ^XMD
+15 QUIT
+16 ;
ERROR ; send message when job was queued to extract data already extracted
+1 SET ECSDN=$$FMTE^XLFDT(ECSD)
SET ECEDN=$$FMTE^XLFDT(ECED)
+2 SET XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE"
SET XMDUZ="DSS SYSTEM"
+3 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+4 SET ECMSG(1,0)="The "_ECPACK_" extract was automatically requeued to extract"
+5 SET ECMSG(2,0)="data for "_ECSDN_" through "_ECEDN_"."
+6 SET ECMSG(3,0)="Data for this range of dates has already been extracted."
+7 SET ECMSG(4,0)=" "
+8 SET ECMSG(5,0)="The extract was NOT generated, but has been requeued to run"
+9 SET ECMSG(6,0)="next month. "
+10 SET XMTEXT="ECMSG("
DO ^XMD
+11 QUIT
+12 ;
FYMSG ; send message for october extract
+1 SET Y=$EXTRACT(ECFDT,1,5)_"00"
DO DD^%DT
+2 SET XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE"
SET XMDUZ="DSS SYSTEM"
+3 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+4 SET ECMSG(1,0)="There was an attempt to automatically requeue the "_ECPACK
+5 SET ECMSG(2,0)="extract for the month of "_Y_"."
+6 SET ECMSG(3,0)=" "
+7 SET ECMSG(4,0)="The extract was NOT generated. The first extract of the new fiscal"
+8 SET ECMSG(5,0)="year will need to be queued to run after any required fiscal year"
+9 SET ECMSG(6,0)="update is installed."
+10 SET XMTEXT="ECMSG("
DO ^XMD
+11 QUIT
+12 ;
RUNMSG ;
+1 SET ECSDN=$$FMTE^XLFDT(ECSD)
SET ECEDN=$$FMTE^XLFDT(ECED)
+2 SET XMSUB=ECINST_" - "_ECPACK_" BACKGROUND EXTRACT FAILURE"
SET XMDUZ="DSS SYSTEM"
+3 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+4 SET ECMSG(1,0)="The "_ECPACK_" extract was automatically requeued to extract"
+5 SET ECMSG(2,0)="data for "_ECSDN_" through "_ECEDN_"."
+6 SET ECMSG(3,0)="But a "_ECHEAD_" extract appears to be currently running."
+7 SET ECMSG(4,0)=" "
+8 SET ECMSG(5,0)="The requeued extract was NOT generated, but has been requeued"
+9 SET ECMSG(6,0)="for next month."
+10 SET XMTEXT="ECMSG("
DO ^XMD
+11 QUIT
