Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEBF

IBCNEBF.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. ;**Program Description**
  1. ; This program will create a Buffer entry based upon input values
  1. ;
  1. Q
  1. ;
  1. PT(DFN,IRIEN,SYMBOL,OVRRIDE,ADD,IBERROR) ; Get data
  1. ; from a specific patient and insurance record entry
  1. ;
  1. ; Input Parameters
  1. ; DFN = Patient IEN
  1. ; IRIEN = Patient Insurance Record IEN
  1. ; SYMBOL = eIV Symbol IEN
  1. ; OVRRIDE = Override flag for ins. buffer record (0 or 1)
  1. ; ADD = If defined, then it will add a new Buffer entry
  1. ; IBERROR = If defined, then it will be updated with error info.
  1. ; OPTIONALLY PASSED BY REFERENCE
  1. ;
  1. I DFN=""!(IRIEN="") Q ; * do not require SYMBOL or OVRRIDE
  1. ;
  1. ;
  1. N VBUF,IDATA0,IDATA3,IDATA7,IEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
  1. N BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
  1. N MSG,XMSUB,MSGP,INSDATA,PCE,BFD,BFN,INSPCE,ESGHPARR
  1. N SUBADDR1,SUBADDR2,SUBCITY,SUBSTATE,SUBZIP,SUBCNTRY,SUBCNDIV
  1. ;
  1. S IDATA0=$G(^DPT(DFN,.312,IRIEN,0)),IDATA3=$G(^DPT(DFN,.312,IRIEN,3))
  1. S IDATA7=$G(^DPT(DFN,.312,IRIEN,7))
  1. S IIEN=$P(IDATA0,U,1),INAME=$$GET1^DIQ(36,IIEN,.01,"E")
  1. S PPHONE=$P($G(^DIC(36,IIEN,.13)),U,3),BPHONE=$P($G(^DIC(36,IIEN,.13)),U,2)
  1. S NAME=$P(IDATA7,U,1),SUBID=$P(IDATA7,U,2)
  1. S PATID=$P($G(^DPT(DFN,.312,IRIEN,5)),U,1)
  1. S WHO=$P(IDATA0,U,6),COB=$P(IDATA0,U,20)
  1. S IDOB=$P(IDATA3,U,1),ISSN=$P(IDATA3,U,5),ISEX=$P(IDATA3,U,12)
  1. S EFFDT=$P(IDATA0,U,8),EXPDT=$P(IDATA0,U,4)
  1. S REL=$P($G(^DPT(DFN,.312,IRIEN,4)),U,3)
  1. S SUBADDR1=$P(IDATA3,U,6),SUBADDR2=$P(IDATA3,U,7)
  1. S SUBCITY=$P(IDATA3,U,8),SUBSTATE=$P(IDATA3,U,9),SUBZIP=$P(IDATA3,U,10)
  1. S SUBCNTRY=$P(IDATA3,U,13),SUBCNDIV=$P(IDATA3,U,14)
  1. ;
  1. S IENS=IRIEN_","_DFN_","
  1. S GNUMB=$$GET1^DIQ(2.312,IENS,21,"E")
  1. S GNAME=$$GET1^DIQ(2.312,IENS,20,"E")
  1. ;
  1. ; Capture the employer sponsored insurance fields into array
  1. ; ESGHPARR(buffer field number) = data
  1. ;
  1. S INSDATA=$G(^DPT(DFN,.312,IRIEN,2)),PCE=0
  1. 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
  1. ;
  1. D FIL
  1. K ADD
  1. Q
  1. ;
  1. RP(IEN,ADD,BUFF) ; Get data from a specific response record
  1. ;
  1. ; Input Parameter
  1. ; IEN = Internal entry number of the Response
  1. ; ADD = If defined, then it will add a new Buffer entry
  1. ; BUFF = IEN of the Buffer Entry to be updated (optional)
  1. ;
  1. S BUFF=$G(BUFF) ; Initialize optional parameter
  1. ;
  1. N BPHONE,COB,DFN,EFFDT,EXPDT,GNAME,GNUMB,IBSOURCE,IDOB,IIEN,INAME,IRIEN,ISEX,ISSN,NAME
  1. N PATID,PIEN,PNAME,PPHONE,RDATA,RDATA5,RDATA13,RDATA14,REL,RSTYPE,SUBID,TQIEN,WHO
  1. N SUBADDR1,SUBADDR2,SUBCITY,SUBSTATE,SUBZIP,SUBCNTRY,SUBCNDIV
  1. ;
  1. S DFN=$P(^IBCN(365,IEN,0),U,2),TQIEN=$P(^IBCN(365,IEN,0),U,5)
  1. S PIEN=$P(^IBCN(365,IEN,0),U,3),RSTYPE=$P(^(0),U,10)
  1. I PIEN'="" S PNAME=$P(^IBE(365.12,PIEN,0),U,1)
  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
  1. I $G(IRIEN)'="" S INAME="" D
  1. . S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1)
  1. . I IIEN="" Q
  1. . S INAME=$P(^DIC(36,IIEN,0),U,1)
  1. S RDATA=$G(^IBCN(365,IEN,1)),RDATA5=$G(^IBCN(365,IEN,5))
  1. S RDATA13=$G(^IBCN(365,IEN,13)),RDATA14=$G(^IBCN(365,IEN,14))
  1. S NAME=$P(RDATA13,U,1)
  1. S INAME=$S($G(INAME)'=""&(RSTYPE="O"):INAME,1:$G(PNAME))
  1. S IDOB=$P(RDATA,U,2)
  1. S ISSN=$P(RDATA,U,3)
  1. S ISEX=$P(RDATA,U,4)
  1. S COB=$P(RDATA,U,13)
  1. S SUBID=$P(RDATA13,U,2)
  1. S PATID=$P(RDATA,U,18)
  1. S GNAME=$P(RDATA14,U,1)
  1. S GNUMB=$P(RDATA14,U,2)
  1. S WHO=$P(RDATA,U,8)
  1. 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
  1. S EFFDT=$P(RDATA,U,11)
  1. S EXPDT=$P(RDATA,U,12)
  1. S SUBADDR1=$P(RDATA5,U),SUBADDR2=$P(RDATA5,U,2),SUBCITY=$P(RDATA5,U,3)
  1. S SUBSTATE=$P(RDATA5,U,4),SUBZIP=$P(RDATA5,U,5),SUBCNTRY=$P(RDATA5,U,6)
  1. S SUBCNDIV=$P(RDATA5,U,7)
  1. S PPHONE="",BPHONE=""
  1. ;
  1. D FIL
  1. K DFN,VBUF,IEN,IRIEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
  1. K BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
  1. K ADD,%DT,D0,DG,DIC,DISYS,DIW,IENS,IBEISTC
  1. Q
  1. ;
  1. FIL ; File Buffer Data
  1. ;
  1. S MSGP=$$MGRP^IBCNEUT5()
  1. ;
  1. ; Variable IDUZ is optionally set by the calling routine. If it is
  1. ; not defined, it will be set to the specific, non-human user.
  1. ;
  1. I $G(IDUZ)="" S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
  1. ;
  1. I $G(ADD) S VBUF(.02)=IDUZ ; Entered By
  1. S VBUF(.12)=$G(SYMBOL) ; Buffer Symbol
  1. S VBUF(.13)=$G(OVRRIDE) ; Override freshness flag
  1. S VBUF(.18)=$G(IBELIGDT) ; eligibility date, only comes from ^IBCNEQU (real time eIV inquiry)
  1. I '$G(ERACT) D ; Only file if not an error
  1. . S VBUF(20.01)=INAME ; Insurance Company/Payer Name
  1. . S VBUF(60.01)=DFN ; Patient IEN
  1. . S VBUF(90.02)=GNUMB ; Group Number
  1. . S VBUF(90.01)=GNAME ; Group Name
  1. . S VBUF(91.01)=NAME ; Name of Insured
  1. . S VBUF(90.03)=SUBID ; Subscriber ID
  1. . S VBUF(62.01)=PATID ; Patient/Member ID
  1. . S VBUF(20.04)=PPHONE ; Precertification Phone
  1. . S VBUF(20.03)=BPHONE ; Billing Phone
  1. . S VBUF(60.02)=EFFDT ; Effective Date
  1. . S VBUF(60.03)=EXPDT ; Expiration Date
  1. . S VBUF(60.05)=WHO ; Whose Insurance
  1. . S VBUF(60.14)=REL ; Patient Relationship
  1. . S VBUF(60.08)=IDOB ; Insured's DOB
  1. . S VBUF(60.09)=ISSN ; Insured's SSN
  1. . S VBUF(60.12)=COB ; Coordination of Benefits
  1. . S VBUF(60.13)=ISEX ; Insured's Sex
  1. . S VBUF(62.02)=SUBADDR1 ; Subscriber address line 1
  1. . S VBUF(62.03)=SUBADDR2 ; Subscriber address line 2
  1. . S VBUF(62.04)=SUBCITY ; Subscriber address city
  1. . S VBUF(62.05)=SUBSTATE ; Subscriber address state
  1. . S VBUF(62.06)=SUBZIP ; Subscriber address zip code
  1. . S VBUF(62.07)=SUBCNTRY ; Subscriber address country code
  1. . S VBUF(62.08)=SUBCNDIV ; Subscriber address country subdivision code
  1. . ;
  1. . ; Define Service Type Code (STC) to be sent with Insurance Inquiry
  1. . ; IBEISTC contains the STC defined by User using option EI, otherwise default is sent
  1. . I +$G(IBEISTC) S VBUF(80.01)=IBEISTC
  1. . K IBEISTC
  1. . ;
  1. . ; If the employer sponsored insurance array exists, then merge it in
  1. . I $D(ESGHPARR) M VBUF=ESGHPARR
  1. ;
  1. ; Do not overwrite the existing insurance co. name if it already exists
  1. I $G(ADD)="",$G(BUFF)'="" K VBUF(20.01)
  1. ;
  1. ; ** initialize IBERROR
  1. S IBERROR=""
  1. ;
  1. ; If need to add a new Buffer entry ...
  1. ;
  1. ; Variable IBFDA is returned to the calling routine as the IEN of
  1. ; the buffer entry that was just added.
  1. ;
  1. I $G(ADD) D
  1. . S IBSOURCE=$G(IBSOURCE,5) ; IB*2.0*621 Added IBSOURCE to replace hard coded eIV
  1. . ;IB*743/CKB - calling $$ADDSTF below in order to Lock/Unlock buffer entry
  1. . S IBFDA=$$ADDSTF(IBSOURCE,DFN,.VBUF)
  1. . ; Error Message is 2nd piece of result
  1. . S IBERROR=$P(IBFDA,U,2)
  1. . S IBFDA=$P(IBFDA,U,1)
  1. ;
  1. ; If an error, send an email message
  1. I IBERROR'="" D Q
  1. . S MSG(1)="Error returned by $$ADDSTF^IBCNBES:"
  1. . S MSG(2)=IBERROR
  1. . S MSG(3)="Values:"
  1. . S MSG(4)=" Patient DFN = "_$G(DFN)
  1. . S MSG(5)=" Pt Ins Record IEN = "_$G(IRIEN)
  1. . S MSG(6)="Please log a Remedy Ticket for this problem."
  1. . S XMSUB="Error creating Buffer Entry."
  1. . D MSG^IBCNEUT5(MSGP,XMSUB,"MSG(")
  1. . K MSGP,MSG,XMSUB,IBERR
  1. ;
  1. ; If need to update a new Buffer Entry ...
  1. ;
  1. ; Variable BUFF is passed into this routine whenever the buffer
  1. ; entry is known and the ADD flag is off. The existing buffer entry
  1. ; is edited in this case.
  1. ;
  1. I $G(ADD)="" D EDITSTF^IBCNBES(BUFF,.VBUF)
  1. ;
  1. ; If an error occurred in EDITSTF, the error array is not returned
  1. ;
  1. Q
  1. ;
  1. ;IB*743/CKB - the code below was copied from ADDSTF^IBCNBES to address the locking of the
  1. ; buffer without impacting other existing software
  1. 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)
  1. ; 1 = interview 2 = data match
  1. ; 3 = ivm 4 = pre-registration
  1. ; 5 = eIV etc., refer to file #365.12 for full list of sources
  1. ; DFN = patient's ifn in file 2 (required)
  1. ; IBDATA = data to file in Buffer in an array subscripted by field number of the data field in 355.33
  1. ; ex: IBDATA(20.01)="Insurance Company Name", etc,
  1. ; returns ien of new entry or 0 followed by error if entry not added
  1. ;
  1. ; example of call: $$ADDBUF^IBCNBES(2,DFN,.IBDATA) where IBDATA(field #) = value
  1. ;
  1. N X,Y,BUFLOCK,IBBUFDA,IBERROR
  1. ;
  1. ; verify source of information and data exists to store
  1. I $G(IBSOURCE)="" S IBERROR="SOURCE OF INFORMATION INCORRECT" G EXIT
  1. I $G(^DPT(+$G(DFN),0))="" S IBERROR="NO PATIENT DEFINED" G EXIT
  1. I $D(IBDATA)<10 S IBERROR="NO DATA TO STORE" G EXIT
  1. ;
  1. ; add new entry to Buffer file (355.33)
  1. S IBBUFDA=+$$ADD^IBCNBEE(IBSOURCE) I 'IBBUFDA S IBERROR="COULD NOT CREATE A NEW BUFFER ENTRY" G EXIT
  1. ;
  1. ; Lock the buffer entry
  1. S BUFLOCK=$$BUFLOCK^IBCNEHL6(IBBUFDA,1)
  1. ;
  1. S IBDATA(60.01)=+DFN
  1. ;
  1. ; Set up DUZ (interface user) so 60.01 field check can find 'valid reason' for sensitive
  1. ; patients and not set 60.01 to '0' with an error in tag FLDCHK
  1. I '$G(DUZ) D DUZ^XUP(.5)
  1. ;
  1. D EDITSTF^IBCNBES(+IBBUFDA,.IBDATA)
  1. ;
  1. ; Unlock buffer entry
  1. I BUFLOCK,$$BUFLOCK^IBCNEHL6(IBBUFDA,0)
  1. ;
  1. ; delete leftover ESGHP data if ESGHP? is not Yes
  1. I +$G(IBBUFDA),$D(^IBA(355.33,$G(IBBUFDA),61)),'$G(^IBA(355.33,$G(IBBUFDA),61)) D DELEMP^IBCNBEE($G(IBBUFDA))
  1. ;
  1. EXIT Q +$G(IBBUFDA)_"^"_$G(IBERROR)