| [613] | 1 | IBCNBES ;ALB/ARH-Ins Buffer: stuff new entries/data into buffer ;1 Jun 97
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**82,184,345**;21-MAR-94;Build 28
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | ADDSTF(IBSOURCE,DFN,IBDATA) ; add new entry to Insurance Buffer file (355.33) and stuff the data passed in, no user interaction
|
|---|
| 7 | ; IBSOURCE = source of information (required)
|
|---|
| 8 | ; 1 = interview 2 = data match
|
|---|
| 9 | ; 3 = ivm 4 = pre-registration
|
|---|
| 10 | ; 5 = eIV
|
|---|
| 11 | ; DFN = patient's ifn in file 2 (required)
|
|---|
| 12 | ; IBDATA = data to file in Buffer in an array subscripted by field number of the data field in 355.33
|
|---|
| 13 | ; ex: IBDATA(20.01)="Insurance Company Name", etc,
|
|---|
| 14 | ; returns ien of new entry or 0 followed by error if entry not added
|
|---|
| 15 | ;
|
|---|
| 16 | ; example of call: $$ADDBUF^IBCNBES(2,DFN,.IBDATA) where IBDATA(field #) = value
|
|---|
| 17 | ;
|
|---|
| 18 | N X,Y,IBBUFDA,IBERROR
|
|---|
| 19 | ;
|
|---|
| 20 | ; verify source of information and data exists to store
|
|---|
| 21 | I $G(IBSOURCE)="" S IBERROR="SOURCE OF INFORMATION INCORRECT" G EXIT
|
|---|
| 22 | I $G(^DPT(+$G(DFN),0))="" S IBERROR="NO PATIENT DEFINED" G EXIT
|
|---|
| 23 | I $D(IBDATA)<10 S IBERROR="NO DATA TO STORE" G EXIT
|
|---|
| 24 | ;
|
|---|
| 25 | ; add new entry to Buffer file (355.33)
|
|---|
| 26 | S IBBUFDA=+$$ADD^IBCNBEE(IBSOURCE) I 'IBBUFDA S IBERROR="COULD NOT CREATE A NEW BUFFER ENTRY" G EXIT
|
|---|
| 27 | ;
|
|---|
| 28 | S IBDATA(60.01)=+DFN
|
|---|
| 29 | ;
|
|---|
| 30 | ; Set up DUZ (interface user) so 60.01 field check can find 'valid reason' for sensitive
|
|---|
| 31 | ; patients and not set 60.01 to '0' with an error in tag FLDCHK
|
|---|
| 32 | I '$G(DUZ) D DUZ^XUP(.5)
|
|---|
| 33 | ;
|
|---|
| 34 | D EDITSTF(+IBBUFDA,.IBDATA)
|
|---|
| 35 | ;
|
|---|
| 36 | ; delete leftover ESGHP data if ESGHP? is not Yes
|
|---|
| 37 | I +$G(IBBUFDA),$D(^IBA(355.33,$G(IBBUFDA),61)),'$G(^IBA(355.33,$G(IBBUFDA),61)) D DELEMP^IBCNBEE($G(IBBUFDA))
|
|---|
| 38 | ;
|
|---|
| 39 | EXIT Q +$G(IBBUFDA)_"^"_$G(IBERROR)
|
|---|
| 40 | ;
|
|---|
| 41 | EDITSTF(IBBUFDA,IBDATA) ; loop though data array and stuff each buffer field, no user interaction
|
|---|
| 42 | ;
|
|---|
| 43 | N IBFIELD,IBVALUE,IBARR,IBERR Q:'$G(^IBA(355.33,$G(IBBUFDA),0))
|
|---|
| 44 | ;
|
|---|
| 45 | S IBFIELD=0 F S IBFIELD=$O(IBDATA(IBFIELD)) Q:'IBFIELD D
|
|---|
| 46 | . S IBVALUE=$$FLDCHK(355.33,IBFIELD,IBDATA(IBFIELD)) Q:'IBVALUE
|
|---|
| 47 | . S IBARR(355.33,IBBUFDA_",",IBFIELD)=$P(IBVALUE,U,2)
|
|---|
| 48 | I $D(IBARR)>9 D FILE^DIE("E","IBARR","IBERR")
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | FLDCHK(FILE,FIELD,VALUE) ; minor checks on data: truncate if length too long, if pointer add ' so can be processed as external format
|
|---|
| 52 | N IBATTR,IBERR,IBX S IBX="1^"_VALUE
|
|---|
| 53 | I VALUE="" S IBX="0^No data value." G FLDCHKQ
|
|---|
| 54 | D FIELD^DID(FILE,FIELD,"N","FIELD LENGTH;SPECIFIER","IBATTR","IBERR")
|
|---|
| 55 | I $D(IBERR) S IBX="0^"_$G(IBERR("DIERR",1,"TEXT",1)) G FLDCHKQ
|
|---|
| 56 | I $G(IBATTR("SPECIFIER"))["P" S IBX="1^`"_VALUE G FLDCHKQ
|
|---|
| 57 | I $D(IBATTR("FIELD LENGTH")) S IBX="1^"_$E(VALUE,1,+IBATTR("FIELD LENGTH"))
|
|---|
| 58 | FLDCHKQ Q IBX
|
|---|
