- 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 Feb 18, 2025@23:20:28 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