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

ECPCEU.m

Go to the documentation of this file.
  1. 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
  1. CLIN ;check for active inactive clinic
  1. N ECCLDT
  1. I $L($G(ECDT))>6,+ECDT=ECDT S ECCLDT=ECDT
  1. I '$G(ECCLDT) S ECCLDT=DT
  1. K ECPCL
  1. I '$D(EC4) S ECPCL=0 Q
  1. I 'EC4 S ECPCL=0 Q
  1. I '$D(^SC(+EC4,"I")) S ECPCL=1 Q
  1. S ECPCID=+$P(^SC(+EC4,"I"),"^"),ECPCRD=+$P(^("I"),"^",2)
  1. I ECPCID,ECPCID'>ECCLDT I 'ECPCRD!(ECPCRD>ECCLDT) S ECPCL=0 Q
  1. I ECPCID,ECPCRD,ECPCRD'>ECCLDT S ECPCL=1 Q
  1. I ECPCID,ECPCID>ECCLDT S ECPCL=1 Q
  1. S ECPCL=1
  1. K ECPCID,ECPCRD
  1. Q
  1. NITE ;start nightly job
  1. K ^TMP("ECPXAPI",$J)
  1. D NOW^%DTC S ECCKDT=+$E(%,1,12)
  1. S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECS="EVENT CAPTURE DATA"
  1. 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
  1. 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
  1. K %,%H,%I,ECCKDT
  1. K ^TMP("ECPXAPI",$J)
  1. Q
  1. SET ;set variables
  1. 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)
  1. 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)
  1. S ECHNC=$P(ECNODE,"~",19),ECCV=$P(ECNODE,"~",20),ECSHAD=$P(ECNODE,"~",21)
  1. ; EC*2.0*73 next line added to get default appt type if defined
  1. S ECDFAPT="" S:$D(^SC(ECHL,"AT")) ECDFAPT=+$G(^SC(ECHL,"AT"))
  1. TMP ;set ^TMP for PCE call
  1. ENC S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=ECDT
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"PATIENT")=ECPS
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=ECHL
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"INSTITUTION")=ECL
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"APPT")=ECDFAPT ; added EC*2.0*73
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SC")=ECSC
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"AO")=ECAO
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"IR")=ECIR
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"EC")=ECZEC
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"MST")=ECMST
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HNC")=ECHNC
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CV")=ECCV
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SHAD")=ECSHAD
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="X"
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="A"
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"DSS ID")=ECID
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=ECCKDT
  1. S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ELIGIBILITY")=ECELIG
  1. PROV ;Set providers in ^TMP("ECPXAPI",$J,"PROVIDER",n,"NAME")=provider
  1. K ECPRVARY S ECPRV=$$GETPRV^ECPRVMUT(ECJJ1,.ECPRVARY),ECI=0
  1. ;set primary provider in ^TMP global
  1. F S ECI=$O(ECPRVARY(ECI)) Q:'ECI I $P(ECPRVARY(ECI),U,3)="P" D Q
  1. .S ^TMP("ECPXAPI",$J,"PROVIDER",1,"NAME")=$P(ECPRVARY(ECI),U)
  1. .S ^TMP("ECPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
  1. .S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"ENC PROVIDER")=$P(ECPRVARY(ECI),U)
  1. .K ECPRVARY(ECI)
  1. ;set secondary providers in ^TMP global
  1. S ECI=0,CNT=2 F S ECI=$O(ECPRVARY(ECI)) Q:'ECI D
  1. .S ^TMP("ECPXAPI",$J,"PROVIDER",CNT,"NAME")=$P(ECPRVARY(ECI),U),CNT=CNT+1
  1. I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D
  1. . I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
  1. . . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)=""
  1. DX S ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS")=ECDX
  1. S ^TMP("ECPXAPI",$J,"DX/PL",1,"PRIMARY")=1
  1. ;Set secondary diagnosis codes in ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS",diagnosis
  1. S DXS=0 F ECI=2:1 S DXS=$O(^ECH(ECJJ1,"DX",DXS)) Q:DXS="" D
  1. . S DXSIEN=$G(^ECH(ECJJ1,"DX",DXS,0)) I DXSIEN="" Q
  1. . S ^TMP("ECPXAPI",$J,"DX/PL",ECI,"DIAGNOSIS")=DXSIEN
  1. PROC S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"EVENT D/T")=ECDT
  1. S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"PROCEDURE")=ECCPT
  1. S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"QTY")=ECV
  1. S:EC725]"" ^TMP("ECPXAPI",$J,"PROCEDURE",1,"NARRATIVE")=EC725
  1. MOD ;Set modifiers in ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",modifier
  1. I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D
  1. . I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
  1. . . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)=""
  1. D2PCE S VALQUIET=1,ECVV=$$DATA2PCE^PXAPI("^TMP(""ECPXAPI"",$J)",ECPKG,ECS,.ECVST,ECUSR)
  1. 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
  1. K ^TMP("ECPXAPI",$J),ECVST,VALQUIET,MOD,ECMODF,ECMOD,ECI,DXSIEN,DXS
  1. 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
  1. Q
  1. ;
  1. PCETASK(ECPCE) ;Set up task for transfer to PCE
  1. ;
  1. ; Input:
  1. ; ECPCE - [pass by reference] array subscripted by FM date/time
  1. ; and pointer to EVENT CAPTURE PATIENT (#721) file
  1. ; [ex: ECPCE(3080101.140425,611)]
  1. ;
  1. ; Output:
  1. ; Function value - Task ID on success; 0 on failure
  1. ;
  1. N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
  1. S ZTIO=""
  1. S ZTRTN="XFER2PCE^ECPCEU"
  1. S ZTDESC="ECS2PCE TRANSFER"
  1. S ZTDTH=$$NOW^XLFDT()
  1. S ZTSAVE("ECPCE(")=""
  1. D ^%ZTLOAD
  1. Q $S($D(ZTSK):ZTSK,1:0)
  1. ;
  1. XFER2PCE ;Task entry point for single ECS record xfer to PCE
  1. ;Input from Task: ECPCE -array subscripted by date and pointer
  1. ; to EVENT CAPTURE PATIENT (#721) file
  1. ; [Ex: ECPCE(3080101,611)]
  1. ;
  1. N ECPKG ;package name
  1. N ECS ;source
  1. N ECCKDT ;check-out date/time
  1. N ECJJ ;date iterator
  1. N ECJJ1 ;file #721 IEN iterator
  1. K ^TMP("ECPXAPI",$J)
  1. D NOW^%DTC S ECCKDT=+$E(%,1,12)
  1. S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECS="EVENT CAPTURE DATA"
  1. S ECJJ=0 F S ECJJ=$O(ECPCE(ECJJ)) Q:'ECJJ D
  1. . S ECJJ1=0
  1. . F S ECJJ1=$O(ECPCE(ECJJ,ECJJ1)) Q:'ECJJ1 D
  1. . . I $D(^ECH(ECJJ1,"PCE")) D SET
  1. 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
  1. K %,%H,%I,ECCKDT
  1. K ^TMP("ECPXAPI",$J)
  1. S ZTREQ="@"
  1. Q