- 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 Jan 18, 2025@02:41 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