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

PRCAGST1.m

Go to the documentation of this file.
  1. PRCAGST1 ;WASH-ISC@ALTOONA,PA/CMS-Print Patient Statement Bottom ;10/16/96 11:13 AM
  1. V ;;4.5;Accounts Receivable;**2,48,104,176,249,301,405,406**;Mar 20, 1995;Build 5
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;ENTRY FROM PRCAGST PAGE 1
  1. ;INPUT (UNDECLARED): RCDFN - (Optional) Patient IEN
  1. ; DEB - Debtor IEN
  1. ; DEBT - Debtor Info Variable (<Unknown>^Name (Last,First Middle))
  1. ;
  1. NEW AMT,BN,DAT,DESC,I,REF,THNK,TN,TTY,X,Y,RCTOTAL
  1. ;
  1. ; PRCA*4.5*406 - Set up DFN and Name for Acct No. Creation.
  1. I '$G(RCDFN) S RCDFN=+$P(^RCD(340,+DEB,0),U) ;Get the DFN of the Debtor if it doesn't exist
  1. I $P($G(DEBT),U,2)="" S $P(DEBT,U,2)=$$NAM^RCFN01(DEB) ;Get the Debtor name if necessary
  1. ;End PRCA*4.5*406
  1. ;
  1. D HDR
  1. S DESC(1)="Previous Balance",REF="" D WRL(PDAT,.DESC,PBAL,REF)
  1. S DAT=0
  1. F S DAT=$O(^TMP("PRCAGT",$J,DEB,DAT)) Q:'DAT S BN=0 F S BN=$O(^TMP("PRCAGT",$J,DEB,DAT,BN)) Q:'BN D
  1. . Q:$D(^PRCA(430,"TCSP",BN)) ; skip CS bills/transactions
  1. . S REF=$P($G(^PRCA(430,BN,0)),"^") ; Get Bill Name
  1. . I $D(^TMP("PRCAGT",$J,DEB,DAT,BN,0)) S AMT=+^(0) I AMT D Q
  1. .. D BILLDESC(BN,.DESC) ; Compile bill description
  1. .. D WRL(DAT,.DESC,AMT,REF) ; Print the item
  1. . S TN=0 F S TN=$O(^TMP("PRCAGT",$J,DEB,DAT,BN,TN)) Q:'TN S AMT=^(TN) D
  1. .. S TTY=$P(AMT,U,2) S AMT=+AMT
  1. .. D AMOUNT(TN,TTY,.AMT,.THNK) ; Adjust Amount sign (+/-) and "Thank You" flag
  1. .. D TRANDESC(TN,.DESC) ; Compile description
  1. .. D WRL(DAT,.DESC,AMT,REF) ; Print the item
  1. I ($Y+9)>(IOSL-2) D D HDR
  1. . W !,"|" F I=12,46,9,12 S Y="",$P(Y,"_",I)="" W Y,"|"
  1. D SUM^PRCAGST2
  1. Q
  1. WRL(DAT,DESC,AMT,REF) ;Write transaction
  1. NEW LN,I,X,Y
  1. S LN=1,X=0 F S X=$O(DESC(X)) Q:'X S LN=$G(LN)+1
  1. I ($Y+LN)>(IOSL-2) D D HDR
  1. . W !,"|" F I=12,46,9,12 S Y="",$P(Y,"_",I)="" W Y,"|"
  1. W !,"|",$S($G(DAT):$$DAT(DAT),1:""),?12,"|",DESC(1),?58,"|",$J(AMT,8,2),?67,"|",?68,$G(REF),?79,"|"
  1. F X=1:0 S X=$O(DESC(X)) Q:'X W !,"|",?12,"|",DESC(X),?58,"|",?67,"|",?79,"|"
  1. Q
  1. ;
  1. ; Get transaction description array
  1. TRANDESC(PRTRAN,RCDESC) N RCTOTAL
  1. ; RCTOTAL not used in reprinted statements.
  1. K RCDESC
  1. D TRANDESC^RCCPCPS1(PRTRAN,45) ; returns RCDESC() array (max. length 45 characters)
  1. Q
  1. ;
  1. AMOUNT(BN,TTY,AMT,THNK) ;Adjust (+/-) amount depending on Transaction Type
  1. N BN0,CAT,TS
  1. S BN0=$G(^PRCA(430,BN,0)),CAT=$$CATN^PRCAFN(+$P(BN0,U,2))
  1. I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TTY_",") I AMT'<0 S AMT=-AMT
  1. I ",2,8,9,10,11,12,14,19,47,34,35,29,"'[(","_TTY_",") I AMT<0 S AMT=-AMT
  1. I +CAT=33,TTY=1 I AMT<0 S AMT=-AMT
  1. I +CAT=33,TTY=35 I AMT>0 S AMT=-AMT
  1. S TS=$P($G(^PRCA(430.3,TTY,0)),U,3) I '$D(THNK),(TS=2!(TS=20)) S THNK=1
  1. Q
  1. ; Description for bills
  1. ; Input: PRBILL - Bill IEN
  1. ; Output: RCDESC(1..n) - Description Array
  1. BILLDESC(PRBILL,RCDESC) K RCDESC
  1. D BILLDESC^RCCPCPS1(PRBILL,45) ; returns RCDESC() array (max. length 45 characters)
  1. Q
  1. DAT(DAT) ;slash date
  1. I 'DAT Q ""
  1. Q $$SLH^RCFN01(DAT,"/")
  1. HDR ;statement transaction header
  1. NEW I,Y
  1. S PAGE=$G(PAGE)+1
  1. I PAGE>1 W @IOF I $G(^RC(342,1,5))]"" F I=1:1:18 W !
  1. W !,"Department of Veterans Affairs",?35,"Acct No.:",$$ACCT^PRCAAPR1(RCDFN) ;PRCA*4.5*405 Replace SSN with Account Number
  1. W !,NAM,?50,"Page ",PAGE
  1. S Y="",$P(Y,"_",80)="" W !,Y
  1. W !,"|Date Posted|",?13," Description",?58,"| Amount ",?67,"| Reference |"
  1. W !,"|" F I=12,46,9,12 S Y="",$P(Y,"_",I)="" W Y,"|"
  1. Q