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

Last change on this file since 1581 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1IBCNBED ;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 ;
5DELDATA(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
Note: See TracBrowser for help on using the repository browser.