| 1 | IBCNBED ;ALB/ARH-Ins Buffer: delete existing entries in buffer ;1 Jun 97
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**82**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | DELDATA(IBBUFDA) ; delete all insurance/group/policy data from buffer file entry, leaving stub entry
|
|---|
| 6 | ; deletes all data with field numbers 1 or greater and blank nodes
|
|---|
| 7 | ;
|
|---|
| 8 | Q:'$G(^IBA(355.33,+$G(IBBUFDA),0))
|
|---|
| 9 | N DR,DA,DIE,DIC,X,Y,IBFLDS,IBIFN,IBFLD,IBCNT,IBI,IBX S IBIFN=IBBUFDA_",",DR="",IBCNT=1
|
|---|
| 10 | ;
|
|---|
| 11 | D GETS^DIQ(355.33,IBIFN,"1:999","IN","IBFLDS") ; returns all non-blank fields
|
|---|
| 12 | ;
|
|---|
| 13 | S IBFLD=0 F S IBFLD=$O(IBFLDS(355.33,IBIFN,IBFLD)) Q:'IBFLD D ; set up DR string
|
|---|
| 14 | . I $L(DR)>200 S DR(1,355.33,IBCNT)=DR,DR="",IBCNT=IBCNT+1
|
|---|
| 15 | . S DR=DR_IBFLD_"///@;"
|
|---|
| 16 | ;
|
|---|
| 17 | I DR'="" D ; delete data then nodes
|
|---|
| 18 | . S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DA,DIC,DIE,DR
|
|---|
| 19 | . ;
|
|---|
| 20 | . ; if Status is Entered, change it to Rejected, there should be no entry with a status of Entered without data
|
|---|
| 21 | . I $P(^IBA(355.33,IBBUFDA,0),U,4)="E" D STATUS^IBCNBEE(IBBUFDA,"R")
|
|---|
| 22 | ;
|
|---|
| 23 | ; kill blank nodes since DIE doesn't
|
|---|
| 24 | S IBI=0 F S IBI=$O(^IBA(355.33,IBBUFDA,IBI)) Q:'IBI S IBX=$G(^IBA(355.33,IBBUFDA,IBI)) I IBX?."^" K ^IBA(355.33,IBBUFDA,IBI)
|
|---|
| 25 | Q
|
|---|
