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**;8 May 96
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,ECDFAPT,CNT,ECPRVARY,ECPRV
 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)
 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)
 ; 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,"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)
 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,CNT,ECPRVARY,ECPRV
 Q