- PRCABIL4 ;WIRMFO/RWT-DELETE BILL LEAVING AUDIT TRAIL
- V ;;4.5;Accounts Receivable;**67**;March 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- DELETE ;Deletes a Bill leaving an audit trail
- ;REQUIRES PRCABN=Bill IEN to delete
- ; PRCACOMM=Reason why this bill is being deleted
- N PRCACAT,PRCASTAT,PRCAID,B0,DIK,DIE,DA,DR
- I '$D(^PRCA(430,PRCABN,0)) Q
- S B0=$G(^PRCA(430,PRCABN,0))
- S PRCAID=$P(B0,U,1),PRCACAT=$P(B0,U,2),PRCASTAT=$P(B0,U,8)
- S DIK="^PRCA(430,",DA=PRCABN D ^DIK K DIK
- ;
- ; Now Add it back in w/ audit trails
- S X=PRCAID,DINUM=PRCABN,DIC="^PRCA(430,",DIC(0)="L",DLAYGO=430
- K DD,DO D FILE^DICN K DIC,DLAYGO,DO
- ;
- ; Ensure that the last entry number counter is correct
- S $P(^PRCA(430,0),U,3)=$O(^PRCA(430,"A"),-1)
- ;
- S DIE="^PRCA(430,",DR="[PRCA CREATE BILL STUB]",DA=PRCABN D ^DIE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCABIL4 860 printed Feb 18, 2025@23:05:26 Page 2
- PRCABIL4 ;WIRMFO/RWT-DELETE BILL LEAVING AUDIT TRAIL
- V ;;4.5;Accounts Receivable;**67**;March 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- DELETE ;Deletes a Bill leaving an audit trail
- +1 ;REQUIRES PRCABN=Bill IEN to delete
- +2 ; PRCACOMM=Reason why this bill is being deleted
- +3 NEW PRCACAT,PRCASTAT,PRCAID,B0,DIK,DIE,DA,DR
- +4 IF '$DATA(^PRCA(430,PRCABN,0))
- QUIT
- +5 SET B0=$GET(^PRCA(430,PRCABN,0))
- +6 SET PRCAID=$PIECE(B0,U,1)
- SET PRCACAT=$PIECE(B0,U,2)
- SET PRCASTAT=$PIECE(B0,U,8)
- +7 SET DIK="^PRCA(430,"
- SET DA=PRCABN
- DO ^DIK
- KILL DIK
- +8 ;
- +9 ; Now Add it back in w/ audit trails
- +10 SET X=PRCAID
- SET DINUM=PRCABN
- SET DIC="^PRCA(430,"
- SET DIC(0)="L"
- SET DLAYGO=430
- +11 KILL DD,DO
- DO FILE^DICN
- KILL DIC,DLAYGO,DO
- +12 ;
- +13 ; Ensure that the last entry number counter is correct
- +14 SET $PIECE(^PRCA(430,0),U,3)=$ORDER(^PRCA(430,"A"),-1)
- +15 ;
- +16 SET DIE="^PRCA(430,"
- SET DR="[PRCA CREATE BILL STUB]"
- SET DA=PRCABN
- DO ^DIE
- +17 QUIT