| 1 | PRCAGST1 ;WASH-ISC@ALTOONA,PA/CMS-Print Patient Statement Bottom ;10/16/96 11:13 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**2,48,104,176**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;ENTRY FROM PRCAGST PAGE 1
|
|---|
| 5 | NEW AMT,BN,DAT,DESC,I,REF,THNK,TN,TTY,X,Y,RCTOTAL
|
|---|
| 6 | D HDR
|
|---|
| 7 | S DESC(1)="Previous Balance",REF="" D WRL(PDAT,.DESC,PBAL,REF)
|
|---|
| 8 | S DAT=0
|
|---|
| 9 | 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
|
|---|
| 10 | . S REF=$P($G(^PRCA(430,BN,0)),"^") ; Get Bill Name
|
|---|
| 11 | . I $D(^TMP("PRCAGT",$J,DEB,DAT,BN,0)) S AMT=+^(0) I AMT D Q
|
|---|
| 12 | .. D BILLDESC(BN,.DESC) ; Compile bill description
|
|---|
| 13 | .. D WRL(DAT,.DESC,AMT,REF) ; Print the item
|
|---|
| 14 | . S TN=0 F S TN=$O(^TMP("PRCAGT",$J,DEB,DAT,BN,TN)) Q:'TN S AMT=^(TN) D
|
|---|
| 15 | .. S TTY=$P(AMT,U,2) S AMT=+AMT
|
|---|
| 16 | .. D AMOUNT(TN,TTY,.AMT,.THNK) ; Adjust Amount sign (+/-) and "Thank You" flag
|
|---|
| 17 | .. D TRANDESC(TN,.DESC) ; Compile description
|
|---|
| 18 | .. D WRL(DAT,.DESC,AMT,REF) ; Print the item
|
|---|
| 19 | I ($Y+9)>(IOSL-2) D D HDR
|
|---|
| 20 | . W !,"|" F I=12,46,9,12 S Y="",$P(Y,"_",I)="" W Y,"|"
|
|---|
| 21 | D SUM^PRCAGST2
|
|---|
| 22 | Q
|
|---|
| 23 | WRL(DAT,DESC,AMT,REF) ;Write transaction
|
|---|
| 24 | NEW LN,I,X,Y
|
|---|
| 25 | S LN=1,X=0 F S X=$O(DESC(X)) Q:'X S LN=$G(LN)+1
|
|---|
| 26 | I ($Y+LN)>(IOSL-2) D D HDR
|
|---|
| 27 | . W !,"|" F I=12,46,9,12 S Y="",$P(Y,"_",I)="" W Y,"|"
|
|---|
| 28 | W !,"|",$S($G(DAT):$$DAT(DAT),1:""),?12,"|",DESC(1),?58,"|",$J(AMT,8,2),?67,"|",?68,$G(REF),?79,"|"
|
|---|
| 29 | F X=1:0 S X=$O(DESC(X)) Q:'X W !,"|",?12,"|",DESC(X),?58,"|",?67,"|",?79,"|"
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | ; Get transaction description array
|
|---|
| 33 | TRANDESC(PRTRAN,RCDESC) N RCTOTAL
|
|---|
| 34 | ; RCTOTAL not used in reprinted statements.
|
|---|
| 35 | K RCDESC
|
|---|
| 36 | D TRANDESC^RCCPCPS1(PRTRAN,45) ; returns RCDESC() array (max. length 45 characters)
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | AMOUNT(BN,TTY,AMT,THNK) ;Adjust (+/-) amount depending on Transaction Type
|
|---|
| 40 | N BN0,CAT,TS
|
|---|
| 41 | S BN0=$G(^PRCA(430,BN,0)),CAT=$$CATN^PRCAFN(+$P(BN0,U,2))
|
|---|
| 42 | I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TTY_",") I AMT'<0 S AMT=-AMT
|
|---|
| 43 | I ",2,8,9,10,11,12,14,19,47,34,35,29,"'[(","_TTY_",") I AMT<0 S AMT=-AMT
|
|---|
| 44 | I +CAT=33,TTY=1 I AMT<0 S AMT=-AMT
|
|---|
| 45 | I +CAT=33,TTY=35 I AMT>0 S AMT=-AMT
|
|---|
| 46 | S TS=$P($G(^PRCA(430.3,TTY,0)),U,3) I '$D(THNK),(TS=2!(TS=20)) S THNK=1
|
|---|
| 47 | Q
|
|---|
| 48 | ; Description for bills
|
|---|
| 49 | ; Input: PRBILL - Bill IEN
|
|---|
| 50 | ; Output: RCDESC(1..n) - Description Array
|
|---|
| 51 | BILLDESC(PRBILL,RCDESC) K RCDESC
|
|---|
| 52 | D BILLDESC^RCCPCPS1(PRBILL,45) ; returns RCDESC() array (max. length 45 characters)
|
|---|
| 53 | Q
|
|---|
| 54 | DAT(DAT) ;slash date
|
|---|
| 55 | I 'DAT Q ""
|
|---|
| 56 | Q $$SLH^RCFN01(DAT,"/")
|
|---|
| 57 | HDR ;statement transaction header
|
|---|
| 58 | NEW I,Y
|
|---|
| 59 | S PAGE=$G(PAGE)+1
|
|---|
| 60 | I PAGE>1 W @IOF I $G(^RC(342,1,5))]"" F I=1:1:18 W !
|
|---|
| 61 | W !,"Department of Veterans Affairs",?50,"Acct No.: ",SSN
|
|---|
| 62 | W !,NAM,?50,"Page ",PAGE
|
|---|
| 63 | S Y="",$P(Y,"_",80)="" W !,Y
|
|---|
| 64 | W !,"|Date Posted|",?13," Description",?58,"| Amount ",?67,"| Reference |"
|
|---|
| 65 | W !,"|" F I=12,46,9,12 S Y="",$P(Y,"_",I)="" W Y,"|"
|
|---|
| 66 | Q
|
|---|
