source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAI168.m@ 1361

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PRCAI168 ;WISC/RFJ-post init patch 168 ; 26 Jan 01
2 ;;4.5;Accounts Receivable;**168**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7START ; start post init
8 ; track int, admin write offs on the write off 433 transaction
9 ;
10 D BMES^XPDUTL(" >> Checking write-off transactions ...")
11 ;
12 N DATA7,DATA8,NEXTTRAN,P,PRIN,RCBILLDA,RCDATE,RCTRANDA,RCTRTYPE
13 ;
14 ; 8 = TERM.BY FIS.OFFICER
15 ; 9 = TERM.BY COMPROMISE
16 ; 10 = WAIVED IN FULL
17 ; 11 = WAIVED IN PART
18 ; 29 = TERM BY RC/DOJ
19 F RCTRTYPE=8,9,10,11,29 S RCDATE=0 F S RCDATE=$O(^PRCA(433,"AT",RCTRTYPE,RCDATE)) Q:'RCDATE D
20 . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AT",RCTRTYPE,RCDATE,RCTRANDA)) Q:'RCTRANDA D
21 . . ; if transaction status not valid, quit
22 . . I '$$VALID^RCRJRCOT(RCTRANDA) Q
23 . . ;
24 . . L +^PRCA(433,RCTRANDA)
25 . . ;
26 . . S DATA8=$G(^PRCA(433,RCTRANDA,8))
27 . . S PRIN=$P(DATA8,"^") I 'PRIN S PRIN=$$TRANAMT^RCRJRCOT(RCTRANDA),$P(DATA8,"^")=PRIN
28 . . ;
29 . . S RCBILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA L -^PRCA(433,RCTRANDA) Q
30 . . S DATA7=$P($G(^PRCA(430,RCBILLDA,7)),"^",1,5)
31 . . ;
32 . . ; if the termination is not the last transaction, find the next re-establish transaction
33 . . ; to determine the interest and admin
34 . . I $O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) D
35 . . . S NEXTTRAN=RCTRANDA F S NEXTTRAN=$O(^PRCA(433,"C",RCBILLDA,NEXTTRAN)) Q:'NEXTTRAN I $P($G(^PRCA(433,NEXTTRAN,1)),"^",2)=43 Q
36 . . . I 'NEXTTRAN Q
37 . . . F P=2:1:5 S $P(DATA8,"^",P)=+$P($G(^PRCA(433,NEXTTRAN,8)),"^",P)
38 . . ;
39 . . ; move over int, admin, mf, cc
40 . . I '$O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) F P=2:1:5 S $P(DATA8,"^",P)=+$P(DATA7,"^",P)
41 . . ;
42 . . F P=1:1:5 I $P(DATA8,"^",P),(+$P(DATA8,"^",P)'=+$P($G(^PRCA(433,RCTRANDA,8)),"^",P)) D
43 . . . S $P(^PRCA(433,RCTRANDA,8),"^",P)=+$P(DATA8,"^",P)
44 . . ;
45 . . L -^PRCA(433,RCTRANDA)
46 ;
47 D MES^XPDUTL(" OK, done.")
48 Q
Note: See TracBrowser for help on using the repository browser.