1 | ECPCEU ;BIR/JPW-ECS to PCE Utilities ;7 Jan 97
|
---|
2 | ;;2.0; EVENT CAPTURE ;**4,5,7,10,17,18,23,42,54,73,72**;8 May 96
|
---|
3 | CLIN ;check for active inactive clinic
|
---|
4 | N ECCLDT
|
---|
5 | I $L($G(ECDT))>6,+ECDT=ECDT S ECCLDT=ECDT
|
---|
6 | I '$G(ECCLDT) S ECCLDT=DT
|
---|
7 | K ECPCL
|
---|
8 | I '$D(EC4) S ECPCL=0 Q
|
---|
9 | I 'EC4 S ECPCL=0 Q
|
---|
10 | I '$D(^SC(+EC4,"I")) S ECPCL=1 Q
|
---|
11 | S ECPCID=+$P(^SC(+EC4,"I"),"^"),ECPCRD=+$P(^("I"),"^",2)
|
---|
12 | I ECPCID,ECPCID'>ECCLDT I 'ECPCRD!(ECPCRD>ECCLDT) S ECPCL=0 Q
|
---|
13 | I ECPCID,ECPCRD,ECPCRD'>ECCLDT S ECPCL=1 Q
|
---|
14 | I ECPCID,ECPCID>ECCLDT S ECPCL=1 Q
|
---|
15 | S ECPCL=1
|
---|
16 | K ECPCID,ECPCRD
|
---|
17 | Q
|
---|
18 | NITE ;start nightly job
|
---|
19 | K ^TMP("ECPXAPI",$J)
|
---|
20 | D NOW^%DTC S ECCKDT=+$E(%,1,12)
|
---|
21 | S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECS="EVENT CAPTURE DATA"
|
---|
22 | 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
|
---|
23 | 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
|
---|
24 | K %,%H,%I,ECCKDT
|
---|
25 | K ^TMP("ECPXAPI",$J)
|
---|
26 | Q
|
---|
27 | SET ;set variables
|
---|
28 | 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)
|
---|
29 | 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)
|
---|
30 | S ECHNC=$P(ECNODE,"~",19),ECCV=$P(ECNODE,"~",20)
|
---|
31 | ; EC*2.0*73 next line added to get default appt type if defined
|
---|
32 | S ECDFAPT="" S:$D(^SC(ECHL,"AT")) ECDFAPT=+$G(^SC(ECHL,"AT"))
|
---|
33 | TMP ;set ^TMP for PCE call
|
---|
34 | ENC S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=ECDT
|
---|
35 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"PATIENT")=ECPS
|
---|
36 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=ECHL
|
---|
37 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"INSTITUTION")=ECL
|
---|
38 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"APPT")=ECDFAPT ; added EC*2.0*73
|
---|
39 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SC")=ECSC
|
---|
40 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"AO")=ECAO
|
---|
41 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"IR")=ECIR
|
---|
42 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"EC")=ECZEC
|
---|
43 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"MST")=ECMST
|
---|
44 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HNC")=ECHNC
|
---|
45 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CV")=ECCV
|
---|
46 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="X"
|
---|
47 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="A"
|
---|
48 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"DSS ID")=ECID
|
---|
49 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=ECCKDT
|
---|
50 | S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ELIGIBILITY")=ECELIG
|
---|
51 | PROV ;Set providers in ^TMP("ECPXAPI",$J,"PROVIDER",n,"NAME")=provider
|
---|
52 | K ECPRVARY S ECPRV=$$GETPRV^ECPRVMUT(ECJJ1,.ECPRVARY),ECI=0
|
---|
53 | ;set primary provider in ^TMP global
|
---|
54 | F S ECI=$O(ECPRVARY(ECI)) Q:'ECI I $P(ECPRVARY(ECI),U,3)="P" D Q
|
---|
55 | .S ^TMP("ECPXAPI",$J,"PROVIDER",1,"NAME")=$P(ECPRVARY(ECI),U)
|
---|
56 | .S ^TMP("ECPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
|
---|
57 | .S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"ENC PROVIDER")=$P(ECPRVARY(ECI),U)
|
---|
58 | .K ECPRVARY(ECI)
|
---|
59 | ;set secondary providers in ^TMP global
|
---|
60 | S ECI=0,CNT=2 F S ECI=$O(ECPRVARY(ECI)) Q:'ECI D
|
---|
61 | .S ^TMP("ECPXAPI",$J,"PROVIDER",CNT,"NAME")=$P(ECPRVARY(ECI),U),CNT=CNT+1
|
---|
62 | I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D
|
---|
63 | . I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
|
---|
64 | . . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)=""
|
---|
65 | DX S ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS")=ECDX
|
---|
66 | S ^TMP("ECPXAPI",$J,"DX/PL",1,"PRIMARY")=1
|
---|
67 | ;Set secondary diagnosis codes in ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS",diagnosis
|
---|
68 | S DXS=0 F ECI=2:1 S DXS=$O(^ECH(ECJJ1,"DX",DXS)) Q:DXS="" D
|
---|
69 | . S DXSIEN=$G(^ECH(ECJJ1,"DX",DXS,0)) I DXSIEN="" Q
|
---|
70 | . S ^TMP("ECPXAPI",$J,"DX/PL",ECI,"DIAGNOSIS")=DXSIEN
|
---|
71 | PROC S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"EVENT D/T")=ECDT
|
---|
72 | S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"PROCEDURE")=ECCPT
|
---|
73 | S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"QTY")=ECV
|
---|
74 | S:EC725]"" ^TMP("ECPXAPI",$J,"PROCEDURE",1,"NARRATIVE")=EC725
|
---|
75 | MOD ;Set modifiers in ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",modifier
|
---|
76 | I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D
|
---|
77 | . I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
|
---|
78 | . . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)=""
|
---|
79 | D2PCE S VALQUIET=1,ECVV=$$DATA2PCE^PXAPI("^TMP(""ECPXAPI"",$J)",ECPKG,ECS,.ECVST)
|
---|
80 | 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
|
---|
81 | K ^TMP("ECPXAPI",$J),ECVST,VALQUIET,MOD,ECMODF,ECMOD,ECI,DXSIEN,DXS
|
---|
82 | 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
|
---|
83 | Q
|
---|