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

IBCNBES.m

Go to the documentation of this file. 
  1. IBCNBES ;ALB/ARH-Ins Buffer: stuff new entries/data into buffer ;1 Jun 97
  1.  ;;2.0;INTEGRATED BILLING;**82,184,345,438,497,743**;21-MAR-94;Build 18
  1.  ;;Per VHA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;
  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  ;IB*743/CKB
  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,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.  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(+IBBUFDA,.IBDATA)
  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)
  1.  ;
  1. EDITSTF(IBBUFDA,IBDATA) ;  loop though data array and stuff each buffer field, no user interaction
  1.  ;
  1.  N IBFIELD,IBVALUE,IBARR,IBERR Q:'$G(^IBA(355.33,$G(IBBUFDA),0))
  1.  ;
  1.  S IBFIELD=0 F  S IBFIELD=$O(IBDATA(IBFIELD)) Q:'IBFIELD  D
  1.  . ; ** have to file subscriber id last in order for real-time verification inquiry triggers to work properly **
  1.  . I IBFIELD=90.03!(IBFIELD=60.04) Q
  1.  . S IBVALUE=$$FLDCHK(355.33,IBFIELD,IBDATA(IBFIELD)) Q:'IBVALUE
  1.  . S IBARR(355.33,IBBUFDA_",",IBFIELD)=$P(IBVALUE,U,2)
  1.  I $D(IBARR)>9 D FILE^DIE("E","IBARR","IBERR")
  1.  ; file subscriber id
  1.  ; needs to work with new and old subscriber id field until transition to the new field is complete. 
  1.  I $G(IBDATA(90.03))'=""!($G(IBDATA(60.04))'="") D
  1.  .N IBSUBIDF
  1.  .S IBSUBIDF=$S($G(IBDATA(90.03))'="":90.03,1:60.04)
  1.  .S IBVALUE=$$FLDCHK(355.33,IBSUBIDF,IBDATA(IBSUBIDF)) Q:'IBVALUE
  1.  .K IBARR S IBARR(355.33,IBBUFDA_",",IBSUBIDF)=$P(IBVALUE,U,2)
  1.  .D FILE^DIE("E","IBARR","IBERR")
  1.  .Q
  1.  Q
  1.  ;
  1. FLDCHK(FILE,FIELD,VALUE) ; minor checks on data: truncate if length too long, if pointer add ' so can be processed as external format
  1.  N IBATTR,IBERR,IBX S IBX="1^"_VALUE
  1.  I VALUE="" S IBX="0^No data value." G FLDCHKQ
  1.  D FIELD^DID(FILE,FIELD,"N","FIELD LENGTH;SPECIFIER","IBATTR","IBERR")
  1.  I $D(IBERR) S IBX="0^"_$G(IBERR("DIERR",1,"TEXT",1)) G FLDCHKQ
  1.  I $G(IBATTR("SPECIFIER"))["P" S IBX="1^`"_VALUE G FLDCHKQ
  1.  I $D(IBATTR("FIELD LENGTH")) S IBX="1^"_$E(VALUE,1,+IBATTR("FIELD LENGTH"))
  1. FLDCHKQ Q IBX