source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAGT.m@ 1008

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1PRCAGT ;WASH-ISC@ALTOONA,PA/CMS-Patient Statement Build Tran List ;8/19/93
2V ;;4.5;Accounts Receivable;**100,162,165,169**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;SEND (DEB=340-IFN,BEG,END,TRANTYPE=430.3-IFN)
5 ;BUILD ^TMP("PRCAGT",$J,DEB,DATE,BILL,TN)=TAMT^TTY
6 ;IF (TN,TTY)=0 TAMT=BILL'S ORIG AMT
7 ;CALLER MUST KILL ^TMP
8EN(DEB,BEG,END,TTY) ;*CALLER MUST KILL ^TMP("PRCAGT",$J)
9 NEW Y K ^TMP("PRCAGT",$J)
10 S:$G(BEG)="" BEG=0 I $G(END)="" D NOW^%DTC S END=%
11 S TTY=$G(TTY) I TTY="" D F430
12 D F433
13Q Q
14F430 ;
15 NEW DAT,BN
16 S DAT=BEG F S DAT=$O(^PRCA(430,"ATD",DEB,DAT)) Q:('DAT)!(DAT>END) S BN=0 F S BN=$O(^PRCA(430,"ATD",DEB,DAT,BN)) Q:'BN D
17 .I $P(^PRCA(430,BN,0),U,3) S ^TMP("PRCAGT",$J,DEB,DAT,BN,0)=$P(^PRCA(430,BN,0),"^",3)_"^0"
18 Q
19F433 ;
20 NEW DAT,TN,TN0,TN1
21 F DAT=BEG:0 S DAT=$O(^PRCA(433,"ATD",DEB,DAT)) Q:('DAT)!(DAT>END) F TN=0:0 S TN=$O(^PRCA(433,"ATD",DEB,DAT,TN)) Q:'TN D
22 .S TN0=$G(^PRCA(433,TN,0)) Q:TN0="" S TN1=$G(^PRCA(433,TN,1))
23 .I $G(TTY)'="" Q:TTY'=$P(TN1,U,2)
24 .I TTY="",",3,4,5,6,7,24,25,30,"[(","_$P(TN1,U,2)_",") Q
25 .I ($P(TN0,U,2)="")!($P(TN0,U,4)'=2) Q
26 .I $G(PRCAHIST)="THIST",$P(TN1,U,2)=45 G F433A
27 .I $P(TN0,U,10)=1 Q
28 .;
29 .; if transaction type not 46 (unsuspended) and not 47 (suspended)
30 .; then check to see if the bill was suspended or unsuspended at the
31 .; time the transaction was entered. if the bill is suspended, then
32 .; the transaction should not be counted. if the bill is unsuspended
33 .; then the transaction should be counted.
34 .I $P(TN1,"^",2)'=46,$P(TN1,"^",2)'=47 D I TN1="" Q
35 . . N RCTRANDA,RCSTOP,TRANTYPE
36 . . ; check to see if bill was unsuspended when transaction was created
37 . . ; if so, count the transaction
38 . . S RCSTOP=0
39 . . S RCTRANDA=TN F S RCTRANDA=$O(^PRCA(433,"C",+$P(TN0,"^",2),RCTRANDA),-1) Q:'RCTRANDA D I RCSTOP Q
40 . . . ; transaction not complete
41 . . . I $P($G(^PRCA(433,RCTRANDA,0)),"^",4)'=2 Q
42 . . . S TRANTYPE=$P($G(^PRCA(433,RCTRANDA,1)),"^",2)
43 . . . ; transaction type is unsuspended (46) meaning the bill
44 . . . ; was unsuspended when the transaction was created. the
45 . . . ; transaction should be counted.
46 . . . I TRANTYPE=46 S RCSTOP=1 Q
47 . . . ; transaction type is suspended (47) meaning the bill
48 . . . ; was suspended when the transaction was created. the
49 . . . ; transaction should not be counted.
50 . . . I TRANTYPE=47 S RCSTOP=1,TN1="" Q
51 .;
52 .I TTY="",+$P(TN1,U,5)=0,$P(TN1,U,2)'=45 Q
53F433A .S ^TMP("PRCAGT",$J,DEB,DAT,$P(TN0,U,2),TN)=+$P(TN1,U,5)_U_$P(TN1,U,2)
54 S DAT=0 F S DAT=$O(^TMP("PRCAGT",$J,DEB,DAT)) Q:'DAT S END=DAT
55 Q
56TBAL(DEB,TBAL) ;get balance of transactions
57 NEW BN,CH,DAT,PC,RF,RR,TAMT,TN,TTY
58 S RR=+$O(^PRCA(430.2,"AC",33,0)),(CH,RF,PC)=0
59 I '$D(^TMP("PRCAGT",$J,DEB)) G TBALQ
60 F DAT=0:0 S DAT=$O(^TMP("PRCAGT",$J,DEB,DAT)) Q:'DAT F BN=0:0 S BN=$O(^TMP("PRCAGT",$J,DEB,DAT,BN)) Q:'BN D
61 .I $D(^TMP("PRCAGT",$J,DEB,DAT,BN,0)) S CH=CH+^(0)
62 .F TN=0:0 S TN=$O(^TMP("PRCAGT",$J,DEB,DAT,BN,TN)) Q:'TN S TAMT=^(TN),TTY=$P(TAMT,U,2) I TTY'=45 D
63 ..I TTY=12 S:TAMT<0 PC=PC+TAMT S:TAMT'<0 CH=CH+TAMT
64 ..; interest and admin charges may be negative
65 ..; this was added in patch 165
66 ..I TTY'=13 S TAMT=$TR(+TAMT,"-")
67 ..I $P(^PRCA(430,BN,0),U,2)=RR S:TTY=1 PC=PC-TAMT S:TTY=35 CH=CH+TAMT S:TTY=41 RF=RF+TAMT Q
68 ..I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TTY_",") S PC=PC-TAMT Q
69 ..I ",1,13,46,43,"[(","_TTY_",") S CH=CH+TAMT
70 ;
71TBALQ S TBAL("RF")=RF,TBAL("CH")=CH,TBAL("PC")=PC,TBAL=RF+CH+PC
72 Q
73ACT(DEB,DAT) ;Quit 1 if debtor has activity other than interest
74 NEW BN,DATT,TN,TN0,TN1
75 S TN=0 F DATT=$P($G(DAT),"."):0 S DATT=$O(^PRCA(430,"ATD",DEB,DATT)) Q:'DATT!(TN) F BN=0:0 S BN=$O(^PRCA(430,"ATD",DEB,DATT,BN)) Q:'BN!(TN) S TN=1 Q
76 I TN=1 G Q1
77 S BN=0 F DATT=$P($G(DAT),"."):0 S DATT=$O(^PRCA(433,"ATD",DEB,DATT)) Q:'DATT!(BN) F TN=0:0 S TN=$O(^PRCA(433,"ATD",DEB,DATT,TN)) Q:'TN!(BN) D
78 .S TN0=$G(^PRCA(433,TN,0)) Q:TN0="" S TN1=$G(^PRCA(433,TN,1))
79 .I ($P(TN0,U,4)=1)!($P(TN0,U,10)=1) Q
80 .I +$P(TN1,U,5)=0,$P(TN1,U,2)'=45 Q
81 .I +$P(TN1,U,2)'=13 S BN=1 Q
82 I BN=1 G Q1
83Q0 Q 0
84Q1 Q 1
Note: See TracBrowser for help on using the repository browser.