IBCNEBF	;DAOU/ALA - Create an Entry in the Buffer File ;20-JUN-2002
	;;2.0;INTEGRATED BILLING;**184,271,361,371**;21-MAR-94;Build 57
	;;Per VHA Directive 2004-038, this routine should not be modified.
	;
	;**Program Description**
	;  This program will create a Buffer entry based upon input values
	;
	Q
	;
PT(DFN,IRIEN,SYMBOL,OVRRIDE,ADD,IBERROR)	;  Get data
	;   from a specific patient and insurance record entry
	;
	;  Input Parameters
	;    DFN = Patient IEN
	;    IRIEN = Patient Insurance Record IEN
	;    SYMBOL = IIV Symbol IEN
	;    OVRRIDE = Override flag for ins. buffer record  (0 or 1)
	;    ADD = If defined, then it will add a new Buffer entry
	;    IBERROR = If defined, then it will be updated with error info.
	;              OPTIONALLY PASSED BY REFERENCE
	;
	I DFN=""!(IRIEN="") Q   ; * do not require SYMBOL or OVRRIDE
	;
	;
	NEW VBUF,IEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
	NEW BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
	NEW MSG,XMSUB,MSGP,INSDATA,PCE,BFD,BFN,INSPCE,ESGHPARR
	;
	S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1)
	S INAME=$$GET1^DIQ(36,IIEN,.01,"E")
	S PPHONE=$P($G(^DIC(36,IIEN,.13)),U,3)
	S BPHONE=$P($G(^DIC(36,IIEN,.13)),U,2)
	S NAME=$P($G(^DPT(DFN,.312,IRIEN,0)),U,17)
	S SUBID=$P($G(^DPT(DFN,.312,IRIEN,0)),U,2)
	S PATID=$P($G(^DPT(DFN,.312,IRIEN,5)),U,1)
	S WHO=$P($G(^DPT(DFN,.312,IRIEN,0)),U,6)
	S COB=$P($G(^DPT(DFN,.312,IRIEN,0)),U,20)
	S IDOB=$P($G(^DPT(DFN,.312,IRIEN,3)),U,1)
	S ISSN=$P($G(^DPT(DFN,.312,IRIEN,3)),U,5)
	S ISEX=$P($G(^DPT(DFN,.312,IRIEN,3)),U,12)
	S EFFDT=$P(^DPT(DFN,.312,IRIEN,0),U,8)
	S EXPDT=$P(^DPT(DFN,.312,IRIEN,0),U,4)
	S REL=$P(^DPT(DFN,.312,IRIEN,0),U,16)
	;
	S IENS=IRIEN_","_DFN_","
	S GNUMB=$$GET1^DIQ(2.312,IENS,21,"E")
	S GNAME=$$GET1^DIQ(2.312,IENS,20,"E")
	;
	; Capture the employer sponsored insurance fields into array
	;   ESGHPARR(buffer field number) = data
	;
	S INSDATA=$G(^DPT(DFN,.312,IRIEN,2)),PCE=0
	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
	;
	D FIL
	K ADD
	Q
	;
