- 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 Feb 18, 2025@23:40:47 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)