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

PRCAGT.m

Go to the documentation of this file.
  1. PRCAGT ;WASH-ISC@ALTOONA,PA/CMS - Patient Statement Build Tran List ;8/19/93
  1. V ;;4.5;Accounts Receivable;**100,162,165,169,219,301,340,377,381,389**;Mar 20, 1995;Build 36
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;SEND (DEB=340-IFN,BEG,END,TRANTYPE=430.3-IFN)
  1. ;BUILD ^TMP("PRCAGT",$J,DEB,DATE,BILL,TN)=TAMT^TTY
  1. ;IF (TN,TTY)=0 TAMT=BILL'S ORIG AMT
  1. ;CALLER MUST KILL ^TMP
  1. EN(DEB,BEG,END,TTY) ;*CALLER MUST KILL ^TMP("PRCAGT",$J)
  1. NEW Y,% K ^TMP("PRCAGT",$J)
  1. S:$G(BEG)="" BEG=0 I $G(END)="" D NOW^%DTC S END=%
  1. S TTY=$G(TTY) I TTY="" D F430
  1. D F433
  1. Q Q
  1. F430 ;
  1. NEW DAT,BN
  1. 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
  1. .;Q:$D(^PRCA(430,"TCSP",BN)) ;prca*4.5*301
  1. .I $P(^PRCA(430,BN,0),U,3) S ^TMP("PRCAGT",$J,DEB,DAT,BN,0)=$P(^PRCA(430,BN,0),"^",3)_"^0"
  1. Q
  1. F433 ;
  1. NEW DAT,TN,TN0,TN1,COMM S COMM=0
  1. 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
  1. .S TN0=$G(^PRCA(433,TN,0)) Q:TN0="" S TN1=$G(^PRCA(433,TN,1))
  1. .I $P(TN1,U,2)=45 S COMM=1
  1. .I $G(TTY)'="" Q:TTY'=$P(TN1,U,2)
  1. .;PRCA*4.5*377/PRCA*4.5*381/PRCA*4.5*389
  1. .I TTY="",",3,4,5,6,7,24,30,"[(","_$P(TN1,U,2)_",") Q
  1. .I ($P(TN0,U,2)="")!($P(TN0,U,4)'=2) Q
  1. .I $G(PRCAHIST)="THIST",$P(TN1,U,2)=45 G F433A
  1. .I $P(TN0,U,10)=1 Q
  1. .;
  1. .; if transaction type not 46 (unsuspended) and not 47 (suspended)
  1. .; then check to see if the bill was suspended or unsuspended at the
  1. .; time the transaction was entered. if the bill is suspended, then
  1. .; the transaction should not be counted. if the bill is unsuspended
  1. .; then the transaction should be counted.
  1. .I $P(TN1,"^",2)'=46,$P(TN1,"^",2)'=47 D I TN1="" Q
  1. . . N RCTRANDA,RCSTOP,TRANTYPE
  1. . . ; check to see if bill was unsuspended when transaction was created
  1. . . ; if so, count the transaction
  1. . . S RCSTOP=0
  1. . . S RCTRANDA=TN F S RCTRANDA=$O(^PRCA(433,"C",+$P(TN0,"^",2),RCTRANDA),-1) Q:'RCTRANDA D I RCSTOP Q
  1. . . . ; transaction not complete
  1. . . . I $P($G(^PRCA(433,RCTRANDA,0)),"^",4)'=2 Q
  1. . . . S TRANTYPE=$P($G(^PRCA(433,RCTRANDA,1)),"^",2)
  1. . . . ; transaction type is unsuspended (46) meaning the bill
  1. . . . ; was unsuspended when the transaction was created. the
  1. . . . ; transaction should be counted.
  1. . . . I TRANTYPE=46 S RCSTOP=1 Q
  1. . . . ; transaction type is suspended (47) meaning the bill
  1. . . . ; was suspended when the transaction was created. the
  1. . . . ; transaction should not be counted.
  1. . . . I TRANTYPE=47 S RCSTOP=1,TN1="" Q
  1. .;
  1. .I TTY="",+$P(TN1,U,5)=0,$P(TN1,U,2)'=45 Q
  1. F433A .S ^TMP("PRCAGT",$J,DEB,DAT,$P(TN0,U,2),TN)=+$P(TN1,U,5)_U_$P(TN1,U,2)
  1. S DAT=0 F S DAT=$O(^TMP("PRCAGT",$J,DEB,DAT)) Q:'DAT S END=DAT
  1. Q
  1. TBAL(DEB,TBAL) ;get balance of transactions
  1. NEW BN,CH,DAT,PC,RF,RR,TAMT,TN,TTY,CS,CSFLAG
  1. S RR=+$O(^PRCA(430.2,"AC",33,0)),(CH,RF,PC)=0,CSFLAG=$D(CSTCH)
  1. I '$D(^TMP("PRCAGT",$J,DEB)) G TBALQ
  1. 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
  1. .S CS=$D(^PRCA(430,"TCSP",BN)) ; set flag for CS bills
  1. .I $D(^TMP("PRCAGT",$J,DEB,DAT,BN,0)) S CH=CH+^(0) S:CS CSTCH=$G(CSTCH)+^(0)
  1. .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
  1. ..I TTY=12!(TTY=74) S:TAMT<0 PC=PC+TAMT S:TAMT'<0 CH=CH+TAMT S:TAMT<0&CS CSTPC=$G(CSTPC)+TAMT S:TAMT'<0 CSTCH=$G(CSTCH)+TAMT
  1. ..; interest and admin charges may be negative
  1. ..; this was added in patch 165
  1. ..I TTY'=13 S TAMT=$TR(+TAMT,"-")
  1. ..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
  1. ..I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TTY_",") S PC=PC-TAMT S:CS CSTPC=$G(CSTPC)-TAMT Q
  1. ..I ",1,13,46,43,73,"[(","_TTY_",") S CH=CH+TAMT S:CS CSTCH=$G(CSTCH)+TAMT
  1. ;
  1. TBALQ S TBAL("RF")=RF,TBAL("CH")=CH,TBAL("PC")=PC,TBAL=RF+CH+PC
  1. I 'CSFLAG K CSTCH,CSTPC
  1. Q
  1. ACT(DEB,DAT) ;Quit 1 if debtor has activity other than interest
  1. NEW BN,DATT,TN,TN0,TN1
  1. 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
  1. I TN=1 G Q1
  1. 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
  1. .S TN0=$G(^PRCA(433,TN,0)) Q:TN0="" S TN1=$G(^PRCA(433,TN,1))
  1. .I ($P(TN0,U,4)=1)!($P(TN0,U,10)=1) Q
  1. .I +$P(TN1,U,5)=0,$P(TN1,U,2)'=45 Q
  1. .I +$P(TN1,U,2)'=13 S BN=1 Q
  1. I BN=1 G Q1
  1. Q0 Q 0
  1. Q1 Q 1