ECXTRAC ;ALB/GTS,JAP,BIR/DMA,CML-Package Extracts for DSS ;5/28/24 10:00
;;3.0;DSS EXTRACTS;**9,8,14,24,30,33,49,84,105,144,161,190**;Dec 22, 1997;Build 36
;Date range, queuing and message sending for package extracts
;Input
; ECPACK printed name of package (e.g. Lab, Prescriptions)
; ECNODE in file 728 where last date is stored
; ECPIECE piece of node where last date is stored
; ECRTN in the form of START^ROUTINE
; ECGRP name of local mail group to receive summary message
; (MUST BE 1 TO 5 UPPER CASE ALPHA - NO SPACES)
; ECFILE file number of the local editing file
; ECXLOGIC Fiscal year extract logic to use (optional)
; ECXDATES StartDate^EndDate^DoNotUpdate728 (optional)
;Generates
; EC23=2nd and 3rd piece of zero node in local editing file
; =YYMM of end date^pointer to 727
; ECXLOGIC=Fiscal year extract logic to use
;
EN ;entry point
N OUT,CHKFLG,RUN ;144
I '$D(ECNODE) S ECNODE=7
I '$D(ECHEAD) S ECHEAD=" "
I $P($G(^ECX(728,1,ECNODE+.1)),U,ECPIECE)]"" D I '$G(RUN) Q ;144
.W !!,$C(7),ECPACK," extract is already running or is scheduled to run.",!! ;144
.S RUN=$$RUSURE(1) ;144
.;D PAUSE
W @IOF,!,"Extract ",ECPACK," Information for DSS",!!
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
;* get last date for all extracts except prosthetics
I ECGRP'="PRO" D
.S ECLDT=$S($D(^ECX(728,1,ECNODE)):$P(^(ECNODE),U,ECPIECE),1:2610624)
.S:ECLDT="" ECLDT=2610624
;* get last date for prosthetics
I ECGRP="PRO" D
.N ECXDA1
.S ECXDA1=$O(^ECX(728,0))
.I $D(^ECX(728,ECXDA1,1,ECXINST,0)) D
..S ECLDT=$P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
.I '$D(^ECX(728,ECXDA1,1,ECXINST,0)) D
..S DA(1)=ECXDA1
..S DIC(0)="L" K ECXDD
..D FIELD^DID(728,59,,"SPECIFIER","ECXDD")
..S DIC("P")=ECXDD("SPECIFIER") K ECXDD
..S DIC="^ECX(728,"_DA(1)_",1,",X=ECXINST,DINUM=X
..K DD,DO D FILE^DICN
..K DIC,X,DINUM,Y,DA
..S ECLDT=2610624
S X=$G(ECXDATES) S ECSD=$P(X,"^",1),ECED=$P(X,"^",2)
S OUT=0
I (ECSD="")!(ECED="") F S (ECED,ECSD)="" D Q:OUT
.K %DT S %DT="AEX",%DT("A")="Starting with Date: " D ^%DT
.I Y<0 S OUT=1 Q
.S ECSD=Y
.K %DT S %DT="AEX",%DT("A")="Ending with Date: " D ^%DT
.I Y<0 S OUT=1 Q
.I Y<ECSD D Q
..W !!,"The ending date cannot be earlier than the starting date."
..W !,"Please try again.",!!
.I $E(Y,1,5)'=$E(ECSD,1,5) D Q
..W !!,"Beginning and ending dates must be in the same month and year."
..W !,"Please try again.",!!
.S ECED=Y
.I ECLDT'<ECSD D I '$G(RUN) Q ;144
..W !!,"The ",ECPACK," information has already been extracted " W:$L(ECPACK)>10 ! W "through ",$$FMTE^XLFDT(ECLDT),"." ;144
..S RUN=$$RUSURE(2) Q:$G(RUN) W ! ;144
..W !,"Please enter a new date range.",!!
.S OUT=1
I ECED]"",ECSD]"" D QUE
Q
;
QUE ;queue extract
N CHKFLG
;if extract is ivp (i.e., file=727.819) and data in the intermediate file use new format
I ECFILE=727.819 D Q:CHKFLG
.S CHKFLG=0
.S X="PSIVSTAT" X ^%ZOSF("TEST") I '$T Q
.I '$D(^ECX(728.113,"A")) S CHKFLG=1 D NOIVP Q
.S DATE=$O(^ECX(728.113,"A",ECED+1),-1) I DATE<ECSD S CHKFLG=1 D NOIVP Q
.D CHK^ECXDIVIV Q:CHKFLG
.D CHK2
.S ECRTN="START^ECXPIVDN",ECVER=7
I '$D(ECNODE) S ECNODE=7
I '$D(ECHEAD) S ECHEAD=""
S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1
K ZTSAVE
F X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN" S ZTSAVE(X)=""
F X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE" S ZTSAVE(X)=""
F X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST" S ZTSAVE(X)=""
F X="ECXLOGIC","ECXDATES" S ZTSAVE(X)=""
S ZTDESC=ECPACK_" EXTRACT: "_ECSDN_" TO "_ECEDN,ZTRTN="START^ECXTRAC",ZTIO=""
D ^%ZTLOAD
I $D(ZTSK) D
.S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
.S ^XTMP("ECX EXTRACT",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^TASK INFORMATION FOR EXTRACTS" ;144,161 Update zero node for task information in XTMP
.S ^XTMP("ECX EXTRACT",ECHEAD)=ZTSK_"^"_$G(DUZ)_"^"_$G(ZTSK("D"))_"^"_ECSD_"^"_ECED ;144 Save data related to task
.; Append Extract Job # to ^XTMP entry tjl ECX*3*190
.N ECXIEN S ECXIEN=+$O(^ECX(727.1,"C",ECHEAD,0))
.S ^XTMP("ECX EXTRACT",ECHEAD)=^XTMP("ECX EXTRACT",ECHEAD)_"^"_ECXIEN
.W !,"Request queued as Task #",ZTSK,".",!
.D PAUSE
Q
;
NOIVP ;cannot generate ivp message
W !!,?5,"There does not appear to be any data in the IV EXTRACT DATA"
W !,?5,"file (#728.113) for the selected date range."
W !!,?5,"The IVP extract cannot be generated."
D PAUSE
Q
;
START ; entry when queued
S QFLG=0
L +^ECX(727,0):3 Q:'$T S EC=$P(^ECX(727,0),U,3)+1,$P(^(0),U,3,4)=EC_U_EC L -^ECX(727,0) ;144 Added time out to lock as required by standard
S ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$E(ECED,1,7)_U_U_DUZ
S ^ECX(727,EC,"HEAD")=ECHEAD
S:ECFILE=727.816 ECFILE=727.827 S ^ECX(727,EC,"FILE")=ECFILE
S ^ECX(727,EC,"GRP")=ECGRP
I $G(ECXLOGIC)="" S ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
S ^ECX(727,EC,"VER")=$G(ECVER)_"^"_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
;do specific extract
D @ECRTN
;if task gets stop request, set ztstop and quit
I QFLG D Q
.S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="",ZTSTOP=1
.K ^XTMP("ECX EXTRACT",ECHEAD) ;144 Delete queued information if stopped by user
.D QKILL
.D QMSG
.D ^ECXKILL
;Set last date for extract
I '$P($G(ECXDATES),"^",3) D
.;* set last date for all extracts except prosthetics
.I ECGRP'="PRO" S $P(^ECX(728,1,ECNODE),U,ECPIECE)=$P(ECED,".") Q
.;* set last date for prosthetics
.N ECXDA1
.S ECXDA1=$O(^ECX(728,0))
.S $P(^ECX(728,ECXDA1,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)=""
K ^XTMP("ECX EXTRACT",ECHEAD) ;144 Delete queued information if processing completed normally
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
MSG ; send message to mail group 'DSS-ECGRP'
S XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
S ECMSG(1,0)="The 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
;
QMSG ; send abort message to mail group 'DSS-ECGRP'
S XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
S ECMSG(1,0)="The 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)=" "
S ECMSG(4,0)="A user stop request was received by Taskmanager which caused processing"
S ECMSG(5,0)="to terminate before completion. Any records which may have been created"
S ECMSG(6,0)="in file #"_ECFILE_" for this extract have been deleted."
S ECMSG(7,0)=" "
S XMTEXT="ECMSG("
D ^XMD
Q
;
QKILL ;delete records created for any extract stopped at user request
N ECX,FILE,IEN,DA,DIK
S FILE="^ECX("_ECFILE_","
S ECX=$P(EC23,U,2)
F S IEN=$O(^ECX(ECFILE,999999999),-1) Q:($P(^ECX(ECFILE,IEN,0),U,3)'=ECX) D
.S DIK=FILE,DA=IEN D ^DIK
Q
;
CHK2 ;iv extract check - all active iv rooms to have a division
S EC=0
D ALL^PSJ59P5(,"??","ECXIV")
F S EC=$O(^TMP($J,"ECXIV",EC)) Q:'EC I '^(EC,19) D I CHKFLG D EXIT Q
.S CHKFLG=$S($G(^TMP($J,"ECXIV",EC,19)):1,$G(^(19))>DT:1,1:0)
.I CHKFLG D
..W !!,"All active IV Rooms in the IV Room file (#59.5) must have a ""DIVISION""",!,"assigned to run this extract!"
..W !!,"This information can be entered using the DSS Extract Manager's Maintenance ",!,"option ""Enter/Edit IV Room Division""."
..D PAUSE
EXIT K ^TMP($J,"ECXIV")
Q
;
PAUSE ;pause screen
N DIR,X,Y
S OUT=0
I $E(IOST)="C" D
.S SS=22-$Y F JJ=1:1:SS W !
.S DIR(0)="E" W ! D ^DIR K DIR
I 'Y S OUT=1
W !!
Q
;API added in patch 144
RUSURE(TYPE) ;Allow user to override running node or bypass last date run checks
N DIR,Y,ZTSK,USER,QUE,NODE,STDT,EDDT
I TYPE=1 D
.S NODE=$G(^XTMP("ECX EXTRACT",ECHEAD))
.S ZTSK=$P(NODE,U),USER=$$GET1^DIQ(200,$P(NODE,U,2),.01),QUE=$$HTE^XLFDT($P(NODE,U,3)),STDT=$$FMTE^XLFDT($P(NODE,U,4)),EDDT=$$FMTE^XLFDT($P(NODE,U,5))
.I ZTSK D STAT^%ZTLOAD D W !
..W "Task Information: ",!,$$REPEAT^XLFSTR("-",17),!,"Task #: ",ZTSK,!,"Queued by: ",USER,!,"Extract date range: ",STDT," to ",EDDT,!,"Status: "
..I '$G(ZTSK(0))!(ZTSK(1)=0) W "Task deleted, no further information available."
..I ZTSK(1)=1 W "ACTIVE - Task is scheduled to start on ",QUE
..I ZTSK(1)=2 W "ACTIVE - Task is currently running and started on ",QUE
..I ZTSK(1)=5 W "INACTIVE - Task ended abnormally"
..I ZTSK(1)=1!(ZTSK(1)=2) W !!,"**Before continuing, the ",$G(ECHEAD)," extract should be ",$S(ZTSK(1)=1:"deleted",1:"stopped")," in TaskManager.",!,"Failure to do so may result in multiple ",$G(ECHEAD)," extracts running simultaneously**."
..I ZTSK(1)=5 W !!,"Be sure any errors or issues have been addressed before overriding this status",!,"and starting another ",$G(ECHEAD)," extract."
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to continue processing the "_$G(ECHEAD)_" extract"
D ^DIR
I '+Y Q 0
W !
S DIR("A")="Are you SURE you want to run the "_$G(ECHEAD)_" extract"
I TYPE=2 S DIR("A",1)="Make sure you have checked that your selected dates are correct",DIR("A",2)="before answering yes to the next question.",DIR("A",3)=""
D ^DIR
Q +Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXTRAC 10313 printed Dec 13, 2024@01:54:05 Page 2
ECXTRAC ;ALB/GTS,JAP,BIR/DMA,CML-Package Extracts for DSS ;5/28/24 10:00
+1 ;;3.0;DSS EXTRACTS;**9,8,14,24,30,33,49,84,105,144,161,190**;Dec 22, 1997;Build 36
+2 ;Date range, queuing and message sending for package extracts
+3 ;Input
+4 ; ECPACK printed name of package (e.g. Lab, Prescriptions)
+5 ; ECNODE in file 728 where last date is stored
+6 ; ECPIECE piece of node where last date is stored
+7 ; ECRTN in the form of START^ROUTINE
+8 ; ECGRP name of local mail group to receive summary message
+9 ; (MUST BE 1 TO 5 UPPER CASE ALPHA - NO SPACES)
+10 ; ECFILE file number of the local editing file
+11 ; ECXLOGIC Fiscal year extract logic to use (optional)
+12 ; ECXDATES StartDate^EndDate^DoNotUpdate728 (optional)
+13 ;Generates
+14 ; EC23=2nd and 3rd piece of zero node in local editing file
+15 ; =YYMM of end date^pointer to 727
+16 ; ECXLOGIC=Fiscal year extract logic to use
+17 ;
EN ;entry point
+1 ;144
NEW OUT,CHKFLG,RUN
+2 IF '$DATA(ECNODE)
SET ECNODE=7
+3 IF '$DATA(ECHEAD)
SET ECHEAD=" "
+4 ;144
IF $PIECE($GET(^ECX(728,1,ECNODE+.1)),U,ECPIECE)]""
Begin DoDot:1
+5 ;144
WRITE !!,$CHAR(7),ECPACK," extract is already running or is scheduled to run.",!!
+6 ;144
SET RUN=$$RUSURE(1)
+7 ;D PAUSE
End DoDot:1
IF '$GET(RUN)
QUIT
+8 WRITE @IOF,!,"Extract ",ECPACK," Information for DSS",!!
+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 ;* get last date for all extracts except prosthetics
+14 IF ECGRP'="PRO"
Begin DoDot:1
+15 SET ECLDT=$SELECT($DATA(^ECX(728,1,ECNODE)):$PIECE(^(ECNODE),U,ECPIECE),1:2610624)
+16 if ECLDT=""
SET ECLDT=2610624
End DoDot:1
+17 ;* get last date for prosthetics
+18 IF ECGRP="PRO"
Begin DoDot:1
+19 NEW ECXDA1
+20 SET ECXDA1=$ORDER(^ECX(728,0))
+21 IF $DATA(^ECX(728,ECXDA1,1,ECXINST,0))
Begin DoDot:2
+22 SET ECLDT=$PIECE(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
End DoDot:2
+23 IF '$DATA(^ECX(728,ECXDA1,1,ECXINST,0))
Begin DoDot:2
+24 SET DA(1)=ECXDA1
+25 SET DIC(0)="L"
KILL ECXDD
+26 DO FIELD^DID(728,59,,"SPECIFIER","ECXDD")
+27 SET DIC("P")=ECXDD("SPECIFIER")
KILL ECXDD
+28 SET DIC="^ECX(728,"_DA(1)_",1,"
SET X=ECXINST
SET DINUM=X
+29 KILL DD,DO
DO FILE^DICN
+30 KILL DIC,X,DINUM,Y,DA
+31 SET ECLDT=2610624
End DoDot:2
End DoDot:1
+32 SET X=$GET(ECXDATES)
SET ECSD=$PIECE(X,"^",1)
SET ECED=$PIECE(X,"^",2)
+33 SET OUT=0
+34 IF (ECSD="")!(ECED="")
FOR
SET (ECED,ECSD)=""
Begin DoDot:1
+35 KILL %DT
SET %DT="AEX"
SET %DT("A")="Starting with Date: "
DO ^%DT
+36 IF Y<0
SET OUT=1
QUIT
+37 SET ECSD=Y
+38 KILL %DT
SET %DT="AEX"
SET %DT("A")="Ending with Date: "
DO ^%DT
+39 IF Y<0
SET OUT=1
QUIT
+40 IF Y<ECSD
Begin DoDot:2
+41 WRITE !!,"The ending date cannot be earlier than the starting date."
+42 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+43 IF $EXTRACT(Y,1,5)'=$EXTRACT(ECSD,1,5)
Begin DoDot:2
+44 WRITE !!,"Beginning and ending dates must be in the same month and year."
+45 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+46 SET ECED=Y
+47 ;144
IF ECLDT'<ECSD
Begin DoDot:2
+48 ;144
WRITE !!,"The ",ECPACK," information has already been extracted "
if $LENGTH(ECPACK)>10
WRITE !
WRITE "through ",$$FMTE^XLFDT(ECLDT),"."
+49 ;144
SET RUN=$$RUSURE(2)
if $GET(RUN)
QUIT
WRITE !
+50 WRITE !,"Please enter a new date range.",!!
End DoDot:2
IF '$GET(RUN)
QUIT
+51 SET OUT=1
End DoDot:1
if OUT
QUIT
+52 IF ECED]""
IF ECSD]""
DO QUE
+53 QUIT
+54 ;
QUE ;queue extract
+1 NEW CHKFLG
+2 ;if extract is ivp (i.e., file=727.819) and data in the intermediate file use new format
+3 IF ECFILE=727.819
Begin DoDot:1
+4 SET CHKFLG=0
+5 SET X="PSIVSTAT"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+6 IF '$DATA(^ECX(728.113,"A"))
SET CHKFLG=1
DO NOIVP
QUIT
+7 SET DATE=$ORDER(^ECX(728.113,"A",ECED+1),-1)
IF DATE<ECSD
SET CHKFLG=1
DO NOIVP
QUIT
+8 DO CHK^ECXDIVIV
if CHKFLG
QUIT
+9 DO CHK2
+10 SET ECRTN="START^ECXPIVDN"
SET ECVER=7
End DoDot:1
if CHKFLG
QUIT
+11 IF '$DATA(ECNODE)
SET ECNODE=7
+12 IF '$DATA(ECHEAD)
SET ECHEAD=""
+13 SET ECSDN=$$FMTE^XLFDT(ECSD)
SET ECEDN=$$FMTE^XLFDT(ECED)
SET ECSD1=ECSD-.1
+14 KILL ZTSAVE
+15 FOR X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN"
SET ZTSAVE(X)=""
+16 FOR X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE"
SET ZTSAVE(X)=""
+17 FOR X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST"
SET ZTSAVE(X)=""
+18 FOR X="ECXLOGIC","ECXDATES"
SET ZTSAVE(X)=""
+19 SET ZTDESC=ECPACK_" EXTRACT: "_ECSDN_" TO "_ECEDN
SET ZTRTN="START^ECXTRAC"
SET ZTIO=""
+20 DO ^%ZTLOAD
+21 IF $DATA(ZTSK)
Begin DoDot:1
+22 SET $PIECE(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
+23 ;144,161 Update zero node for task information in XTMP
SET ^XTMP("ECX EXTRACT",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^TASK INFORMATION FOR EXTRACTS"
+24 ;144 Save data related to task
SET ^XTMP("ECX EXTRACT",ECHEAD)=ZTSK_"^"_$GET(DUZ)_"^"_$GET(ZTSK("D"))_"^"_ECSD_"^"_ECED
+25 ; Append Extract Job # to ^XTMP entry tjl ECX*3*190
+26 NEW ECXIEN
SET ECXIEN=+$ORDER(^ECX(727.1,"C",ECHEAD,0))
+27 SET ^XTMP("ECX EXTRACT",ECHEAD)=^XTMP("ECX EXTRACT",ECHEAD)_"^"_ECXIEN
+28 WRITE !,"Request queued as Task #",ZTSK,".",!
+29 DO PAUSE
End DoDot:1
+30 QUIT
+31 ;
NOIVP ;cannot generate ivp message
+1 WRITE !!,?5,"There does not appear to be any data in the IV EXTRACT DATA"
+2 WRITE !,?5,"file (#728.113) for the selected date range."
+3 WRITE !!,?5,"The IVP extract cannot be generated."
+4 DO PAUSE
+5 QUIT
+6 ;
START ; entry when queued
+1 SET QFLG=0
+2 ;144 Added time out to lock as required by standard
LOCK +^ECX(727,0):3
if '$TEST
QUIT
SET EC=$PIECE(^ECX(727,0),U,3)+1
SET $PIECE(^(0),U,3,4)=EC_U_EC
LOCK -^ECX(727,0)
+3 SET ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$EXTRACT(ECED,1,7)_U_U_DUZ
+4 SET ^ECX(727,EC,"HEAD")=ECHEAD
+5 if ECFILE=727.816
SET ECFILE=727.827
SET ^ECX(727,EC,"FILE")=ECFILE
+6 SET ^ECX(727,EC,"GRP")=ECGRP
+7 IF $GET(ECXLOGIC)=""
SET ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
+8 SET ^ECX(727,EC,"VER")=$GET(ECVER)_"^"_ECXLOGIC
+9 SET ^ECX(727,EC,"DIV")=ECXINST
+10 SET DA=EC
SET DIK="^ECX(727,"
DO IX^DIK
KILL DIK,DA
+11 SET ECRN=0
SET ECXYM=$$ECXYM^ECXUTL(ECED)
SET EC23=ECXYM_U_EC
+12 SET ECXSTART=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
SET ECXNOW=$HOROLOG
+13 ;do specific extract
+14 DO @ECRTN
+15 ;if task gets stop request, set ztstop and quit
+16 IF QFLG
Begin DoDot:1
+17 SET $PIECE(^ECX(728,1,ECNODE+.1),U,ECPIECE)=""
SET ZTSTOP=1
+18 ;144 Delete queued information if stopped by user
KILL ^XTMP("ECX EXTRACT",ECHEAD)
+19 DO QKILL
+20 DO QMSG
+21 DO ^ECXKILL
End DoDot:1
QUIT
+22 ;Set last date for extract
+23 IF '$PIECE($GET(ECXDATES),"^",3)
Begin DoDot:1
+24 ;* set last date for all extracts except prosthetics
+25 IF ECGRP'="PRO"
SET $PIECE(^ECX(728,1,ECNODE),U,ECPIECE)=$PIECE(ECED,".")
QUIT
+26 ;* set last date for prosthetics
+27 NEW ECXDA1
+28 SET ECXDA1=$ORDER(^ECX(728,0))
+29 SET $PIECE(^ECX(728,ECXDA1,1,ECXINST,0),U,2)=$PIECE(ECED,".")
End DoDot:1
+30 SET TIME=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
+31 SET $PIECE(^ECX(727,$PIECE(EC23,U,2),0),U,6)=ECRN
+32 ;set piece 3 and 4 of the zero node
+33 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
+34 DO MSG
+35 SET $PIECE(^ECX(728,1,ECNODE+.1),U,ECPIECE)=""
+36 ;144 Delete queued information if processing completed normally
KILL ^XTMP("ECX EXTRACT",ECHEAD)
+37 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+38 QUIT
+39 ;
MSG ; send message to mail group 'DSS-ECGRP'
+1 SET XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS"
SET XMDUZ="DSS SYSTEM"
+2 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+3 SET ECMSG(1,0)="The 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("
+15 DO ^XMD
+16 QUIT
+17 ;
QMSG ; send abort message to mail group 'DSS-ECGRP'
+1 SET XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS"
SET XMDUZ="DSS SYSTEM"
+2 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+3 SET ECMSG(1,0)="The 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)=" "
+6 SET ECMSG(4,0)="A user stop request was received by Taskmanager which caused processing"
+7 SET ECMSG(5,0)="to terminate before completion. Any records which may have been created"
+8 SET ECMSG(6,0)="in file #"_ECFILE_" for this extract have been deleted."
+9 SET ECMSG(7,0)=" "
+10 SET XMTEXT="ECMSG("
+11 DO ^XMD
+12 QUIT
+13 ;
QKILL ;delete records created for any extract stopped at user request
+1 NEW ECX,FILE,IEN,DA,DIK
+2 SET FILE="^ECX("_ECFILE_","
+3 SET ECX=$PIECE(EC23,U,2)
+4 FOR
SET IEN=$ORDER(^ECX(ECFILE,999999999),-1)
if ($PIECE(^ECX(ECFILE,IEN,0),U,3)'=ECX)
QUIT
Begin DoDot:1
+5 SET DIK=FILE
SET DA=IEN
DO ^DIK
End DoDot:1
+6 QUIT
+7 ;
CHK2 ;iv extract check - all active iv rooms to have a division
+1 SET EC=0
+2 DO ALL^PSJ59P5(,"??","ECXIV")
+3 FOR
SET EC=$ORDER(^TMP($JOB,"ECXIV",EC))
if 'EC
QUIT
IF '^(EC,19)
Begin DoDot:1
+4 SET CHKFLG=$SELECT($GET(^TMP($JOB,"ECXIV",EC,19)):1,$GET(^(19))>DT:1,1:0)
+5 IF CHKFLG
Begin DoDot:2
+6 WRITE !!,"All active IV Rooms in the IV Room file (#59.5) must have a ""DIVISION""",!,"assigned to run this extract!"
+7 WRITE !!,"This information can be entered using the DSS Extract Manager's Maintenance ",!,"option ""Enter/Edit IV Room Division""."
+8 DO PAUSE
End DoDot:2
End DoDot:1
IF CHKFLG
DO EXIT
QUIT
EXIT KILL ^TMP($JOB,"ECXIV")
+1 QUIT
+2 ;
PAUSE ;pause screen
+1 NEW DIR,X,Y
+2 SET OUT=0
+3 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+4 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+5 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+6 IF 'Y
SET OUT=1
+7 WRITE !!
+8 QUIT
+9 ;API added in patch 144
RUSURE(TYPE) ;Allow user to override running node or bypass last date run checks
+1 NEW DIR,Y,ZTSK,USER,QUE,NODE,STDT,EDDT
+2 IF TYPE=1
Begin DoDot:1
+3 SET NODE=$GET(^XTMP("ECX EXTRACT",ECHEAD))
+4 SET ZTSK=$PIECE(NODE,U)
SET USER=$$GET1^DIQ(200,$PIECE(NODE,U,2),.01)
SET QUE=$$HTE^XLFDT($PIECE(NODE,U,3))
SET STDT=$$FMTE^XLFDT($PIECE(NODE,U,4))
SET EDDT=$$FMTE^XLFDT($PIECE(NODE,U,5))
+5 IF ZTSK
DO STAT^%ZTLOAD
Begin DoDot:2
+6 WRITE "Task Information: ",!,$$REPEAT^XLFSTR("-",17),!,"Task #: ",ZTSK,!,"Queued by: ",USER,!,"Extract date range: ",STDT," to ",EDDT,!,"Status: "
+7 IF '$GET(ZTSK(0))!(ZTSK(1)=0)
WRITE "Task deleted, no further information available."
+8 IF ZTSK(1)=1
WRITE "ACTIVE - Task is scheduled to start on ",QUE
+9 IF ZTSK(1)=2
WRITE "ACTIVE - Task is currently running and started on ",QUE
+10 IF ZTSK(1)=5
WRITE "INACTIVE - Task ended abnormally"
+11 IF ZTSK(1)=1!(ZTSK(1)=2)
WRITE !!,"**Before continuing, the ",$GET(ECHEAD)," extract should be ",$SELECT(ZTSK(1)=1:"deleted",1:"stopped")," in TaskManager.",!,"Failure to do so may result in multiple ",$GET(ECHEAD)," extracts running simultaneously*
*."
+12 IF ZTSK(1)=5
WRITE !!,"Be sure any errors or issues have been addressed before overriding this status",!,"and starting another ",$GET(ECHEAD)," extract."
End DoDot:2
WRITE !
End DoDot:1
+13 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you want to continue processing the "_$GET(ECHEAD)_" extract"
+14 DO ^DIR
+15 IF '+Y
QUIT 0
+16 WRITE !
+17 SET DIR("A")="Are you SURE you want to run the "_$GET(ECHEAD)_" extract"
+18 IF TYPE=2
SET DIR("A",1)="Make sure you have checked that your selected dates are correct"
SET DIR("A",2)="before answering yes to the next question."
SET DIR("A",3)=""
+19 DO ^DIR
+20 QUIT +Y
