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