PRCAI158.m

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 ---PRCAI158   765     printed  Apr 23, 2025@17:54:25                                                                                                                                                                                                     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