source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECPCEU.m@ 1379

Last change on this file since 1379 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1ECPCEU ;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
3CLIN ;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
18NITE ;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
27SET ;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"))
33TMP ;set ^TMP for PCE call
34ENC 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
51PROV ;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)=""
65DX 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
71PROC 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
75MOD ;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)=""
79D2PCE 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
Note: See TracBrowser for help on using the repository browser.