PRCAI158 ;ALB/MFR-PATCH PRCA*4.5*158 POST INIT ; 06/27/00
;;4.5;Accounts Receivable;**158**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
D DATADEL
Q
;
DATADEL ; Delete the "-1" Bills from the Accounts Receivable file (430)
;
N DA,DIK,RCIDX,RCXRF,RCCNT
;
D BMES^XPDUTL(" >> Removing inconsistent entries from file 430...")
;
S (DA,RCCNT)="",DIK="^PRCA(430,"
F RCIDX="B","D" D
. S RCXRF=$S(RCIDX="B":"-1^",1:"1^")
. F S RCXRF=$O(^PRCA(430,RCIDX,RCXRF)) Q:RCXRF=""!(RCXRF'["^") D
. . F S DA=$O(^PRCA(430,RCIDX,RCXRF,DA)) Q:DA="" D
. . . I $D(^PRCA(430,DA,0)) D ^DIK S RCCNT=RCCNT+1
. . . K ^PRCA(430,RCIDX,RCXRF,DA)
;
D BMES^XPDUTL(" >> Total of "_+RCCNT_" bills removed.")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAI158 765 printed Nov 22, 2024@16:50:11 Page 2
PRCAI158 ;ALB/MFR-PATCH PRCA*4.5*158 POST INIT ; 06/27/00
+1 ;;4.5;Accounts Receivable;**158**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 DO DATADEL
+5 QUIT
+6 ;
DATADEL ; Delete the "-1" Bills from the Accounts Receivable file (430)
+1 ;
+2 NEW DA,DIK,RCIDX,RCXRF,RCCNT
+3 ;
+4 DO BMES^XPDUTL(" >> Removing inconsistent entries from file 430...")
+5 ;
+6 SET (DA,RCCNT)=""
SET DIK="^PRCA(430,"
+7 FOR RCIDX="B","D"
Begin DoDot:1
+8 SET RCXRF=$SELECT(RCIDX="B":"-1^",1:"1^")
+9 FOR
SET RCXRF=$ORDER(^PRCA(430,RCIDX,RCXRF))
if RCXRF=""!(RCXRF'["^")
QUIT
Begin DoDot:2
+10 FOR
SET DA=$ORDER(^PRCA(430,RCIDX,RCXRF,DA))
if DA=""
QUIT
Begin DoDot:3
+11 IF $DATA(^PRCA(430,DA,0))
DO ^DIK
SET RCCNT=RCCNT+1
+12 KILL ^PRCA(430,RCIDX,RCXRF,DA)
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 DO BMES^XPDUTL(" >> Total of "_+RCCNT_" bills removed.")
+15 ;
+16 QUIT
