ECPCEU ;BIR/JPW-ECS to PCE Utilities ;7 Jan 97
;;2.0; EVENT CAPTURE ;**4,5,7,10,17,18,23,42,54,73,72,95,76**;8 May 96;Build 6
CLIN ;check for active inactive clinic
N ECCLDT
I $L($G(ECDT))>6,+ECDT=ECDT S ECCLDT=ECDT
I '$G(ECCLDT) S ECCLDT=DT
K ECPCL
I '$D(EC4) S ECPCL=0 Q
I 'EC4 S ECPCL=0 Q
I '$D(^SC(+EC4,"I")) S ECPCL=1 Q
S ECPCID=+$P(^SC(+EC4,"I"),"^"),ECPCRD=+$P(^("I"),"^",2)
I ECPCID,ECPCID'>ECCLDT I 'ECPCRD!(ECPCRD>ECCLDT) S ECPCL=0 Q
I ECPCID,ECPCRD,ECPCRD'>ECCLDT S ECPCL=1 Q
I ECPCID,ECPCID>ECCLDT S ECPCL=1 Q
S ECPCL=1
K ECPCID,ECPCRD
Q
NITE ;start nightly job
K ^TMP("ECPXAPI",$J)
D NOW^%DTC S ECCKDT=+$E(%,1,12)
S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECS="EVENT CAPTURE DATA"
S ECJJ=0 F S ECJJ=$O(^ECH("AD",ECJJ)) Q:'ECJJ S ECJJ1=0 F S ECJJ1=$O(^ECH("AD",ECJJ,ECJJ1)) Q:'ECJJ1 I $D(^ECH(ECJJ1,"PCE")) D SET
K DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV,ECSHAD,ECDFAPT,CNT,ECPRVARY,ECPRV,ECUSR
K %,%H,%I,ECCKDT
K ^TMP("ECPXAPI",$J)
Q
SET ;set variables
S ECNODE=^ECH(ECJJ1,"PCE"),ECDT=$P(ECNODE,"~"),ECPS=$P(ECNODE,"~",2),ECHL=$P(ECNODE,"~",3),ECL=$P(ECNODE,"~",4),ECID=$P(ECNODE,"~",5),ECV=$P(ECNODE,"~",9),ECUSR=$P($G(^ECH(ECJJ1,0)),U,13)
S ECCPT=$P(ECNODE,"~",10),ECDX=$P(ECNODE,"~",11),ECAO=$P(ECNODE,"~",12),ECIR=$P(ECNODE,"~",13),ECZEC=$P(ECNODE,"~",14),ECSC=$P(ECNODE,"~",15),EC725=$P(ECNODE,"~",16),ECELIG=$P(ECNODE,"~",17),ECMST=$P(ECNODE,"~",18)
S ECHNC=$P(ECNODE,"~",19),ECCV=$P(ECNODE,"~",20),ECSHAD=$P(ECNODE,"~",21)
; EC*2.0*73 next line added to get default appt type if defined
S ECDFAPT="" S:$D(^SC(ECHL,"AT")) ECDFAPT=+$G(^SC(ECHL,"AT"))
TMP ;set ^TMP for PCE call
ENC S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=ECDT
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"PATIENT")=ECPS
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=ECHL
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"INSTITUTION")=ECL
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"APPT")=ECDFAPT ; added EC*2.0*73
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SC")=ECSC
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"AO")=ECAO
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"IR")=ECIR
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"EC")=ECZEC
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"MST")=ECMST
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HNC")=ECHNC
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CV")=ECCV
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SHAD")=ECSHAD
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="X"
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="A"
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"DSS ID")=ECID
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=ECCKDT
S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ELIGIBILITY")=ECELIG
PROV ;Set providers in ^TMP("ECPXAPI",$J,"PROVIDER",n,"NAME")=provider
K ECPRVARY S ECPRV=$$GETPRV^ECPRVMUT(ECJJ1,.ECPRVARY),ECI=0
;set primary provider in ^TMP global
F S ECI=$O(ECPRVARY(ECI)) Q:'ECI I $P(ECPRVARY(ECI),U,3)="P" D Q
.S ^TMP("ECPXAPI",$J,"PROVIDER",1,"NAME")=$P(ECPRVARY(ECI),U)
.S ^TMP("ECPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
.S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"ENC PROVIDER")=$P(ECPRVARY(ECI),U)
.K ECPRVARY(ECI)
;set secondary providers in ^TMP global
S ECI=0,CNT=2 F S ECI=$O(ECPRVARY(ECI)) Q:'ECI D
.S ^TMP("ECPXAPI",$J,"PROVIDER",CNT,"NAME")=$P(ECPRVARY(ECI),U),CNT=CNT+1
I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D
. I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
. . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)=""
DX S ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS")=ECDX
S ^TMP("ECPXAPI",$J,"DX/PL",1,"PRIMARY")=1
;Set secondary diagnosis codes in ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS",diagnosis
S DXS=0 F ECI=2:1 S DXS=$O(^ECH(ECJJ1,"DX",DXS)) Q:DXS="" D
. S DXSIEN=$G(^ECH(ECJJ1,"DX",DXS,0)) I DXSIEN="" Q
. S ^TMP("ECPXAPI",$J,"DX/PL",ECI,"DIAGNOSIS")=DXSIEN
PROC S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"EVENT D/T")=ECDT
S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"PROCEDURE")=ECCPT
S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"QTY")=ECV
S:EC725]"" ^TMP("ECPXAPI",$J,"PROCEDURE",1,"NARRATIVE")=EC725
MOD ;Set modifiers in ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",modifier
I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D
. I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
. . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)=""
D2PCE S VALQUIET=1,ECVV=$$DATA2PCE^PXAPI("^TMP(""ECPXAPI"",$J)",ECPKG,ECS,.ECVST,ECUSR)
I ECVST K DA,DIE,DR S DA=ECJJ1,DIE=721,DR="25////1;31///@;28////"_ECVST_";32////"_ECCKDT D ^DIE K DA,DIE,DR
K ^TMP("ECPXAPI",$J),ECVST,VALQUIET,MOD,ECMODF,ECMOD,ECI,DXSIEN,DXS
K DA,D0,DIE,DR,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECNODE,ECPS,ECSC,ECV,ECVV,ECZEC,ECELIG,ECMST,ECHNC,ECCV,ECSHAD,CNT,ECPRVARY,ECPRV
Q
;
PCETASK(ECPCE) ;Set up task for transfer to PCE
;
; Input:
; ECPCE - [pass by reference] array subscripted by FM date/time
; and pointer to EVENT CAPTURE PATIENT (#721) file
; [ex: ECPCE(3080101.140425,611)]
;
; Output:
; Function value - Task ID on success; 0 on failure
;
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
S ZTIO=""
S ZTRTN="XFER2PCE^ECPCEU"
S ZTDESC="ECS2PCE TRANSFER"
S ZTDTH=$$NOW^XLFDT()
S ZTSAVE("ECPCE(")=""
D ^%ZTLOAD
Q $S($D(ZTSK):ZTSK,1:0)
;
XFER2PCE ;Task entry point for single ECS record xfer to PCE
;Input from Task: ECPCE -array subscripted by date and pointer
; to EVENT CAPTURE PATIENT (#721) file
; [Ex: ECPCE(3080101,611)]
;
N ECPKG ;package name
N ECS ;source
N ECCKDT ;check-out date/time
N ECJJ ;date iterator
N ECJJ1 ;file #721 IEN iterator
K ^TMP("ECPXAPI",$J)
D NOW^%DTC S ECCKDT=+$E(%,1,12)
S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECS="EVENT CAPTURE DATA"
S ECJJ=0 F S ECJJ=$O(ECPCE(ECJJ)) Q:'ECJJ D
. S ECJJ1=0
. F S ECJJ1=$O(ECPCE(ECJJ,ECJJ1)) Q:'ECJJ1 D
. . I $D(^ECH(ECJJ1,"PCE")) D SET
K DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV,ECDFAPT,CNT,ECPRVARY,ECPRV,ECUSR
K %,%H,%I,ECCKDT
K ^TMP("ECPXAPI",$J)
S ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECPCEU 6223 printed Apr 09, 2024@21:03:57 Page 2
ECPCEU ;BIR/JPW-ECS to PCE Utilities ;7 Jan 97
+1 ;;2.0; EVENT CAPTURE ;**4,5,7,10,17,18,23,42,54,73,72,95,76**;8 May 96;Build 6
CLIN ;check for active inactive clinic
+1 NEW ECCLDT
+2 IF $LENGTH($GET(ECDT))>6
IF +ECDT=ECDT
SET ECCLDT=ECDT
+3 IF '$GET(ECCLDT)
SET ECCLDT=DT
+4 KILL ECPCL
+5 IF '$DATA(EC4)
SET ECPCL=0
QUIT
+6 IF 'EC4
SET ECPCL=0
QUIT
+7 IF '$DATA(^SC(+EC4,"I"))
SET ECPCL=1
QUIT
+8 SET ECPCID=+$PIECE(^SC(+EC4,"I"),"^")
SET ECPCRD=+$PIECE(^("I"),"^",2)
+9 IF ECPCID
IF ECPCID'>ECCLDT
IF 'ECPCRD!(ECPCRD>ECCLDT)
SET ECPCL=0
QUIT
+10 IF ECPCID
IF ECPCRD
IF ECPCRD'>ECCLDT
SET ECPCL=1
QUIT
+11 IF ECPCID
IF ECPCID>ECCLDT
SET ECPCL=1
QUIT
+12 SET ECPCL=1
+13 KILL ECPCID,ECPCRD
+14 QUIT
NITE ;start nightly job
+1 KILL ^TMP("ECPXAPI",$JOB)
+2 DO NOW^%DTC
SET ECCKDT=+$EXTRACT(%,1,12)
+3 SET ECPKG=$ORDER(^DIC(9.4,"B","EVENT CAPTURE",0))
SET ECS="EVENT CAPTURE DATA"
+4 SET ECJJ=0
FOR
SET ECJJ=$ORDER(^ECH("AD",ECJJ))
if 'ECJJ
QUIT
SET ECJJ1=0
FOR
SET ECJJ1=$ORDER(^ECH("AD",ECJJ,ECJJ1))
if 'ECJJ1
QUIT
IF $DATA(^ECH(ECJJ1,"PCE"))
DO SET
+5 KILL DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV,ECSHAD,ECDFAPT,CNT,ECPRVARY,ECPRV,ECUSR
+6 KILL %,%H,%I,ECCKDT
+7 KILL ^TMP("ECPXAPI",$JOB)
+8 QUIT
SET ;set variables
+1 SET ECNODE=^ECH(ECJJ1,"PCE")
SET ECDT=$PIECE(ECNODE,"~")
SET ECPS=$PIECE(ECNODE,"~",2)
SET ECHL=$PIECE(ECNODE,"~",3)
SET ECL=$PIECE(ECNODE,"~",4)
SET ECID=$PIECE(ECNODE,"~",5)
SET ECV=$PIECE(ECNODE,"~",9)
SET ECUSR=$PIECE($GET(^ECH(ECJJ1,0)),U,13)
+2 SET ECCPT=$PIECE(ECNODE,"~",10)
SET ECDX=$PIECE(ECNODE,"~",11)
SET ECAO=$PIECE(ECNODE,"~",12)
SET ECIR=$PIECE(ECNODE,"~",13)
SET ECZEC=$PIECE(ECNODE,"~",14)
SET ECSC=$PIECE(ECNODE,"~",15)
SET EC725=$PIECE(ECNODE,"~",16)
SET ECELIG=$PIECE(ECNODE,"~",17)
SET ECMST=$PIECE(ECNODE,"~",18)
+3 SET ECHNC=$PIECE(ECNODE,"~",19)
SET ECCV=$PIECE(ECNODE,"~",20)
SET ECSHAD=$PIECE(ECNODE,"~",21)
+4 ; EC*2.0*73 next line added to get default appt type if defined
+5 SET ECDFAPT=""
if $DATA(^SC(ECHL,"AT"))
SET ECDFAPT=+$GET(^SC(ECHL,"AT"))
TMP ;set ^TMP for PCE call
ENC SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"ENC D/T")=ECDT
+1 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"PATIENT")=ECPS
+2 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"HOS LOC")=ECHL
+3 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"INSTITUTION")=ECL
+4 ; added EC*2.0*73
SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"APPT")=ECDFAPT
+5 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"SC")=ECSC
+6 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"AO")=ECAO
+7 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"IR")=ECIR
+8 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"EC")=ECZEC
+9 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"MST")=ECMST
+10 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"HNC")=ECHNC
+11 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"CV")=ECCV
+12 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"SHAD")=ECSHAD
+13 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"SERVICE CATEGORY")="X"
+14 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"ENCOUNTER TYPE")="A"
+15 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"DSS ID")=ECID
+16 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"CHECKOUT D/T")=ECCKDT
+17 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"ELIGIBILITY")=ECELIG
PROV ;Set providers in ^TMP("ECPXAPI",$J,"PROVIDER",n,"NAME")=provider
+1 KILL ECPRVARY
SET ECPRV=$$GETPRV^ECPRVMUT(ECJJ1,.ECPRVARY)
SET ECI=0
+2 ;set primary provider in ^TMP global
+3 FOR
SET ECI=$ORDER(ECPRVARY(ECI))
if 'ECI
QUIT
IF $PIECE(ECPRVARY(ECI),U,3)="P"
Begin DoDot:1
+4 SET ^TMP("ECPXAPI",$JOB,"PROVIDER",1,"NAME")=$PIECE(ECPRVARY(ECI),U)
+5 SET ^TMP("ECPXAPI",$JOB,"PROVIDER",1,"PRIMARY")=1
+6 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"ENC PROVIDER")=$PIECE(ECPRVARY(ECI),U)
+7 KILL ECPRVARY(ECI)
End DoDot:1
QUIT
+8 ;set secondary providers in ^TMP global
+9 SET ECI=0
SET CNT=2
FOR
SET ECI=$ORDER(ECPRVARY(ECI))
if 'ECI
QUIT
Begin DoDot:1
+10 SET ^TMP("ECPXAPI",$JOB,"PROVIDER",CNT,"NAME")=$PIECE(ECPRVARY(ECI),U)
SET CNT=CNT+1
End DoDot:1
+11 IF $ORDER(^ECH(ECJJ1,"MOD",0))'=""
SET ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD)
Begin DoDot:1
+12 IF ECMODF
SET MOD=""
FOR
SET MOD=$ORDER(ECMOD(MOD))
if MOD=""
QUIT
Begin DoDot:2
+13 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"MODIFIERS",MOD)=""
End DoDot:2
End DoDot:1
DX SET ^TMP("ECPXAPI",$JOB,"DX/PL",1,"DIAGNOSIS")=ECDX
+1 SET ^TMP("ECPXAPI",$JOB,"DX/PL",1,"PRIMARY")=1
+2 ;Set secondary diagnosis codes in ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS",diagnosis
+3 SET DXS=0
FOR ECI=2:1
SET DXS=$ORDER(^ECH(ECJJ1,"DX",DXS))
if DXS=""
QUIT
Begin DoDot:1
+4 SET DXSIEN=$GET(^ECH(ECJJ1,"DX",DXS,0))
IF DXSIEN=""
QUIT
+5 SET ^TMP("ECPXAPI",$JOB,"DX/PL",ECI,"DIAGNOSIS")=DXSIEN
End DoDot:1
PROC SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"EVENT D/T")=ECDT
+1 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"PROCEDURE")=ECCPT
+2 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"QTY")=ECV
+3 if EC725]""
SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"NARRATIVE")=EC725
MOD ;Set modifiers in ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",modifier
+1 IF $ORDER(^ECH(ECJJ1,"MOD",0))'=""
SET ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD)
Begin DoDot:1
+2 IF ECMODF
SET MOD=""
FOR
SET MOD=$ORDER(ECMOD(MOD))
if MOD=""
QUIT
Begin DoDot:2
+3 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"MODIFIERS",MOD)=""
End DoDot:2
End DoDot:1
D2PCE SET VALQUIET=1
SET ECVV=$$DATA2PCE^PXAPI("^TMP(""ECPXAPI"",$J)",ECPKG,ECS,.ECVST,ECUSR)
+1 IF ECVST
KILL DA,DIE,DR
SET DA=ECJJ1
SET DIE=721
SET DR="25////1;31///@;28////"_ECVST_";32////"_ECCKDT
DO ^DIE
KILL DA,DIE,DR
+2 KILL ^TMP("ECPXAPI",$JOB),ECVST,VALQUIET,MOD,ECMODF,ECMOD,ECI,DXSIEN,DXS
+3 KILL DA,D0,DIE,DR,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECNODE,ECPS,ECSC,ECV,ECVV,ECZEC,ECELIG,ECMST,ECHNC,ECCV,ECSHAD,CNT,ECPRVARY,ECPRV
+4 QUIT
+5 ;
PCETASK(ECPCE) ;Set up task for transfer to PCE
+1 ;
+2 ; Input:
+3 ; ECPCE - [pass by reference] array subscripted by FM date/time
+4 ; and pointer to EVENT CAPTURE PATIENT (#721) file
+5 ; [ex: ECPCE(3080101.140425,611)]
+6 ;
+7 ; Output:
+8 ; Function value - Task ID on success; 0 on failure
+9 ;
+10 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+11 SET ZTIO=""
+12 SET ZTRTN="XFER2PCE^ECPCEU"
+13 SET ZTDESC="ECS2PCE TRANSFER"
+14 SET ZTDTH=$$NOW^XLFDT()
+15 SET ZTSAVE("ECPCE(")=""
+16 DO ^%ZTLOAD
+17 QUIT $SELECT($DATA(ZTSK):ZTSK,1:0)
+18 ;
XFER2PCE ;Task entry point for single ECS record xfer to PCE
+1 ;Input from Task: ECPCE -array subscripted by date and pointer
+2 ; to EVENT CAPTURE PATIENT (#721) file
+3 ; [Ex: ECPCE(3080101,611)]
+4 ;
+5 ;package name
NEW ECPKG
+6 ;source
NEW ECS
+7 ;check-out date/time
NEW ECCKDT
+8 ;date iterator
NEW ECJJ
+9 ;file #721 IEN iterator
NEW ECJJ1
+10 KILL ^TMP("ECPXAPI",$JOB)
+11 DO NOW^%DTC
SET ECCKDT=+$EXTRACT(%,1,12)
+12 SET ECPKG=$ORDER(^DIC(9.4,"B","EVENT CAPTURE",0))
SET ECS="EVENT CAPTURE DATA"
+13 SET ECJJ=0
FOR
SET ECJJ=$ORDER(ECPCE(ECJJ))
if 'ECJJ
QUIT
Begin DoDot:1
+14 SET ECJJ1=0
+15 FOR
SET ECJJ1=$ORDER(ECPCE(ECJJ,ECJJ1))
if 'ECJJ1
QUIT
Begin DoDot:2
+16 IF $DATA(^ECH(ECJJ1,"PCE"))
DO SET
End DoDot:2
End DoDot:1
+17 KILL DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV,ECDFAPT,CNT,ECPRVARY,ECPRV,ECUSR
+18 KILL %,%H,%I,ECCKDT
+19 KILL ^TMP("ECPXAPI",$JOB)
+20 SET ZTREQ="@"
+21 QUIT
