| [613] | 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 | 
|---|