Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBDXREF

RCBDXREF.m

Go to the documentation of this file.
  1. RCBDXREF ;WISC/RFJ-fix cross references ;1 Jan 01
  1. ;;4.5;Accounts Receivable;**165**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. FIXATD ; fix atd x-ref
  1. ;
  1. N DATE,DEBT,RCBILLDA,RCDATE,RCDEBTDA
  1. ;
  1. ; loop current x-refs and see if any should be removed
  1. S RCDEBTDA=0 F S RCDEBTDA=$O(^PRCA(430,"ATD",RCDEBTDA)) Q:'RCDEBTDA D
  1. . ;
  1. . ; not a first party account
  1. . I $P($G(^RCD(340,RCDEBTDA,0)),"^")'["DPT(" D Q
  1. . . W !,"Not a correct XREF. KILL ^PRCA(430,""ATD"",",RCDEBTDA,")"
  1. . . K ^PRCA(430,"ATD",RCDEBTDA)
  1. . ;
  1. . S RCDATE=0 F S RCDATE=$O(^PRCA(430,"ATD",RCDEBTDA,RCDATE)) Q:'RCDATE D
  1. . . S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)) Q:'RCBILLDA D
  1. . . . S DATE=+$P($G(^PRCA(430,RCBILLDA,6)),"^",21)
  1. . . . S DEBT=+$P($G(^PRCA(430,RCBILLDA,0)),"^",9)
  1. . . . I RCDEBTDA'=DEBT!(RCDATE'=DATE) D
  1. . . . . W !,"Not a correct XREF. KILL ^PRCA(430,""ATD"",",RCDEBTDA,",",RCDATE,",",RCBILLDA,")"
  1. . . . . K ^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)
  1. ;
  1. ; loop all bills and make sure x-ref is set
  1. S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,RCBILLDA)) Q:'RCBILLDA D
  1. . S RCDATE=+$P($G(^PRCA(430,RCBILLDA,6)),"^",21) I 'RCDATE Q
  1. . S RCDEBTDA=+$P($G(^PRCA(430,RCBILLDA,0)),"^",9) I 'RCDEBTDA Q
  1. . ;
  1. . ; not a first party account
  1. . I $P($G(^RCD(340,RCDEBTDA,0)),"^")'["DPT(" Q
  1. . ;
  1. . I '$D(^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)) D
  1. . . W !,"Missing XREF. SET ^PRCA(430,""ATD"",",RCDEBTDA,",",RCDATE,",",RCBILLDA,")"
  1. . . S ^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)=""
  1. Q