source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAI103.m@ 710

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PRCAI103 ;WISC/RFJ-post init patch 103 ;1 Mar 97
2 ;;4.5;Accounts Receivable;**103**;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 N DATA3,DATE,TRANDA
9 ; for exempt int/adm charge transactions (entry = 14)
10 S DATE=0 F S DATE=$O(^PRCA(433,"AT",14,DATE)) Q:'DATE D
11 . S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AT",14,DATE,TRANDA)) Q:'TRANDA D
12 . . L +^PRCA(433,TRANDA)
13 . . ;
14 . . S DATA3=$G(^PRCA(433,TRANDA,3))
15 . . ; if there is interest collected (field 32),
16 . . ; move to interest charge (field 27)
17 . . I $P(DATA3,"^",2) D
18 . . . S $P(^PRCA(433,TRANDA,2),"^",7)=$P(DATA3,"^",2)
19 . . . S $P(^PRCA(433,TRANDA,3),"^",2)=""
20 . . ; if there is admin collected (field 33),
21 . . ; move to admin charge (field 28)
22 . . I $P(DATA3,"^",3) D
23 . . . S $P(^PRCA(433,TRANDA,2),"^",8)=$P(DATA3,"^",3)
24 . . . S $P(^PRCA(433,TRANDA,3),"^",3)=""
25 . . ;
26 . . L -^PRCA(433,TRANDA)
27 ;
28 ; if the patch is installed after the 20th of the month
29 ; send the responses to the messages which will be deleted
30 ; on the first of the month (by routine RCRJR)
31 I $E(DT,6,7)>20 D CLEANXMB^RCRJR
32 Q
Note: See TracBrowser for help on using the repository browser.