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

IBCNEBF ;DAOU/ALA - Create an Entry in the Buffer File ;20-JUN-2002
 ;;2.0;INTEGRATED BILLING;**184,271,361**;21-MAR-94;Build 9
 ;;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
 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 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 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
 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(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 NOIS 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