source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECEFPAT.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1ECEFPAT ;ALB/JAM-Enter Event Capture Data Patient Filer ;12 Oct 00
2 ;;2.0; EVENT CAPTURE ;**25,32,39,42,47,49,54,65,72**;8 May 96
3 ;
4FILE ;Used by the RPC broker to file patient encounter in file #721
5 ; Variables passed in
6 ; ECIEN - IEN of #721, if editing
7 ; ECDEL - Delete record. 1- YES; 0- 0, null or undefine for NO.
8 ; ECDFN - Patient IEN for file #2
9 ; ECDT - Date and time of procedure
10 ; ECL - Location
11 ; ECD - DSS Unit
12 ; ECC - Category
13 ; ECP - Procedure
14 ; ECVOL - Volume
15 ; ECU1..n - Provider (1 thru n), Prov 1 is required,other optional
16 ; ECMN - Ordering Section
17 ; ECDUZ - Entered/Edited by, pointer to #200
18 ; ECDX - Primary Diagnosis
19 ; ECDXS - Secondary Diagnosis; multiple, optional
20 ; EC4 - Associated Clinic, required if sending data to PCE
21 ; ECPTSTAT- Patient Status
22 ; ECPXREAS- Procedure reason, optional
23 ; ECMOD - CPT modifiers, optional
24 ; ECLASS - Classification, optional
25 ; ECELIG - Eligibility, optional
26 ;
27 ; Variable return
28 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #721^Message
29 ;
30 N NODE,ECS,ECM,ECID,ECCPT,ECINT,ECPCE,ECX,ECERR,ECOUT,ECFLG,ECRES
31 N ECFIL,ECPRV
32 S ECFLG=1,ECERR=0 D CHKDT(1) I ECERR Q
33 F ECX=1:1 Q:'$D(@("ECU"_ECX)) D I ECERR Q
34 .I @("ECU"_ECX)="" Q
35 .S NODE=$$GET^XUA4A72(@("ECU"_ECX),ECDT) I +NODE'>0 S ECERR=1 D Q
36 ..S ^TMP($J,"ECMSG",1)="0^Provider doesn't have an active Person class"
37 .S ECPRV(ECX)=@("ECU"_ECX)_"^^"_$S(ECX=1:"P",1:"S")
38 I $G(ECIEN)'="" S ECFLG=0 D I ECERR Q
39 . I '$D(^ECH(ECIEN)) S ECERR=1,^TMP($J,"ECMSG",1)="0^Pat IEN Not Found"
40 I $G(ECDEL) K ^TMP($J,"ECMSG") D Q
41 .S ECVST=$P($G(^ECH(ECIEN,0)),"^",21) I ECVST D
42 ..;* Resend all EC records with same Visit file entry to PCE
43 ..;* Remove Visit entry from ^ECH( so DELVFILE will complete cleanup
44 ..S ECVAR1=$$FNDVST^ECUTL(ECVST) K ECVAR1
45 ..;Set VALQUIET to stop Amb Care validator from broadcasting to screen
46 ..S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST) K ECVST,VALQUIET
47 .S DA=ECIEN,DIK="^ECH(" D ^DIK K DA,DIK,ECVV
48 .S ^TMP($J,"ECMSG",1)="1^Procedure Deleted"
49 I '$D(ECPRV) S ^TMP($J,"ECMSG",1)="0^No provider present" Q
50 S ECDT=+ECDT,NODE=$G(^ECD(ECD,0)) I NODE="" D MSG Q
51 S ECFN=$G(ECIEN),ECVOL=$G(ECVOL,1),ECS=$P(NODE,U,2),ECM=$P(NODE,U,3)
52 S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N")
53 ;S ECPTSTAT=$$INOUTPT^ECUTL0(ECDFN,+ECDT) ;pat stat may not need
54 I $G(EC4)="" D GETCLN^ECEDF
55 S ECID=$S(+EC4:$P($G(^SC(+EC4,0)),"^",7),1:""),ECINP=ECPTSTAT
56 I $S($P(ECPCE,"~",2)="N":0,$P(ECPCE,"~",2)="O"&(ECINP'="O"):0,1:1) D
57 .D CHKDT(2)
58 I +EC4 S ECRES=$$CLNCK^SDUTL2(+EC4,0) I 'ECRES D S ECERR=1
59 .S ^TMP($J,"ECMSG",1)=ECRES_" Clinic MUST be corrected before filing."
60 Q:ECERR I ECFLG D NEWIEN
61 S ECCPT=$S(ECP["ICPT":+ECP,1:$P($G(^EC(725,+ECP,0)),U,5))
62 K DA,DR,DIE S DIE="^ECH(",(DA,ECFN)=ECIEN K ECIEN
63 S DR=".01////"_ECFN_";1////"_ECDFN_";3////"_ECL_";4////"_ECS
64 S DR=DR_";5////"_ECM_";6////"_ECD_";7////"_+ECC_";9////"_ECVOL
65 S $P(^ECH(ECFN,0),"^",9)=ECP
66 D ^DIE I $D(DTOUT) D RECDEL,MSG Q
67 S DA=ECFN,DR="11////"_ECMN_";13////"_ECDUZ_";2////"_ECDT
68 S ECPXREAS=$G(ECPXREAS)
69 S DR=DR_";19////"_$S(+ECCPT:ECCPT,1:"@")_";20////"_ECDX
70 S DR=DR_";26////"_$G(EC4)_";27////"_$G(ECID)_";29////"_ECPTSTAT
71 S DR=DR_";34////"_$S(ECPXREAS="":"@",1:ECPXREAS)
72 D ^DIE I $D(DTOUT) D RECDEL,MSG Q
73 I ECDX S ^DISV(DUZ,"^ICD9(")=ECDX ;last ICD9 code
74 S ECX=$O(ECPRV("A"),-1) I ECX'="" S ^DISV(DUZ,"^VA(200,")=+ECPRV(ECX)
75 ;Remove Old CPT modifiers
76 I 'ECFLG D
77 . K OLDMOD S (ECDA,DA(1))=ECFN,DIK="^ECH("_DA(1)_",""MOD"",",DA=0
78 . F S DA=$O(^ECH(ECDA,"MOD",DA)) Q:'DA S OLDMOD(DA)="" D ^DIK
79 . K DA,ECDA,DIK,^ECH(ECFN,"MOD")
80 .;Remove old secondary diagnosis codes
81 . K OLDDXS S (ECDA,DA(1))=ECFN,DIK="^ECH("_DA(1)_",""DX"",",DA=0
82 . F S DA=$O(^ECH(ECDA,"DX",DA)) Q:'DA S OLDDXS(DA)="" D ^DIK
83 . K DA,ECDA,DIK,^ECH(ECFN,"DX")
84 I $D(DTOUT) D RECDEL,MSG Q
85 ;File multiple providers
86 S ECFIL=$$FILPRV^ECPRVMUT(ECFN,.ECPRV,.ECOUT) K ECOUT
87 I 'ECFIL D RECDEL,MSG Q
88 ;File CPT modifiers
89 I $G(ECMOD)'="" D
90 . S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,36,0),U,2)
91 . S DIC="^ECH("_DA(1)_","_"""MOD"""_","
92 . F ECX=1:1:$L(ECMOD,"^") S MODIEN=$P(ECMOD,U,ECX) I +MODIEN>0 D
93 . . K DD,DO S X=MODIEN D FILE^DICN
94 . K MODIEN,DIC
95 I $D(DTOUT) D RECDEL,MSG Q
96 ; File multiple secondary diagnosis codes
97 I $G(ECDXS)'="" D
98 . S DXS="",DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,38,0),U,2)
99 . S DIC="^ECH("_DA(1)_","_"""DX"""_",",ECDXY=ECDX K ECDXX
100 . F ECX=1:1:$L(ECDXS,"^") S DXSIEN=$P(ECDXS,U,ECX) I +DXSIEN>0 D
101 . . S DXCDE=$$ICDDX^ICDCODE(DXSIEN,ECDT) Q:+DXCDE<0 I '$P(DXCDE,U,10) Q
102 . . K DD,DO S X=DXSIEN D FILE^DICN
103 . . S DXCDE=$P(DXCDE,U,2),ECDXX(DXCDE)=DXSIEN
104 . . S ^DISV(DUZ,"^ICD9(")=DXSIEN ;last ICD9 code
105 . ; Update all procedures for an encounter with same primary & second dx
106 . S PXUPD=$$PXUPD^ECUTL2(ECDFN,ECDT,ECL,EC4,ECDXY,.ECDXX,ECFN)
107 . K PXUPD,ECDXY,ECDXX,DXS,DXSIEN,DIC,DXCDE,DA,DD,DO
108 I $D(DTOUT) D RECDEL,MSG Q
109 S DA=ECFN
110 ;File classification AO^IR^SC^EC^MST^HNC^CV
111 I $G(ECLASS)'="" D
112 . S CLSTR="21^22^24^23^35^39^40",DR=""
113 . F ECX=1:1:$L(CLSTR,"^") D
114 . . S DR=DR_$P(CLSTR,U,ECX)_"////"_$P(ECLASS,U,ECX)_";"
115 . S DR=$E(DR,1,($L(DR)-1)) D ^DIE
116 . K CLSTR,DR,DIE
117 I $D(DTOUT) D RECDEL,MSG Q
118 ;
119PCE ; format PCE data to send
120 I ($P(ECPCE,"~",2)="N")!($P(ECPCE,"~",2)="O"&(ECINP'="O")) D Q
121 .S ^TMP($J,"ECMSG",1)="1^Record Filed"
122 D:ECFLG PCE^ECBEN2U I 'ECFLG S EC(0)=^ECH(ECFN,0) D PCEE^ECBEN2U K EC
123 I $G(ECOUT)!(ECERR) D Q
124 . D RECDEL S STR=$S($G(^ECH(ECFN,"R")):^("R"),1:" PCE Data Missing")
125 . S ^TMP($J,"ECMSG",1)="0^Record Not Filed, "_STR K STR
126 S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_$G(ECIEN)
127 Q
128 ;
129NEWIEN ;Create new IEN in file #721
130 N DIC,DA,DD,DO,ECRN
131RLCK L +^ECH(0) S ECRN=$P(^ECH(0),"^",3)+1
132 I $D(^ECH(ECRN)) S $P(^ECH(0),"^",3)=$P(^(0),"^",3)+1 L -^ECH(0) G RLCK
133 L -^ECH(0) S DIC(0)="L",DIC="^ECH(",X=ECRN
134 D FILE^DICN S ECIEN=+Y
135 Q
136RECDEL ; Delete record
137 ;restore old data
138 I 'ECFLG D Q
139 . I $O(OLDMOD("")) D
140 . . S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,36,0),U,2)
141 . . S DIC="^ECH("_DA(1)_","_"""MOD"""_",",ECX=0
142 . . F S ECX=$O(OLDMOD(ECX)) Q:'ECX I ECX>0 K DD,DO S X=ECX D FILE^DICN
143 . I $O(OLDDXS("")) D
144 . . S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,38,0),U,2)
145 . . S DIC="^ECH("_DA(1)_","_"""DX"""_",",ECX=0
146 . . F S ECX=$O(OLDDXS(ECX)) Q:'ECX I ECX>0 K DD,DO S X=ECX D FILE^DICN
147 . K DIC,DA,DD,DO,OLDMOD,OLDDXS,ECX
148 S DA=ECFN,DIK="^ECH(" D ^DIK K DA,DIK
149 Q
150MSG ;Record not filed
151 S ^TMP($J,"ECMSG",1)="0^Record not Filed"
152 Q
153CHKDT(FLG) ;Required Data Check
154 N I,C
155 S C=1
156 I FLG=1 D Q
157 .F I="ECD","ECC","ECL","ECDT","ECP","ECDFN","ECMN","ECDUZ","ECPTSTAT" D
158 ..I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
159 .I $G(ECDEL),$D(ECIEN) K ^TMP($J,"ECMSG") S ECERR=0
160 ;check PCE data
161 I FLG=2 D Q
162 .F I="EC4","ECDX" D Q
163 ..I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key PCE data missing "_I,C=C+1,ECERR=1
164 Q
165VALDATA ;validate data
166 N ECRRX
167 D CHK^DIE(721,1,,"`"_ECDFN,.ECRRX) I ECRRX'=ECDFN D Q
168 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Patient"
169 D CHK^DIE(721,2,,ECDT,.ECRRX) I ECRRX'=ECDT D Q
170 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure Date"
171 D CHK^DIE(721,3,,"`"_ECL,.ECRRX) I ECRRX'=ECL D Q
172 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Location"
173 D CHK^DIE(721,6,,"`"_ECD,.ECRRX) I ECRRX'=ECD D Q
174 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid DSS Unit"
175 D CHK^DIE(721,7,,"`"_ECC,.ECRRX) I ECRRX'=ECC D Q
176 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Category"
177 D I ECERR Q
178 .I ECP["ICPT" S ECRRX=$$CPT^ICPTCOD(+ECP,ECDT) I +ECRRX>0,$P(ECRRX,U,7) Q
179 .I ECP["EC",$D(^EC(725,+ECP,0)) Q
180 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure"
181 D CHK^DIE(721,11,,"`"_ECMN,.ECRRX) I ECRRX'=ECMN D Q
182 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Ordering Section"
183 D CHK^DIE(721,20,,"`"_ECDX,.ECRRX) I ECRRX'=ECDX D Q
184 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Primary Diagnosis"
185 I $G(EC4)'="" D CHK^DIE(721,26,,"`"_EC4,.ECRRX) I ECRRX'=EC4 D Q
186 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Associated Clinic"
187 Q
Note: See TracBrowser for help on using the repository browser.