RP(IEN,ADD,BUFF)	;  Get data from a specific response record
	;
	;  Input Parameter
	;    IEN  = Internal entry number of the Response
	;    ADD  = If defined, then it will add a new Buffer entry
	;    BUFF = IEN of the Buffer Entry to be updated (optional)
	;
	S BUFF=$G(BUFF) ; Initialize optional parameter
	;
	NEW PIEN,RSTYPE
	S DFN=$P(^IBCN(365,IEN,0),U,2),TQIEN=$P(^IBCN(365,IEN,0),U,5)
	S PIEN=$P(^IBCN(365,IEN,0),U,3),RSTYPE=$P(^(0),U,10)
	I PIEN'="" S PNAME=$P(^IBE(365.12,PIEN,0),U,1)
	I TQIEN'="" S IRIEN=$P($G(^IBCN(365.1,TQIEN,0)),U,13)
	I $G(IRIEN)'="" S INAME="" D
	. S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1)
	. I IIEN="" Q
	. S INAME=$P(^DIC(36,IIEN,0),U,1)
	S RDATA=$G(^IBCN(365,IEN,1))
	S NAME=$P(RDATA,U,1)
	S INAME=$S($G(INAME)'=""&(RSTYPE="O"):INAME,1:$G(PNAME))
	S IDOB=$P(RDATA,U,2)
	S ISSN=$P(RDATA,U,3)
	S ISEX=$P(RDATA,U,4)
	S COB=$P(RDATA,U,13)
	S SUBID=$P(RDATA,U,5)
	S PATID=$P(RDATA,U,18)
	S GNAME=$P(RDATA,U,6)
	S GNUMB=$P(RDATA,U,7)
	S WHO=$P(RDATA,U,8)
	S REL=$P(RDATA,U,9)
	S EFFDT=$P(RDATA,U,11)
	S EXPDT=$P(RDATA,U,12)
	S PPHONE="",BPHONE=""
	;
	D FIL
	K DFN,VBUF,IEN,IRIEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
	K BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
	K ADD,%DT,D0,DG,DIC,DISYS,DIW,IENS
	Q
	;
FIL	;  File Buffer Data
	;
	S MSGP=$$MGRP^IBCNEUT5()
	;
	; Variable IDUZ is optionally set by the calling routine.  If it is
	; not defined, it will be set to the specific, non-human user.
	;
	I $G(IDUZ)="" S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV")
	;
	I $G(ADD) S VBUF(.02)=IDUZ  ; Entered By
	S VBUF(.12)=$G(SYMBOL)   ; Buffer Symbol
	S VBUF(.13)=$G(OVRRIDE) ; Override freshness flag
	I '$G(ERACT) D  ; Only file if not an error
	. S VBUF(20.01)=INAME  ; Insurance Company/Payer Name
	. S VBUF(60.01)=DFN  ; Patient IEN
	. S VBUF(40.03)=GNUMB  ; Group Number
	. S VBUF(40.02)=GNAME  ; Group Name
	. S VBUF(60.07)=NAME  ; Name of Insured
	. S VBUF(60.04)=SUBID  ; Subscriber ID
	. S VBUF(62.01)=PATID  ; Patient/Member ID
	. S VBUF(20.04)=PPHONE  ; Precertification Phone
	. S VBUF(20.03)=BPHONE  ; Billing Phone
	. S VBUF(60.02)=EFFDT  ; Effective Date
	. S VBUF(60.03)=EXPDT  ; Expiration Date
	. S VBUF(60.05)=WHO  ; Whose Insurance
	. S VBUF(60.06)=REL  ;  Patient Relationship
	. S VBUF(60.08)=IDOB  ;  Insured's DOB
	. S VBUF(60.09)=ISSN  ;  Insured's SSN
	. S VBUF(60.12)=COB  ;  Coordination of Benefits
	. S VBUF(60.13)=ISEX  ;  Insured's Sex
	. ;
	. ; If the employer sponsored insurance array exists, then merge it in
	. I $D(ESGHPARR) M VBUF=ESGHPARR
	;
	; Do not overwrite the existing insurance co. name if it already exists
	I $G(ADD)="",$G(BUFF)'="" K VBUF(20.01)
	;
	; ** initialize IBERROR
	S IBERROR=""
	;
	;  If need to add a new Buffer entry ...
	;
	;  Variable IBFDA is returned to the calling routine as the IEN of
	;  the buffer entry that was just added.
	;
	I $G(ADD) D
	. S IBFDA=$$ADDSTF^IBCNBES(5,DFN,.VBUF)
	. ; Error Message is 2nd piece of result
	. S IBERROR=$P(IBFDA,U,2)
	. S IBFDA=$P(IBFDA,U,1)
	;
	;  If an error, send an email message
	I IBERROR'="" D  Q
	. S MSG(1)="Error returned by $$ADDSTF^IBCNBES:"
	. S MSG(2)=IBERROR
	. S MSG(3)="Values:"
	. S MSG(4)=" Patient DFN = "_$G(DFN)
	. S MSG(5)=" Pt Ins Record IEN = "_$G(IRIEN)
	. S MSG(6)="Please log a Remedy Ticket for this problem."
	. S XMSUB="Error creating Buffer Entry."
	. D MSG^IBCNEUT5(MSGP,XMSUB,"MSG(")
	. K MSGP,MSG,XMSUB,IBERR
	;
	;  If need to update a new Buffer Entry ...
	;
	;  Variable BUFF is passed into this routine whenever the buffer
	;  entry is known and the ADD flag is off.  The existing buffer entry
	;  is edited in this case.
	;
	I $G(ADD)="" D EDITSTF^IBCNBES(BUFF,.VBUF)
	;
	;  If an error occurred in EDITSTF, the error array is not returned
	;
	Q