source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBDXREF.m@ 1739

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

initial load of WorldVistAEHR
File size: 1.6 KB
RevLine 
[613]1RCBDXREF ;WISC/RFJ-fix cross references ;1 Jan 01
2 ;;4.5;Accounts Receivable;**165**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7FIXATD ; fix atd x-ref
8 ;
9 N DATE,DEBT,RCBILLDA,RCDATE,RCDEBTDA
10 ;
11 ; loop current x-refs and see if any should be removed
12 S RCDEBTDA=0 F S RCDEBTDA=$O(^PRCA(430,"ATD",RCDEBTDA)) Q:'RCDEBTDA D
13 . ;
14 . ; not a first party account
15 . I $P($G(^RCD(340,RCDEBTDA,0)),"^")'["DPT(" D Q
16 . . W !,"Not a correct XREF. KILL ^PRCA(430,""ATD"",",RCDEBTDA,")"
17 . . K ^PRCA(430,"ATD",RCDEBTDA)
18 . ;
19 . S RCDATE=0 F S RCDATE=$O(^PRCA(430,"ATD",RCDEBTDA,RCDATE)) Q:'RCDATE D
20 . . S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)) Q:'RCBILLDA D
21 . . . S DATE=+$P($G(^PRCA(430,RCBILLDA,6)),"^",21)
22 . . . S DEBT=+$P($G(^PRCA(430,RCBILLDA,0)),"^",9)
23 . . . I RCDEBTDA'=DEBT!(RCDATE'=DATE) D
24 . . . . W !,"Not a correct XREF. KILL ^PRCA(430,""ATD"",",RCDEBTDA,",",RCDATE,",",RCBILLDA,")"
25 . . . . K ^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)
26 ;
27 ; loop all bills and make sure x-ref is set
28 S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,RCBILLDA)) Q:'RCBILLDA D
29 . S RCDATE=+$P($G(^PRCA(430,RCBILLDA,6)),"^",21) I 'RCDATE Q
30 . S RCDEBTDA=+$P($G(^PRCA(430,RCBILLDA,0)),"^",9) I 'RCDEBTDA Q
31 . ;
32 . ; not a first party account
33 . I $P($G(^RCD(340,RCDEBTDA,0)),"^")'["DPT(" Q
34 . ;
35 . I '$D(^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)) D
36 . . W !,"Missing XREF. SET ^PRCA(430,""ATD"",",RCDEBTDA,",",RCDATE,",",RCBILLDA,")"
37 . . S ^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)=""
38 Q
Note: See TracBrowser for help on using the repository browser.