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

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

revised back to 6/30/08 version

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