source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBBAADTI.m@ 1259

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1IBBAADTI ;OAK/ELZ - PFSS INBOUND FILER ;15-MAR-2005
2 ;;2.0;INTEGRATED BILLING;**286**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5A04 ;receiver for returned A04 messages to create account
6 N IBBHDR,IBBMSG,IBBDFN,IBBARFN,IBBEXVN,HLERR
7 Q:'$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR)
8 I $G(IBBHDR("EVENT"))'="A04" Q
9 S IBBDFN=+$$PID()
10 I 'IBBDFN S HLERR="Patient data could not be matched to database." D NAK Q
11 S IBBEXVN=+$$EXVN()
12 I 'IBBEXVN S HLERR="External billing system account # is not defined." D NAK Q
13 S IBBARFN=$$SET(IBBDFN,HLMTIENS)
14 I 'IBBARFN S HLERR="External billing system account # could not be filed." D NAK Q
15 I IBBARFN D ACK
16 Q
17 ;
18A05 ;receiver for returned A05 messages to create account
19 N IBBHDR,IBBMSG,IBBDFN,IBBARFN,IBBEXVN,HLERR
20 Q:'$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR)
21 I $G(IBBHDR("EVENT"))'="A05" Q
22 S IBBDFN=$$PID()
23 I 'IBBDFN S HLERR="Patient data could not be matched to database." D NAK Q
24 S IBBEXVN=+$$EXVN()
25 I 'IBBEXVN S HLERR="External billing system account # is not defined." D NAK Q
26 S IBBARFN=$$SET(IBBDFN,HLMTIENS)
27 I 'IBBARFN S HLERR="External billing system account # could not be filed." D NAK Q
28 I IBBARFN D ACK
29 Q
30 ;
31SET(IBBDFN,HLMTIENS) ;set returned external account number in file #375
32 N DIC,IEN1,IEN2,IENS,REC,PHYS,PHYSX,ALTNUM,ALTNUMX,PROC,PROCX,OUT,OK,X,XX
33 N IBBEVENT,IBBEXVN,IBBWHEN,IBBWHERE,IBBARFN,IBBIEN,IBBMSG,IBBHDR,IBBSEG,IBBARRAY
34 S IBBARFN=""
35 Q:'$G(HLMTIENS) IBBARFN
36 Q:'$G(IBBDFN) IBBARFN
37 Q:'$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR) IBBARFN
38 ;parse critical data elements from HL7 msg
39 S OUT=0
40 F Q:OUT Q:'$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG) D
41 .I IBBSEG("SEGMENT TYPE")="EVN" D Q
42 ..S (XX,IBBEVENT)=$$GET^HLOPRS(.IBBSEG,1,1,)
43 ..I ";A01;A04;A05;"'[(";"_XX_";") S OUT=1
44 .I IBBSEG("SEGMENT TYPE")="PV1" D Q
45 ..S IBBWHERE=$$GET^HLOPRS(.IBBSEG,3,1)
46 ..S PHYS=$E($$GET^HLOPRS(.IBBSEG,7,1),4,99)
47 ..S IBBARFN=$$GET^HLOPRS(.IBBSEG,5,1)
48 ..S IBBEXVN=$$GET^HLOPRS(.IBBSEG,19,1)
49 ..S ALTNUM=$$GET^HLOPRS(.IBBSEG,50,1)
50 ..S XX=$$GET^HLOPRS(.IBBSEG,44,1),IBBWHEN=$$FMDATE^HLFNC(XX)
51 .I IBBSEG("SEGMENT TYPE")="PR1" D Q
52 ..S PROC=$$GET^HLOPRS(.IBBSEG,3,1)
53 ;exit if not event type of interest
54 Q:OUT IBBARFN
55 ;exit if external visit already known for A01 event
56 I IBBEVENT="A01",IBBWHERE'="FEE BASIS" S X=$$INTNUM(IBBEXVN) I X S IBBARFN=X Q IBBARFN
57 ;resolve location
58 I IBBWHERE'="FEE BASIS" D
59 .K Y S DIC=44,DIC(0)="MXZ",X=IBBWHERE
60 .D ^DIC
61 .I $P($G(Y),U,2)=IBBWHERE S IBBWHERE=+Y
62 I IBBWHERE="FEE BASIS" S IBBWHEN=$P(IBBWHEN,".",1)
63 ;verify account record if IBBARFN is not null
64 I IBBARFN D I 'OK S IBBARFN=""
65 .S OK=1,IBBIEN=0
66 .S IENS=IBBARFN_"," D GETS^DIQ(375,IENS,".01;.03;1.03;1.44;16.01","I","IBBARRAY")
67 .I IBBARFN'=$G(IBBARRAY(375,IENS,.01,"I")) S OK=0 Q
68 .I IBBDFN'=$G(IBBARRAY(375,IENS,.03,"I")) S OK=0 Q
69 .I IBBWHEN'=$G(IBBARRAY(375,IENS,1.44,"I")) S OK=0 Q
70 .I IBBEVENT="A01",IBBWHERE'=$G(IBBARRAY(375,IENS,16.01,"I")) S OK=0 Q
71 .I ((IBBEVENT="A04")!(IBBEVENT="A05"))&(IBBWHERE'=$G(IBBARRAY(375,IENS,1.03,"I"))) S OK=0 Q
72 .S IBBIEN=IBBARFN
73 ;find account record if IBBARFN is null; should be used (normally) only for inpatient A01
74 I 'IBBARFN D
75 .S IBBIEN=0
76 .I IBBWHERE=+IBBWHERE D
77 ..S IEN1=+$O(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,0))
78 ..S IEN2=+$O(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IEN1))
79 .I IBBWHERE'=+IBBWHERE D
80 ..S IEN1=+$O(^IBBAA(375,"AF",IBBDFN,IBBWHEN,IBBWHERE,0))
81 ..S IEN2=+$O(^IBBAA(375,"AF",IBBDFN,IBBWHEN,IBBWHERE,IEN1))
82 .;inpatient admission
83 .I 'IEN1,IBBEVENT="A01",IBBWHERE'="FEE BASIS" S IBBIEN=$$INPT() Q
84 .;unique index entry
85 .I IEN1,'IEN2 S IBBIEN=IEN1
86 .;multiple index entries
87 .I 'IBBIEN,IEN2,IBBWHERE=+IBBWHERE D
88 ..S IEN1=0 F S IEN1=+$O(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IEN1)) Q:'IEN1 D Q:IBBIEN
89 ...S REC=$G(^IBBAA(375,IEN1,"PV1")),ALTNUMX=+$P(REC,U,50)
90 ...I $G(ALTNUM),ALTNUMX=ALTNUM S IBBIEN=IEN1 Q
91 ...I $G(ALTNUM),ALTNUMX'=ALTNUM Q
92 ...S PHYSX=$P(REC,U,7)
93 ...I $G(PHYS),PHYSX=PHYS S IBBIEN=IEN1 Q
94 ...I $G(PHYS),PHYSX'=PHYS Q
95 ...I $G(PROC)'="" S PROC=$$CODEN^ICPTCOD(PROC),PROCX=$P($G(^IBBAA(375,IEN1,"PR1")),U,3)
96 ...I +PROC,PROCX=PROC S IBBIEN=IEN1 Q
97 ;store external visit #
98 I $G(IBBIEN) D
99 .S:('IBBARFN) IBBARFN=IBBIEN
100 .I $P(^IBBAA(375,IBBIEN,0),U,2)="" D
101 ..S $P(^IBBAA(375,IBBIEN,0),U,2)=IBBEXVN
102 ..S $P(^IBBAA(375,IBBIEN,0),U,5)=$$NOW^XLFDT()
103 ..D EVENT^IBBAACCT(IBBIEN,IBBEVENT,"I")
104 Q IBBARFN
105 ;
106INPT() ;set new account record for inpatient admission
107 N IBB,IBBARFN,IBBIEN,IBBIENS,IBBERR,FDA,X
108 S IBBARFN=0
109 L +^IBBAA(375,0):5
110 Q:'$T 0
111 S IBBIEN=$P(^IBBAA(375,0),U,3)+1
112 S IBBIEN(1)=IBBIEN
113 S IBBIENS="+1,"
114 S IBBERR="IBB(""DIERR"")"
115 S FDA(375,IBBIENS,.01)=IBBIEN
116 S FDA(375,IBBIENS,.02)=IBBEXVN
117 S FDA(375,IBBIENS,.03)=IBBDFN
118 S FDA(375,IBBIENS,.04)="COTS_SYSTEM"
119 S FDA(375,IBBIENS,.05)=$$NOW^XLFDT
120 D UPDATE^DIE("","FDA","IBBIEN",IBBERR)
121 L -^IBBAA(375,0)
122 I '$D(IBB("DIERR")) D
123 .S IBBARFN=IBBIEN
124 .S X="",$P(X,U,2)="I",$P(X,U,3)=IBBWHERE,$P(X,U,44)=IBBWHEN
125 .S ^IBBAA(375,IBBIEN,"PV1")=X
126 .D EVENT^IBBAACCT(IBBIEN,IBBEVENT,"I")
127 .S ^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IBBIEN)=""
128 Q IBBARFN
129 ;
130INTNUM(IBBEXVN) ;return PFSS Account Reference using external visit number
131 N IBBARFN,XX
132 S IBBARFN=""
133 Q:'$G(IBBEXVN) IBBARFN
134 S XX=$O(^IBBAA(375,"C",IBBEXVN,0))
135 I XX S IBBARFN=XX
136 Q IBBARFN
137 ;
138PID() ;get DFN from HL7 message; compare to file #2 data
139 N IBBARRY,OUT,REP,FILE,FIELD,IENS,XID,XTYP,XSITE,XSSN,XNAME,XX
140 S OUT=0,XID=0,XSSN=0
141 F Q:OUT Q:'$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG) I IBBSEG("SEGMENT TYPE")="PID" D
142 .S XNAME=$$GET^HLOPRS(.IBBSEG,5,1,1)
143 .F REP=1:1 Q:OUT D
144 ..S XTYP=$$GET^HLOPRS(.IBBSEG,3,5,1,REP)
145 ..I XTYP="PI" D
146 ...S XX=$$GET^HLOPRS(.IBBSEG,3,1,1,REP)
147 ...S XSITE=+$E(XX,1,3),XID=+$E(XX,4,99)
148 ..I XTYP="SS" S XSSN=$$GET^HLOPRS(.IBBSEG,3,1,1,REP)
149 ..I XID&XSSN S OUT=1
150 I XSITE=$P($$SITE^VASITE(),U,3) D
151 .S FILE=2,IENS=XID_",",FIELD=".01;.09"
152 .D GETS^DIQ(FILE,IENS,FIELD,"","IBBARRY")
153 .I XSSN'=$G(IBBARRY(2,IENS,.09)) S XID=0
154 .I XNAME'=$P($G(IBBARRY(2,IENS,.01)),",",1) S XID=0
155 Q XID
156 ;
157EXVN() ;external account/visit number must be non-null
158 N OUT,IBBEXVN
159 S IBBEXVN="",OUT=0
160 F Q:OUT Q:'$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG) D
161 .I IBBSEG("SEGMENT TYPE")="PV1" D Q
162 ..S IBBEXVN=$$GET^HLOPRS(.IBBSEG,19,1),OUT=1
163 Q IBBEXVN
164 ;
165ACK ; prepare positive acknowledgement (AA) message
166 N HLA,HLRESULT
167 S XX=$$SETPURG^HLUTIL(0)
168 S HLA("HLA",$J,1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")
169 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.HLRESULT)
170 Q
171 ;
172NAK ;prepare negative acknowledgement (AE) message
173 N HLA,HLRESULT
174 S XX=$$SETPURG^HLUTIL(1)
175 S HLA("HLA",$J,1)="MSA"_HL("FS")_"AE"_HL("FS")_HL("MID")_HL("FS")_HLERR
176 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.HLRESULT)
177 Q
178 ;
179IBBACONV(IBBDFN,IBBTYPE,IBBWHEN,IBBWHERE,IBBEXVN) ;new account record for converted inpatient or outpatient
180 ;called only from DG or SD routine during back-load of converted data
181 ;input IBBDFN = pointer to file #2
182 ; IBBTYPE = I(npatient) or O(utpatient)
183 ; IBBWHEN = date/time of visit; internal FM format
184 ; IBBWHERE = location of visit; pointer to file #44
185 ; IBBEXVN = external system visit #
186 ;output IBBARFN = ien in file #375; PFSS Account Reference
187 ;
188 N IBB,IBBARFN,IBBIEN,IBBIENS,IBBERR,FDA,X
189 S IBBARFN=0
190 L +^IBBAA(375,0):5
191 Q:'$T 0
192 S IBBIEN=$P(^IBBAA(375,0),U,3)+1
193 S IBBIEN(1)=IBBIEN
194 S IBBIENS="+1,"
195 S IBBERR="IBB(""DIERR"")"
196 S FDA(375,IBBIENS,.01)=IBBIEN
197 S FDA(375,IBBIENS,.02)=$G(IBBEXVN)
198 S FDA(375,IBBIENS,.03)=$G(IBBDFN)
199 S FDA(375,IBBIENS,.04)="CONVERSION"
200 S FDA(375,IBBIENS,.05)=$$NOW^XLFDT
201 D UPDATE^DIE("","FDA","IBBIEN",IBBERR)
202 L -^IBBAA(375,0)
203 I '$D(IBB("DIERR")) D
204 .S IBBARFN=IBBIEN
205 .S X="",$P(X,U,2)=$G(IBBTYPE),$P(X,U,3)=$G(IBBWHERE),$P(X,U,44)=$G(IBBWHEN)
206 .S ^IBBAA(375,IBBIEN,"PV1")=X
207 .I IBBTYPE="O" S $P(^IBBAA(375,IBBIEN,"PV2"),U,8)=$G(IBBWHEN)
208 .I $G(IBBDFN),$G(IBBWHEN),$G(IBBWHERE) S ^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IBBIEN)=""
209 Q IBBARFN
Note: See TracBrowser for help on using the repository browser.