source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEBF.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1IBCNEBF ;DAOU/ALA - Create an Entry in the Buffer File ;20-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271,361,371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;**Program Description**
6 ; This program will create a Buffer entry based upon input values
7 ;
8 Q
9 ;
10PT(DFN,IRIEN,SYMBOL,OVRRIDE,ADD,IBERROR) ; Get data
11 ; from a specific patient and insurance record entry
12 ;
13 ; Input Parameters
14 ; DFN = Patient IEN
15 ; IRIEN = Patient Insurance Record IEN
16 ; SYMBOL = IIV Symbol IEN
17 ; OVRRIDE = Override flag for ins. buffer record (0 or 1)
18 ; ADD = If defined, then it will add a new Buffer entry
19 ; IBERROR = If defined, then it will be updated with error info.
20 ; OPTIONALLY PASSED BY REFERENCE
21 ;
22 I DFN=""!(IRIEN="") Q ; * do not require SYMBOL or OVRRIDE
23 ;
24 ;
25 NEW VBUF,IEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
26 NEW BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
27 NEW MSG,XMSUB,MSGP,INSDATA,PCE,BFD,BFN,INSPCE,ESGHPARR
28 ;
29 S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1)
30 S INAME=$$GET1^DIQ(36,IIEN,.01,"E")
31 S PPHONE=$P($G(^DIC(36,IIEN,.13)),U,3)
32 S BPHONE=$P($G(^DIC(36,IIEN,.13)),U,2)
33 S NAME=$P($G(^DPT(DFN,.312,IRIEN,0)),U,17)
34 S SUBID=$P($G(^DPT(DFN,.312,IRIEN,0)),U,2)
35 S PATID=$P($G(^DPT(DFN,.312,IRIEN,5)),U,1)
36 S WHO=$P($G(^DPT(DFN,.312,IRIEN,0)),U,6)
37 S COB=$P($G(^DPT(DFN,.312,IRIEN,0)),U,20)
38 S IDOB=$P($G(^DPT(DFN,.312,IRIEN,3)),U,1)
39 S ISSN=$P($G(^DPT(DFN,.312,IRIEN,3)),U,5)
40 S ISEX=$P($G(^DPT(DFN,.312,IRIEN,3)),U,12)
41 S EFFDT=$P(^DPT(DFN,.312,IRIEN,0),U,8)
42 S EXPDT=$P(^DPT(DFN,.312,IRIEN,0),U,4)
43 S REL=$P(^DPT(DFN,.312,IRIEN,0),U,16)
44 ;
45 S IENS=IRIEN_","_DFN_","
46 S GNUMB=$$GET1^DIQ(2.312,IENS,21,"E")
47 S GNAME=$$GET1^DIQ(2.312,IENS,20,"E")
48 ;
49 ; Capture the employer sponsored insurance fields into array
50 ; ESGHPARR(buffer field number) = data
51 ;
52 S INSDATA=$G(^DPT(DFN,.312,IRIEN,2)),PCE=0
53 F BFD=5:1:12,2,1,3,4 S PCE=PCE+1,BFN=BFD/100+61,INSPCE=$P(INSDATA,U,PCE) I INSPCE'="" S ESGHPARR(BFN)=INSPCE
54 ;
55 D FIL
56 K ADD
57 Q
58 ;
59RP(IEN,ADD,BUFF) ; Get data from a specific response record
60 ;
61 ; Input Parameter
62 ; IEN = Internal entry number of the Response
63 ; ADD = If defined, then it will add a new Buffer entry
64 ; BUFF = IEN of the Buffer Entry to be updated (optional)
65 ;
66 S BUFF=$G(BUFF) ; Initialize optional parameter
67 ;
68 NEW PIEN,RSTYPE
69 S DFN=$P(^IBCN(365,IEN,0),U,2),TQIEN=$P(^IBCN(365,IEN,0),U,5)
70 S PIEN=$P(^IBCN(365,IEN,0),U,3),RSTYPE=$P(^(0),U,10)
71 I PIEN'="" S PNAME=$P(^IBE(365.12,PIEN,0),U,1)
72 I TQIEN'="" S IRIEN=$P($G(^IBCN(365.1,TQIEN,0)),U,13)
73 I $G(IRIEN)'="" S INAME="" D
74 . S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1)
75 . I IIEN="" Q
76 . S INAME=$P(^DIC(36,IIEN,0),U,1)
77 S RDATA=$G(^IBCN(365,IEN,1))
78 S NAME=$P(RDATA,U,1)
79 S INAME=$S($G(INAME)'=""&(RSTYPE="O"):INAME,1:$G(PNAME))
80 S IDOB=$P(RDATA,U,2)
81 S ISSN=$P(RDATA,U,3)
82 S ISEX=$P(RDATA,U,4)
83 S COB=$P(RDATA,U,13)
84 S SUBID=$P(RDATA,U,5)
85 S PATID=$P(RDATA,U,18)
86 S GNAME=$P(RDATA,U,6)
87 S GNUMB=$P(RDATA,U,7)
88 S WHO=$P(RDATA,U,8)
89 S REL=$P(RDATA,U,9)
90 S EFFDT=$P(RDATA,U,11)
91 S EXPDT=$P(RDATA,U,12)
92 S PPHONE="",BPHONE=""
93 ;
94 D FIL
95 K DFN,VBUF,IEN,IRIEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
96 K BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
97 K ADD,%DT,D0,DG,DIC,DISYS,DIW,IENS
98 Q
99 ;
100FIL ; File Buffer Data
101 ;
102 S MSGP=$$MGRP^IBCNEUT5()
103 ;
104 ; Variable IDUZ is optionally set by the calling routine. If it is
105 ; not defined, it will be set to the specific, non-human user.
106 ;
107 I $G(IDUZ)="" S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV")
108 ;
109 I $G(ADD) S VBUF(.02)=IDUZ ; Entered By
110 S VBUF(.12)=$G(SYMBOL) ; Buffer Symbol
111 S VBUF(.13)=$G(OVRRIDE) ; Override freshness flag
112 I '$G(ERACT) D ; Only file if not an error
113 . S VBUF(20.01)=INAME ; Insurance Company/Payer Name
114 . S VBUF(60.01)=DFN ; Patient IEN
115 . S VBUF(40.03)=GNUMB ; Group Number
116 . S VBUF(40.02)=GNAME ; Group Name
117 . S VBUF(60.07)=NAME ; Name of Insured
118 . S VBUF(60.04)=SUBID ; Subscriber ID
119 . S VBUF(62.01)=PATID ; Patient/Member ID
120 . S VBUF(20.04)=PPHONE ; Precertification Phone
121 . S VBUF(20.03)=BPHONE ; Billing Phone
122 . S VBUF(60.02)=EFFDT ; Effective Date
123 . S VBUF(60.03)=EXPDT ; Expiration Date
124 . S VBUF(60.05)=WHO ; Whose Insurance
125 . S VBUF(60.06)=REL ; Patient Relationship
126 . S VBUF(60.08)=IDOB ; Insured's DOB
127 . S VBUF(60.09)=ISSN ; Insured's SSN
128 . S VBUF(60.12)=COB ; Coordination of Benefits
129 . S VBUF(60.13)=ISEX ; Insured's Sex
130 . ;
131 . ; If the employer sponsored insurance array exists, then merge it in
132 . I $D(ESGHPARR) M VBUF=ESGHPARR
133 ;
134 ; Do not overwrite the existing insurance co. name if it already exists
135 I $G(ADD)="",$G(BUFF)'="" K VBUF(20.01)
136 ;
137 ; ** initialize IBERROR
138 S IBERROR=""
139 ;
140 ; If need to add a new Buffer entry ...
141 ;
142 ; Variable IBFDA is returned to the calling routine as the IEN of
143 ; the buffer entry that was just added.
144 ;
145 I $G(ADD) D
146 . S IBFDA=$$ADDSTF^IBCNBES(5,DFN,.VBUF)
147 . ; Error Message is 2nd piece of result
148 . S IBERROR=$P(IBFDA,U,2)
149 . S IBFDA=$P(IBFDA,U,1)
150 ;
151 ; If an error, send an email message
152 I IBERROR'="" D Q
153 . S MSG(1)="Error returned by $$ADDSTF^IBCNBES:"
154 . S MSG(2)=IBERROR
155 . S MSG(3)="Values:"
156 . S MSG(4)=" Patient DFN = "_$G(DFN)
157 . S MSG(5)=" Pt Ins Record IEN = "_$G(IRIEN)
158 . S MSG(6)="Please log a Remedy Ticket for this problem."
159 . S XMSUB="Error creating Buffer Entry."
160 . D MSG^IBCNEUT5(MSGP,XMSUB,"MSG(")
161 . K MSGP,MSG,XMSUB,IBERR
162 ;
163 ; If need to update a new Buffer Entry ...
164 ;
165 ; Variable BUFF is passed into this routine whenever the buffer
166 ; entry is known and the ADD flag is off. The existing buffer entry
167 ; is edited in this case.
168 ;
169 I $G(ADD)="" D EDITSTF^IBCNBES(BUFF,.VBUF)
170 ;
171 ; If an error occurred in EDITSTF, the error array is not returned
172 ;
173 Q
Note: See TracBrowser for help on using the repository browser.