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

ECXTRAC.m

Go to the documentation of this file.
  1. 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
  1. ;Date range, queuing and message sending for package extracts
  1. ;Input
  1. ; ECPACK printed name of package (e.g. Lab, Prescriptions)
  1. ; ECNODE in file 728 where last date is stored
  1. ; ECPIECE piece of node where last date is stored
  1. ; ECRTN in the form of START^ROUTINE
  1. ; ECGRP name of local mail group to receive summary message
  1. ; (MUST BE 1 TO 5 UPPER CASE ALPHA - NO SPACES)
  1. ; ECFILE file number of the local editing file
  1. ; ECXLOGIC Fiscal year extract logic to use (optional)
  1. ; ECXDATES StartDate^EndDate^DoNotUpdate728 (optional)
  1. ;Generates
  1. ; EC23=2nd and 3rd piece of zero node in local editing file
  1. ; =YYMM of end date^pointer to 727
  1. ; ECXLOGIC=Fiscal year extract logic to use
  1. ;
  1. EN ;entry point
  1. N OUT,CHKFLG,RUN ;144
  1. I '$D(ECNODE) S ECNODE=7
  1. I '$D(ECHEAD) S ECHEAD=" "
  1. I $P($G(^ECX(728,1,ECNODE+.1)),U,ECPIECE)]"" D I '$G(RUN) Q ;144
  1. .W !!,$C(7),ECPACK," extract is already running or is scheduled to run.",!! ;144
  1. .S RUN=$$RUSURE(1) ;144
  1. .;D PAUSE
  1. W @IOF,!,"Extract ",ECPACK," Information for DSS",!!
  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. .S:ECLDT="" ECLDT=2610624
  1. ;* get last date for prosthetics
  1. I ECGRP="PRO" D
  1. .N ECXDA1
  1. .S ECXDA1=$O(^ECX(728,0))
  1. .I $D(^ECX(728,ECXDA1,1,ECXINST,0)) D
  1. ..S ECLDT=$P(^ECX(728,ECXDA1,1,ECXINST,0),U,2)
  1. .I '$D(^ECX(728,ECXDA1,1,ECXINST,0)) D
  1. ..S DA(1)=ECXDA1
  1. ..S DIC(0)="L" K ECXDD
  1. ..D FIELD^DID(728,59,,"SPECIFIER","ECXDD")
  1. ..S DIC("P")=ECXDD("SPECIFIER") K ECXDD
  1. ..S DIC="^ECX(728,"_DA(1)_",1,",X=ECXINST,DINUM=X
  1. ..K DD,DO D FILE^DICN
  1. ..K DIC,X,DINUM,Y,DA
  1. ..S ECLDT=2610624
  1. S X=$G(ECXDATES) S ECSD=$P(X,"^",1),ECED=$P(X,"^",2)
  1. S OUT=0
  1. I (ECSD="")!(ECED="") F S (ECED,ECSD)="" D Q:OUT
  1. .K %DT S %DT="AEX",%DT("A")="Starting with Date: " D ^%DT
  1. .I Y<0 S OUT=1 Q
  1. .S ECSD=Y
  1. .K %DT S %DT="AEX",%DT("A")="Ending with Date: " D ^%DT
  1. .I Y<0 S OUT=1 Q
  1. .I Y<ECSD D Q
  1. ..W !!,"The ending date cannot be earlier than the starting date."
  1. ..W !,"Please try again.",!!
  1. .I $E(Y,1,5)'=$E(ECSD,1,5) D Q
  1. ..W !!,"Beginning and ending dates must be in the same month and year."
  1. ..W !,"Please try again.",!!
  1. .S ECED=Y
  1. .I ECLDT'<ECSD D I '$G(RUN) Q ;144
  1. ..W !!,"The ",ECPACK," information has already been extracted " W:$L(ECPACK)>10 ! W "through ",$$FMTE^XLFDT(ECLDT),"." ;144
  1. ..S RUN=$$RUSURE(2) Q:$G(RUN) W ! ;144
  1. ..W !,"Please enter a new date range.",!!
  1. .S OUT=1
  1. I ECED]"",ECSD]"" D QUE
  1. Q
  1. ;
  1. QUE ;queue extract
  1. N CHKFLG
  1. ;if extract is ivp (i.e., file=727.819) and data in the intermediate file use new format
  1. I ECFILE=727.819 D Q:CHKFLG
  1. .S CHKFLG=0
  1. .S X="PSIVSTAT" X ^%ZOSF("TEST") I '$T Q
  1. .I '$D(^ECX(728.113,"A")) S CHKFLG=1 D NOIVP Q
  1. .S DATE=$O(^ECX(728.113,"A",ECED+1),-1) I DATE<ECSD S CHKFLG=1 D NOIVP Q
  1. .D CHK^ECXDIVIV Q:CHKFLG
  1. .D CHK2
  1. .S ECRTN="START^ECXPIVDN",ECVER=7
  1. I '$D(ECNODE) S ECNODE=7
  1. I '$D(ECHEAD) S ECHEAD=""
  1. S ECSDN=$$FMTE^XLFDT(ECSD),ECEDN=$$FMTE^XLFDT(ECED),ECSD1=ECSD-.1
  1. K ZTSAVE
  1. F X="ECINST","ECED","ECSD","ECSD1","ECEDN","ECSDN" S ZTSAVE(X)=""
  1. F X="ECPACK","ECPIECE","ECRTN","ECGRP","ECNODE" S ZTSAVE(X)=""
  1. F X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST" S ZTSAVE(X)=""
  1. F X="ECXLOGIC","ECXDATES" S ZTSAVE(X)=""
  1. S ZTDESC=ECPACK_" EXTRACT: "_ECSDN_" TO "_ECEDN,ZTRTN="START^ECXTRAC",ZTIO=""
  1. D ^%ZTLOAD
  1. I $D(ZTSK) D
  1. .S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
  1. .S ^XTMP("ECX EXTRACT",0)=$$FMADD^XLFDT(DT,365)_"^"_DT_"^TASK INFORMATION FOR EXTRACTS" ;144,161 Update zero node for task information in XTMP
  1. .S ^XTMP("ECX EXTRACT",ECHEAD)=ZTSK_"^"_$G(DUZ)_"^"_$G(ZTSK("D"))_"^"_ECSD_"^"_ECED ;144 Save data related to task
  1. .; Append Extract Job # to ^XTMP entry tjl ECX*3*190
  1. .N ECXIEN S ECXIEN=+$O(^ECX(727.1,"C",ECHEAD,0))
  1. .S ^XTMP("ECX EXTRACT",ECHEAD)=^XTMP("ECX EXTRACT",ECHEAD)_"^"_ECXIEN
  1. .W !,"Request queued as Task #",ZTSK,".",!
  1. .D PAUSE
  1. Q
  1. ;
  1. NOIVP ;cannot generate ivp message
  1. W !!,?5,"There does not appear to be any data in the IV EXTRACT DATA"
  1. W !,?5,"file (#728.113) for the selected date range."
  1. W !!,?5,"The IVP extract cannot be generated."
  1. D PAUSE
  1. Q
  1. ;
  1. START ; entry when queued
  1. S QFLG=0
  1. 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
  1. S ^ECX(727,EC,0)=EC_U_DT_U_ECPACK_U_ECSD_U_$E(ECED,1,7)_U_U_DUZ
  1. S ^ECX(727,EC,"HEAD")=ECHEAD
  1. S:ECFILE=727.816 ECFILE=727.827 S ^ECX(727,EC,"FILE")=ECFILE
  1. S ^ECX(727,EC,"GRP")=ECGRP
  1. I $G(ECXLOGIC)="" S ECXLOGIC=$$FISCAL^ECXUTL1(ECSD)
  1. S ^ECX(727,EC,"VER")=$G(ECVER)_"^"_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. ;do specific extract
  1. D @ECRTN
  1. ;if task gets stop request, set ztstop and quit
  1. I QFLG D Q
  1. .S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="",ZTSTOP=1
  1. .K ^XTMP("ECX EXTRACT",ECHEAD) ;144 Delete queued information if stopped by user
  1. .D QKILL
  1. .D QMSG
  1. .D ^ECXKILL
  1. ;Set last date for extract
  1. I '$P($G(ECXDATES),"^",3) D
  1. .;* set last date for all extracts except prosthetics
  1. .I ECGRP'="PRO" S $P(^ECX(728,1,ECNODE),U,ECPIECE)=$P(ECED,".") Q
  1. .;* set last date for prosthetics
  1. .N ECXDA1
  1. .S ECXDA1=$O(^ECX(728,0))
  1. .S $P(^ECX(728,ECXDA1,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. K ^XTMP("ECX EXTRACT",ECHEAD) ;144 Delete queued information if processing completed normally
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. MSG ; send message to mail group 'DSS-ECGRP'
  1. S XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
  1. K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
  1. S ECMSG(1,0)="The 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("
  1. D ^XMD
  1. Q
  1. ;
  1. QMSG ; send abort message to mail group 'DSS-ECGRP'
  1. S XMSUB=ECINST_" - "_ECPACK_" EXTRACT FOR DSS",XMDUZ="DSS SYSTEM"
  1. K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
  1. S ECMSG(1,0)="The 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)=" "
  1. S ECMSG(4,0)="A user stop request was received by Taskmanager which caused processing"
  1. S ECMSG(5,0)="to terminate before completion. Any records which may have been created"
  1. S ECMSG(6,0)="in file #"_ECFILE_" for this extract have been deleted."
  1. S ECMSG(7,0)=" "
  1. S XMTEXT="ECMSG("
  1. D ^XMD
  1. Q
  1. ;
  1. QKILL ;delete records created for any extract stopped at user request
  1. N ECX,FILE,IEN,DA,DIK
  1. S FILE="^ECX("_ECFILE_","
  1. S ECX=$P(EC23,U,2)
  1. F S IEN=$O(^ECX(ECFILE,999999999),-1) Q:($P(^ECX(ECFILE,IEN,0),U,3)'=ECX) D
  1. .S DIK=FILE,DA=IEN D ^DIK
  1. Q
  1. ;
  1. CHK2 ;iv extract check - all active iv rooms to have a division
  1. S EC=0
  1. D ALL^PSJ59P5(,"??","ECXIV")
  1. F S EC=$O(^TMP($J,"ECXIV",EC)) Q:'EC I '^(EC,19) D I CHKFLG D EXIT Q
  1. .S CHKFLG=$S($G(^TMP($J,"ECXIV",EC,19)):1,$G(^(19))>DT:1,1:0)
  1. .I CHKFLG D
  1. ..W !!,"All active IV Rooms in the IV Room file (#59.5) must have a ""DIVISION""",!,"assigned to run this extract!"
  1. ..W !!,"This information can be entered using the DSS Extract Manager's Maintenance ",!,"option ""Enter/Edit IV Room Division""."
  1. ..D PAUSE
  1. EXIT K ^TMP($J,"ECXIV")
  1. Q
  1. ;
  1. PAUSE ;pause screen
  1. N DIR,X,Y
  1. S OUT=0
  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. I 'Y S OUT=1
  1. W !!
  1. Q
  1. ;API added in patch 144
  1. RUSURE(TYPE) ;Allow user to override running node or bypass last date run checks
  1. N DIR,Y,ZTSK,USER,QUE,NODE,STDT,EDDT
  1. I TYPE=1 D
  1. .S NODE=$G(^XTMP("ECX EXTRACT",ECHEAD))
  1. .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))
  1. .I ZTSK D STAT^%ZTLOAD D W !
  1. ..W "Task Information: ",!,$$REPEAT^XLFSTR("-",17),!,"Task #: ",ZTSK,!,"Queued by: ",USER,!,"Extract date range: ",STDT," to ",EDDT,!,"Status: "
  1. ..I '$G(ZTSK(0))!(ZTSK(1)=0) W "Task deleted, no further information available."
  1. ..I ZTSK(1)=1 W "ACTIVE - Task is scheduled to start on ",QUE
  1. ..I ZTSK(1)=2 W "ACTIVE - Task is currently running and started on ",QUE
  1. ..I ZTSK(1)=5 W "INACTIVE - Task ended abnormally"
  1. ..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**."
  1. ..I ZTSK(1)=5 W !!,"Be sure any errors or issues have been addressed before overriding this status",!,"and starting another ",$G(ECHEAD)," extract."
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to continue processing the "_$G(ECHEAD)_" extract"
  1. D ^DIR
  1. I '+Y Q 0
  1. W !
  1. S DIR("A")="Are you SURE you want to run the "_$G(ECHEAD)_" extract"
  1. 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)=""
  1. D ^DIR
  1. Q +Y