IBCNEBF ;DAOU/ALA - Create an Entry in the Buffer File ;20-JUN-2002
;;2.0;INTEGRATED BILLING;**184,271,361,371,416,438,497,621,743**;21-MAR-94;Build 18
;;Per VHA Directive 6402, 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 = eIV 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
;
;
N VBUF,IDATA0,IDATA3,IDATA7,IEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
N BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
N MSG,XMSUB,MSGP,INSDATA,PCE,BFD,BFN,INSPCE,ESGHPARR
N SUBADDR1,SUBADDR2,SUBCITY,SUBSTATE,SUBZIP,SUBCNTRY,SUBCNDIV
;
S IDATA0=$G(^DPT(DFN,.312,IRIEN,0)),IDATA3=$G(^DPT(DFN,.312,IRIEN,3))
S IDATA7=$G(^DPT(DFN,.312,IRIEN,7))
S IIEN=$P(IDATA0,U,1),INAME=$$GET1^DIQ(36,IIEN,.01,"E")
S PPHONE=$P($G(^DIC(36,IIEN,.13)),U,3),BPHONE=$P($G(^DIC(36,IIEN,.13)),U,2)
S NAME=$P(IDATA7,U,1),SUBID=$P(IDATA7,U,2)
S PATID=$P($G(^DPT(DFN,.312,IRIEN,5)),U,1)
S WHO=$P(IDATA0,U,6),COB=$P(IDATA0,U,20)
S IDOB=$P(IDATA3,U,1),ISSN=$P(IDATA3,U,5),ISEX=$P(IDATA3,U,12)
S EFFDT=$P(IDATA0,U,8),EXPDT=$P(IDATA0,U,4)
S REL=$P($G(^DPT(DFN,.312,IRIEN,4)),U,3)
S SUBADDR1=$P(IDATA3,U,6),SUBADDR2=$P(IDATA3,U,7)
S SUBCITY=$P(IDATA3,U,8),SUBSTATE=$P(IDATA3,U,9),SUBZIP=$P(IDATA3,U,10)
S SUBCNTRY=$P(IDATA3,U,13),SUBCNDIV=$P(IDATA3,U,14)
;
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
;
N BPHONE,COB,DFN,EFFDT,EXPDT,GNAME,GNUMB,IBSOURCE,IDOB,IIEN,INAME,IRIEN,ISEX,ISSN,NAME
N PATID,PIEN,PNAME,PPHONE,RDATA,RDATA5,RDATA13,RDATA14,REL,RSTYPE,SUBID,TQIEN,WHO
N SUBADDR1,SUBADDR2,SUBCITY,SUBSTATE,SUBZIP,SUBCNTRY,SUBCNDIV
;
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),IBSOURCE=$$GET1^DIQ(365.1,TQIEN_",",3.02,"I") ; IB*2.0*621 IBSOURCE
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)),RDATA5=$G(^IBCN(365,IEN,5))
S RDATA13=$G(^IBCN(365,IEN,13)),RDATA14=$G(^IBCN(365,IEN,14))
S NAME=$P(RDATA13,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(RDATA13,U,2)
S PATID=$P(RDATA,U,18)
S GNAME=$P(RDATA14,U,1)
S GNUMB=$P(RDATA14,U,2)
S WHO=$P(RDATA,U,8)
S REL=$$PREL^IBCNEHLU(355.33,60.14,$$GET1^DIQ(365,IEN,8.01)) ; IB*2*497 VALUE FROM 365,8.01 needs evaluation and possible conversion
S EFFDT=$P(RDATA,U,11)
S EXPDT=$P(RDATA,U,12)
S SUBADDR1=$P(RDATA5,U),SUBADDR2=$P(RDATA5,U,2),SUBCITY=$P(RDATA5,U,3)
S SUBSTATE=$P(RDATA5,U,4),SUBZIP=$P(RDATA5,U,5),SUBCNTRY=$P(RDATA5,U,6)
S SUBCNDIV=$P(RDATA5,U,7)
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,IBEISTC
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 EIV")
;
I $G(ADD) S VBUF(.02)=IDUZ ; Entered By
S VBUF(.12)=$G(SYMBOL) ; Buffer Symbol
S VBUF(.13)=$G(OVRRIDE) ; Override freshness flag
S VBUF(.18)=$G(IBELIGDT) ; eligibility date, only comes from ^IBCNEQU (real time eIV inquiry)
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(90.02)=GNUMB ; Group Number
. S VBUF(90.01)=GNAME ; Group Name
. S VBUF(91.01)=NAME ; Name of Insured
. S VBUF(90.03)=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.14)=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
. S VBUF(62.02)=SUBADDR1 ; Subscriber address line 1
. S VBUF(62.03)=SUBADDR2 ; Subscriber address line 2
. S VBUF(62.04)=SUBCITY ; Subscriber address city
. S VBUF(62.05)=SUBSTATE ; Subscriber address state
. S VBUF(62.06)=SUBZIP ; Subscriber address zip code
. S VBUF(62.07)=SUBCNTRY ; Subscriber address country code
. S VBUF(62.08)=SUBCNDIV ; Subscriber address country subdivision code
. ;
. ; Define Service Type Code (STC) to be sent with Insurance Inquiry
. ; IBEISTC contains the STC defined by User using option EI, otherwise default is sent
. I +$G(IBEISTC) S VBUF(80.01)=IBEISTC
. K IBEISTC
. ;
. ; 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 IBSOURCE=$G(IBSOURCE,5) ; IB*2.0*621 Added IBSOURCE to replace hard coded eIV
. ;IB*743/CKB - calling $$ADDSTF below in order to Lock/Unlock buffer entry
. S IBFDA=$$ADDSTF(IBSOURCE,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
;
;IB*743/CKB - the code below was copied from ADDSTF^IBCNBES to address the locking of the
; buffer without impacting other existing software
ADDSTF(IBSOURCE,DFN,IBDATA) ; add new entry to Insurance Buffer file (355.33) and stuff the data passed in, no user interaction
; IBSOURCE = source of information (required)
; 1 = interview 2 = data match
; 3 = ivm 4 = pre-registration
; 5 = eIV etc., refer to file #365.12 for full list of sources
; DFN = patient's ifn in file 2 (required)
; IBDATA = data to file in Buffer in an array subscripted by field number of the data field in 355.33
; ex: IBDATA(20.01)="Insurance Company Name", etc,
; returns ien of new entry or 0 followed by error if entry not added
;
; example of call: $$ADDBUF^IBCNBES(2,DFN,.IBDATA) where IBDATA(field #) = value
;
N X,Y,BUFLOCK,IBBUFDA,IBERROR
;
; verify source of information and data exists to store
I $G(IBSOURCE)="" S IBERROR="SOURCE OF INFORMATION INCORRECT" G EXIT
I $G(^DPT(+$G(DFN),0))="" S IBERROR="NO PATIENT DEFINED" G EXIT
I $D(IBDATA)<10 S IBERROR="NO DATA TO STORE" G EXIT
;
; add new entry to Buffer file (355.33)
S IBBUFDA=+$$ADD^IBCNBEE(IBSOURCE) I 'IBBUFDA S IBERROR="COULD NOT CREATE A NEW BUFFER ENTRY" G EXIT
;
; Lock the buffer entry
S BUFLOCK=$$BUFLOCK^IBCNEHL6(IBBUFDA,1)
;
S IBDATA(60.01)=+DFN
;
; Set up DUZ (interface user) so 60.01 field check can find 'valid reason' for sensitive
; patients and not set 60.01 to '0' with an error in tag FLDCHK
I '$G(DUZ) D DUZ^XUP(.5)
;
D EDITSTF^IBCNBES(+IBBUFDA,.IBDATA)
;
; Unlock buffer entry
I BUFLOCK,$$BUFLOCK^IBCNEHL6(IBBUFDA,0)
;
; delete leftover ESGHP data if ESGHP? is not Yes
I +$G(IBBUFDA),$D(^IBA(355.33,$G(IBBUFDA),61)),'$G(^IBA(355.33,$G(IBBUFDA),61)) D DELEMP^IBCNBEE($G(IBBUFDA))
;
EXIT Q +$G(IBBUFDA)_"^"_$G(IBERROR)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEBF 9698 printed Dec 13, 2024@02:14:23 Page 2
IBCNEBF ;DAOU/ALA - Create an Entry in the Buffer File ;20-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,271,361,371,416,438,497,621,743**;21-MAR-94;Build 18
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This program will create a Buffer entry based upon input values
+6 ;
+7 QUIT
+8 ;
PT(DFN,IRIEN,SYMBOL,OVRRIDE,ADD,IBERROR) ; Get data
+1 ; from a specific patient and insurance record entry
+2 ;
+3 ; Input Parameters
+4 ; DFN = Patient IEN
+5 ; IRIEN = Patient Insurance Record IEN
+6 ; SYMBOL = eIV Symbol IEN
+7 ; OVRRIDE = Override flag for ins. buffer record (0 or 1)
+8 ; ADD = If defined, then it will add a new Buffer entry
+9 ; IBERROR = If defined, then it will be updated with error info.
+10 ; OPTIONALLY PASSED BY REFERENCE
+11 ;
+12 ; * do not require SYMBOL or OVRRIDE
IF DFN=""!(IRIEN="")
QUIT
+13 ;
+14 ;
+15 NEW VBUF,IDATA0,IDATA3,IDATA7,IEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
+16 NEW BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
+17 NEW MSG,XMSUB,MSGP,INSDATA,PCE,BFD,BFN,INSPCE,ESGHPARR
+18 NEW SUBADDR1,SUBADDR2,SUBCITY,SUBSTATE,SUBZIP,SUBCNTRY,SUBCNDIV
+19 ;
+20 SET IDATA0=$GET(^DPT(DFN,.312,IRIEN,0))
SET IDATA3=$GET(^DPT(DFN,.312,IRIEN,3))
+21 SET IDATA7=$GET(^DPT(DFN,.312,IRIEN,7))
+22 SET IIEN=$PIECE(IDATA0,U,1)
SET INAME=$$GET1^DIQ(36,IIEN,.01,"E")
+23 SET PPHONE=$PIECE($GET(^DIC(36,IIEN,.13)),U,3)
SET BPHONE=$PIECE($GET(^DIC(36,IIEN,.13)),U,2)
+24 SET NAME=$PIECE(IDATA7,U,1)
SET SUBID=$PIECE(IDATA7,U,2)
+25 SET PATID=$PIECE($GET(^DPT(DFN,.312,IRIEN,5)),U,1)
+26 SET WHO=$PIECE(IDATA0,U,6)
SET COB=$PIECE(IDATA0,U,20)
+27 SET IDOB=$PIECE(IDATA3,U,1)
SET ISSN=$PIECE(IDATA3,U,5)
SET ISEX=$PIECE(IDATA3,U,12)
+28 SET EFFDT=$PIECE(IDATA0,U,8)
SET EXPDT=$PIECE(IDATA0,U,4)
+29 SET REL=$PIECE($GET(^DPT(DFN,.312,IRIEN,4)),U,3)
+30 SET SUBADDR1=$PIECE(IDATA3,U,6)
SET SUBADDR2=$PIECE(IDATA3,U,7)
+31 SET SUBCITY=$PIECE(IDATA3,U,8)
SET SUBSTATE=$PIECE(IDATA3,U,9)
SET SUBZIP=$PIECE(IDATA3,U,10)
+32 SET SUBCNTRY=$PIECE(IDATA3,U,13)
SET SUBCNDIV=$PIECE(IDATA3,U,14)
+33 ;
+34 SET IENS=IRIEN_","_DFN_","
+35 SET GNUMB=$$GET1^DIQ(2.312,IENS,21,"E")
+36 SET GNAME=$$GET1^DIQ(2.312,IENS,20,"E")
+37 ;
+38 ; Capture the employer sponsored insurance fields into array
+39 ; ESGHPARR(buffer field number) = data
+40 ;
+41 SET INSDATA=$GET(^DPT(DFN,.312,IRIEN,2))
SET PCE=0
+42 FOR BFD=5:1:12,2,1,3,4
SET PCE=PCE+1
SET BFN=BFD/100+61
SET INSPCE=$PIECE(INSDATA,U,PCE)
IF INSPCE'=""
SET ESGHPARR(BFN)=INSPCE
+43 ;
+44 DO FIL
+45 KILL ADD
+46 QUIT
+47 ;
RP(IEN,ADD,BUFF) ; Get data from a specific response record
+1 ;
+2 ; Input Parameter
+3 ; IEN = Internal entry number of the Response
+4 ; ADD = If defined, then it will add a new Buffer entry
+5 ; BUFF = IEN of the Buffer Entry to be updated (optional)
+6 ;
+7 ; Initialize optional parameter
SET BUFF=$GET(BUFF)
+8 ;
+9 NEW BPHONE,COB,DFN,EFFDT,EXPDT,GNAME,GNUMB,IBSOURCE,IDOB,IIEN,INAME,IRIEN,ISEX,ISSN,NAME
+10 NEW PATID,PIEN,PNAME,PPHONE,RDATA,RDATA5,RDATA13,RDATA14,REL,RSTYPE,SUBID,TQIEN,WHO
+11 NEW SUBADDR1,SUBADDR2,SUBCITY,SUBSTATE,SUBZIP,SUBCNTRY,SUBCNDIV
+12 ;
+13 SET DFN=$PIECE(^IBCN(365,IEN,0),U,2)
SET TQIEN=$PIECE(^IBCN(365,IEN,0),U,5)
+14 SET PIEN=$PIECE(^IBCN(365,IEN,0),U,3)
SET RSTYPE=$PIECE(^(0),U,10)
+15 IF PIEN'=""
SET PNAME=$PIECE(^IBE(365.12,PIEN,0),U,1)
+16 ; IB*2.0*621 IBSOURCE
IF TQIEN'=""
SET IRIEN=$PIECE($GET(^IBCN(365.1,TQIEN,0)),U,13)
SET IBSOURCE=$$GET1^DIQ(365.1,TQIEN_",",3.02,"I")
+17 IF $GET(IRIEN)'=""
SET INAME=""
Begin DoDot:1
+18 SET IIEN=$PIECE($GET(^DPT(DFN,.312,IRIEN,0)),U,1)
+19 IF IIEN=""
QUIT
+20 SET INAME=$PIECE(^DIC(36,IIEN,0),U,1)
End DoDot:1
+21 SET RDATA=$GET(^IBCN(365,IEN,1))
SET RDATA5=$GET(^IBCN(365,IEN,5))
+22 SET RDATA13=$GET(^IBCN(365,IEN,13))
SET RDATA14=$GET(^IBCN(365,IEN,14))
+23 SET NAME=$PIECE(RDATA13,U,1)
+24 SET INAME=$SELECT($GET(INAME)'=""&(RSTYPE="O"):INAME,1:$GET(PNAME))
+25 SET IDOB=$PIECE(RDATA,U,2)
+26 SET ISSN=$PIECE(RDATA,U,3)
+27 SET ISEX=$PIECE(RDATA,U,4)
+28 SET COB=$PIECE(RDATA,U,13)
+29 SET SUBID=$PIECE(RDATA13,U,2)
+30 SET PATID=$PIECE(RDATA,U,18)
+31 SET GNAME=$PIECE(RDATA14,U,1)
+32 SET GNUMB=$PIECE(RDATA14,U,2)
+33 SET WHO=$PIECE(RDATA,U,8)
+34 ; IB*2*497 VALUE FROM 365,8.01 needs evaluation and possible conversion
SET REL=$$PREL^IBCNEHLU(355.33,60.14,$$GET1^DIQ(365,IEN,8.01))
+35 SET EFFDT=$PIECE(RDATA,U,11)
+36 SET EXPDT=$PIECE(RDATA,U,12)
+37 SET SUBADDR1=$PIECE(RDATA5,U)
SET SUBADDR2=$PIECE(RDATA5,U,2)
SET SUBCITY=$PIECE(RDATA5,U,3)
+38 SET SUBSTATE=$PIECE(RDATA5,U,4)
SET SUBZIP=$PIECE(RDATA5,U,5)
SET SUBCNTRY=$PIECE(RDATA5,U,6)
+39 SET SUBCNDIV=$PIECE(RDATA5,U,7)
+40 SET PPHONE=""
SET BPHONE=""
+41 ;
+42 DO FIL
+43 KILL DFN,VBUF,IEN,IRIEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
+44 KILL BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
+45 KILL ADD,%DT,D0,DG,DIC,DISYS,DIW,IENS,IBEISTC
+46 QUIT
+47 ;
FIL ; File Buffer Data
+1 ;
+2 SET MSGP=$$MGRP^IBCNEUT5()
+3 ;
+4 ; Variable IDUZ is optionally set by the calling routine. If it is
+5 ; not defined, it will be set to the specific, non-human user.
+6 ;
+7 IF $GET(IDUZ)=""
SET IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
+8 ;
+9 ; Entered By
IF $GET(ADD)
SET VBUF(.02)=IDUZ
+10 ; Buffer Symbol
SET VBUF(.12)=$GET(SYMBOL)
+11 ; Override freshness flag
SET VBUF(.13)=$GET(OVRRIDE)
+12 ; eligibility date, only comes from ^IBCNEQU (real time eIV inquiry)
SET VBUF(.18)=$GET(IBELIGDT)
+13 ; Only file if not an error
IF '$GET(ERACT)
Begin DoDot:1
+14 ; Insurance Company/Payer Name
SET VBUF(20.01)=INAME
+15 ; Patient IEN
SET VBUF(60.01)=DFN
+16 ; Group Number
SET VBUF(90.02)=GNUMB
+17 ; Group Name
SET VBUF(90.01)=GNAME
+18 ; Name of Insured
SET VBUF(91.01)=NAME
+19 ; Subscriber ID
SET VBUF(90.03)=SUBID
+20 ; Patient/Member ID
SET VBUF(62.01)=PATID
+21 ; Precertification Phone
SET VBUF(20.04)=PPHONE
+22 ; Billing Phone
SET VBUF(20.03)=BPHONE
+23 ; Effective Date
SET VBUF(60.02)=EFFDT
+24 ; Expiration Date
SET VBUF(60.03)=EXPDT
+25 ; Whose Insurance
SET VBUF(60.05)=WHO
+26 ; Patient Relationship
SET VBUF(60.14)=REL
+27 ; Insured's DOB
SET VBUF(60.08)=IDOB
+28 ; Insured's SSN
SET VBUF(60.09)=ISSN
+29 ; Coordination of Benefits
SET VBUF(60.12)=COB
+30 ; Insured's Sex
SET VBUF(60.13)=ISEX
+31 ; Subscriber address line 1
SET VBUF(62.02)=SUBADDR1
+32 ; Subscriber address line 2
SET VBUF(62.03)=SUBADDR2
+33 ; Subscriber address city
SET VBUF(62.04)=SUBCITY
+34 ; Subscriber address state
SET VBUF(62.05)=SUBSTATE
+35 ; Subscriber address zip code
SET VBUF(62.06)=SUBZIP
+36 ; Subscriber address country code
SET VBUF(62.07)=SUBCNTRY
+37 ; Subscriber address country subdivision code
SET VBUF(62.08)=SUBCNDIV
+38 ;
+39 ; Define Service Type Code (STC) to be sent with Insurance Inquiry
+40 ; IBEISTC contains the STC defined by User using option EI, otherwise default is sent
+41 IF +$GET(IBEISTC)
SET VBUF(80.01)=IBEISTC
+42 KILL IBEISTC
+43 ;
+44 ; If the employer sponsored insurance array exists, then merge it in
+45 IF $DATA(ESGHPARR)
MERGE VBUF=ESGHPARR
End DoDot:1
+46 ;
+47 ; Do not overwrite the existing insurance co. name if it already exists
+48 IF $GET(ADD)=""
IF $GET(BUFF)'=""
KILL VBUF(20.01)
+49 ;
+50 ; ** initialize IBERROR
+51 SET IBERROR=""
+52 ;
+53 ; If need to add a new Buffer entry ...
+54 ;
+55 ; Variable IBFDA is returned to the calling routine as the IEN of
+56 ; the buffer entry that was just added.
+57 ;
+58 IF $GET(ADD)
Begin DoDot:1
+59 ; IB*2.0*621 Added IBSOURCE to replace hard coded eIV
SET IBSOURCE=$GET(IBSOURCE,5)
+60 ;IB*743/CKB - calling $$ADDSTF below in order to Lock/Unlock buffer entry
+61 SET IBFDA=$$ADDSTF(IBSOURCE,DFN,.VBUF)
+62 ; Error Message is 2nd piece of result
+63 SET IBERROR=$PIECE(IBFDA,U,2)
+64 SET IBFDA=$PIECE(IBFDA,U,1)
End DoDot:1
+65 ;
+66 ; If an error, send an email message
+67 IF IBERROR'=""
Begin DoDot:1
+68 SET MSG(1)="Error returned by $$ADDSTF^IBCNBES:"
+69 SET MSG(2)=IBERROR
+70 SET MSG(3)="Values:"
+71 SET MSG(4)=" Patient DFN = "_$GET(DFN)
+72 SET MSG(5)=" Pt Ins Record IEN = "_$GET(IRIEN)
+73 SET MSG(6)="Please log a Remedy Ticket for this problem."
+74 SET XMSUB="Error creating Buffer Entry."
+75 DO MSG^IBCNEUT5(MSGP,XMSUB,"MSG(")
+76 KILL MSGP,MSG,XMSUB,IBERR
End DoDot:1
QUIT
+77 ;
+78 ; If need to update a new Buffer Entry ...
+79 ;
+80 ; Variable BUFF is passed into this routine whenever the buffer
+81 ; entry is known and the ADD flag is off. The existing buffer entry
+82 ; is edited in this case.
+83 ;
+84 IF $GET(ADD)=""
DO EDITSTF^IBCNBES(BUFF,.VBUF)
+85 ;
+86 ; If an error occurred in EDITSTF, the error array is not returned
+87 ;
+88 QUIT
+89 ;
+90 ;IB*743/CKB - the code below was copied from ADDSTF^IBCNBES to address the locking of the
+91 ; buffer without impacting other existing software
ADDSTF(IBSOURCE,DFN,IBDATA) ; add new entry to Insurance Buffer file (355.33) and stuff the data passed in, no user interaction
+1 ; IBSOURCE = source of information (required)
+2 ; 1 = interview 2 = data match
+3 ; 3 = ivm 4 = pre-registration
+4 ; 5 = eIV etc., refer to file #365.12 for full list of sources
+5 ; DFN = patient's ifn in file 2 (required)
+6 ; IBDATA = data to file in Buffer in an array subscripted by field number of the data field in 355.33
+7 ; ex: IBDATA(20.01)="Insurance Company Name", etc,
+8 ; returns ien of new entry or 0 followed by error if entry not added
+9 ;
+10 ; example of call: $$ADDBUF^IBCNBES(2,DFN,.IBDATA) where IBDATA(field #) = value
+11 ;
+12 NEW X,Y,BUFLOCK,IBBUFDA,IBERROR
+13 ;
+14 ; verify source of information and data exists to store
+15 IF $GET(IBSOURCE)=""
SET IBERROR="SOURCE OF INFORMATION INCORRECT"
GOTO EXIT
+16 IF $GET(^DPT(+$GET(DFN),0))=""
SET IBERROR="NO PATIENT DEFINED"
GOTO EXIT
+17 IF $DATA(IBDATA)<10
SET IBERROR="NO DATA TO STORE"
GOTO EXIT
+18 ;
+19 ; add new entry to Buffer file (355.33)
+20 SET IBBUFDA=+$$ADD^IBCNBEE(IBSOURCE)
IF 'IBBUFDA
SET IBERROR="COULD NOT CREATE A NEW BUFFER ENTRY"
GOTO EXIT
+21 ;
+22 ; Lock the buffer entry
+23 SET BUFLOCK=$$BUFLOCK^IBCNEHL6(IBBUFDA,1)
+24 ;
+25 SET IBDATA(60.01)=+DFN
+26 ;
+27 ; Set up DUZ (interface user) so 60.01 field check can find 'valid reason' for sensitive
+28 ; patients and not set 60.01 to '0' with an error in tag FLDCHK
+29 IF '$GET(DUZ)
DO DUZ^XUP(.5)
+30 ;
+31 DO EDITSTF^IBCNBES(+IBBUFDA,.IBDATA)
+32 ;
+33 ; Unlock buffer entry
+34 IF BUFLOCK
IF $$BUFLOCK^IBCNEHL6(IBBUFDA,0)
+35 ;
+36 ; delete leftover ESGHP data if ESGHP? is not Yes
+37 IF +$GET(IBBUFDA)
IF $DATA(^IBA(355.33,$GET(IBBUFDA),61))
IF '$GET(^IBA(355.33,$GET(IBBUFDA),61))
DO DELEMP^IBCNBEE($GET(IBBUFDA))
+38 ;
EXIT QUIT +$GET(IBBUFDA)_"^"_$GET(IBERROR)
