- PRCAGST ;WASH-ISC@ALTOONA,PA/CMS-Print Patient Statement ;12/12/96 9:39 AM
- V ;;4.5;Accounts Receivable;**34,181,190,249,405,406**;Mar 20, 1995;Build 5
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;ENTRY WITH DEBTOR PRINT STATEMENT
- EN(DEB,TBAL,PDAT,PBAL,LDT) ;
- NEW ADD,DA,LN,NAM,PAGE,SSN,X,X1,X2,Y,DEBT,RCDFN
- I '$D(SITE) D SITE^PRCAGU
- S RCDFN=+$P(^RCD(340,+DEB,0),U) ;PRCA*4.5*405 Get the DFN of the Debtor
- S SSN=$$SSN^RCFN01(DEB),SSN=$S(SSN=-1:"XXXXXXXXX",1:SSN)
- S $P(DEBT,U,2)=$$NAM^RCFN01(DEB) ;PRCA*4.5*406 Add Debtor name for Acct No Building
- S ADD=$$SADD^RCFN01(8) I ADD="" S ADD=$$SADD^RCFN01(1)
- S X=0 F Y=1:1:3 I $P(ADD,U,Y)]"" S X=X+1 S ADD(X)=$P(ADD,U,Y)
- S X=X+1,ADD(X)=$P(ADD,U,4)_", "_$P(ADD,U,5)_" "_$P(ADD,U,6)
- S X=X+1,ADD(X)=$P(ADD,U,7)
- W @IOF
- W !!,"Department of Veterans Affairs",?35,"Acct No.: ",$$ACCT^PRCAAPR1(RCDFN) ;PRCA*4.5*405 Replace SSN with Account Number
- W !,$G(ADD(1))
- S Y=$$FPS^RCAMFN01($S($G(LDT)>0:$E(LDT,1,5),1:$E(DT,1,5))_$TR($J($$PST^RCAMFN01(DEB),2)," ",0),$S(+$E($G(LDT),6,7)>$$STD^RCCPCFN:2,1:1)) D DD^%DT
- W !,$G(ADD(2)),?50 I TBAL>0 W "Due: UPON RECEIPT"
- W !,$G(ADD(3)),?50,$S(TBAL>0:"Amount Due: $"_$J(TBAL,0,2),1:"NO AMOUNT DUE")
- W !,$G(ADD(4)),?50,$S(TBAL'>0:"*THIS IS NOT A BILL*",1:"Amount Paid: _____________")
- W !,$G(ADD(5)),?50,"Today's Date: " S Y=DT D DD^%DT W Y
- I TBAL'>0 D MES G LB
- W !!,?2,"Please Make your Check or Money Order payable to the ""Department of Veterans"
- W !,?2,"Affairs"" and send payment to the attention of the Agent Cashier at the above"
- W !,?2,"address. If you have any questions regarding this statement, please call"
- W !,?2,"1-866-400-1238.",!!!
- LB K ADD S NAM=$$NAM^RCFN01(DEB)
- W !,?7,NAM
- S ADD=$$DADD^RCAMADD(DEB,1) ; Get debtor address, confidential if applicable
- S X=0 F Y=1:1:3 I $P(ADD,U,Y)]"" S X=X+1 S ADD(X)=$P(ADD,U,Y)
- S X=X+1,ADD(X)=$P(ADD,U,4)_", "_$P(ADD,U,5)_" "_$P(ADD,U,6)
- F X=0:0 S X=$O(ADD(X)) Q:'X W !,?7,$E(ADD(X),1,40) I X=1 W ?50 X $G(SITE("SCAN"))
- W !
- I $G(SITE("COM1"))'="" W !,?2,SITE("COM1")
- I $$GMT(DEB) W !,?2,"REDUCTION OF INPATIENT COPAYMENT DUE TO GEOGRAPHIC MEANS TEST STATUS"
- W !! I TBAL>0 W !,?10,"Please Detach and Return Top Portion with Payment"
- S Y="",$P(Y,"=",80)="" W !,Y
- W !,"IMPORTANT: Please read the Notice of Rights accompanying this statement!",!
- D ^PRCAGST1
- Q
- MES ;text for no amount due
- W !!,?2,"This statement is being sent to you to provide you with information"
- W !,?2,"concerning transactions affecting your account. If a prepayment offset"
- W !,?2,"a bill or you have made one or more payments or charges were removed,"
- W !,?2,"from your account, you are being sent this statement to confirm these actions.",!!
- Q
- ;
- ; Detect GMT-related status for the statement (fetch all patient's bills)
- ; Input: Temporary global ^TMP("PRCAGT",$J,PRDEB)
- ; Output: 1 - 'Yes', 0 - 'No'
- GMT(PRDEB) N PRDAT,PRBN,PRGMT
- S PRGMT=0 ; Default
- I $G(PRDEB)'="" S PRDAT=0 F S PRDAT=$O(^TMP("PRCAGT",$J,PRDEB,PRDAT)) Q:'PRDAT D Q:PRGMT
- . S PRBN=0 F S PRBN=$O(^TMP("PRCAGT",$J,PRDEB,PRDAT,PRBN)) Q:'PRBN D Q:PRGMT
- .. I $$ISGMTBIL^IBAGMT($P($G(^PRCA(430,PRBN,0)),U,1)) S PRGMT=1
- Q PRGMT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAGST 3231 printed Mar 13, 2025@20:44:25 Page 2
- PRCAGST ;WASH-ISC@ALTOONA,PA/CMS-Print Patient Statement ;12/12/96 9:39 AM
- V ;;4.5;Accounts Receivable;**34,181,190,249,405,406**;Mar 20, 1995;Build 5
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;ENTRY WITH DEBTOR PRINT STATEMENT
- EN(DEB,TBAL,PDAT,PBAL,LDT) ;
- +1 NEW ADD,DA,LN,NAM,PAGE,SSN,X,X1,X2,Y,DEBT,RCDFN
- +2 IF '$DATA(SITE)
- DO SITE^PRCAGU
- +3 ;PRCA*4.5*405 Get the DFN of the Debtor
- SET RCDFN=+$PIECE(^RCD(340,+DEB,0),U)
- +4 SET SSN=$$SSN^RCFN01(DEB)
- SET SSN=$SELECT(SSN=-1:"XXXXXXXXX",1:SSN)
- +5 ;PRCA*4.5*406 Add Debtor name for Acct No Building
- SET $PIECE(DEBT,U,2)=$$NAM^RCFN01(DEB)
- +6 SET ADD=$$SADD^RCFN01(8)
- IF ADD=""
- SET ADD=$$SADD^RCFN01(1)
- +7 SET X=0
- FOR Y=1:1:3
- IF $PIECE(ADD,U,Y)]""
- SET X=X+1
- SET ADD(X)=$PIECE(ADD,U,Y)
- +8 SET X=X+1
- SET ADD(X)=$PIECE(ADD,U,4)_", "_$PIECE(ADD,U,5)_" "_$PIECE(ADD,U,6)
- +9 SET X=X+1
- SET ADD(X)=$PIECE(ADD,U,7)
- +10 WRITE @IOF
- +11 ;PRCA*4.5*405 Replace SSN with Account Number
- WRITE !!,"Department of Veterans Affairs",?35,"Acct No.: ",$$ACCT^PRCAAPR1(RCDFN)
- +12 WRITE !,$GET(ADD(1))
- +13 SET Y=$$FPS^RCAMFN01($SELECT($GET(LDT)>0:$EXTRACT(LDT,1,5),1:$EXTRACT(DT,1,5))_$TRANSLATE($JUSTIFY($$PST^RCAMFN01(DEB),2)," ",0),$SELECT(+$EXTRACT($GET(LDT),6,7)>$$STD^RCCPCFN:2,1:1))
- DO DD^%DT
- +14 WRITE !,$GET(ADD(2)),?50
- IF TBAL>0
- WRITE "Due: UPON RECEIPT"
- +15 WRITE !,$GET(ADD(3)),?50,$SELECT(TBAL>0:"Amount Due: $"_$JUSTIFY(TBAL,0,2),1:"NO AMOUNT DUE")
- +16 WRITE !,$GET(ADD(4)),?50,$SELECT(TBAL'>0:"*THIS IS NOT A BILL*",1:"Amount Paid: _____________")
- +17 WRITE !,$GET(ADD(5)),?50,"Today's Date: "
- SET Y=DT
- DO DD^%DT
- WRITE Y
- +18 IF TBAL'>0
- DO MES
- GOTO LB
- +19 WRITE !!,?2,"Please Make your Check or Money Order payable to the ""Department of Veterans"
- +20 WRITE !,?2,"Affairs"" and send payment to the attention of the Agent Cashier at the above"
- +21 WRITE !,?2,"address. If you have any questions regarding this statement, please call"
- +22 WRITE !,?2,"1-866-400-1238.",!!!
- LB KILL ADD
- SET NAM=$$NAM^RCFN01(DEB)
- +1 WRITE !,?7,NAM
- +2 ; Get debtor address, confidential if applicable
- SET ADD=$$DADD^RCAMADD(DEB,1)
- +3 SET X=0
- FOR Y=1:1:3
- IF $PIECE(ADD,U,Y)]""
- SET X=X+1
- SET ADD(X)=$PIECE(ADD,U,Y)
- +4 SET X=X+1
- SET ADD(X)=$PIECE(ADD,U,4)_", "_$PIECE(ADD,U,5)_" "_$PIECE(ADD,U,6)
- +5 FOR X=0:0
- SET X=$ORDER(ADD(X))
- if 'X
- QUIT
- WRITE !,?7,$EXTRACT(ADD(X),1,40)
- IF X=1
- WRITE ?50
- XECUTE $GET(SITE("SCAN"))
- +6 WRITE !
- +7 IF $GET(SITE("COM1"))'=""
- WRITE !,?2,SITE("COM1")
- +8 IF $$GMT(DEB)
- WRITE !,?2,"REDUCTION OF INPATIENT COPAYMENT DUE TO GEOGRAPHIC MEANS TEST STATUS"
- +9 WRITE !!
- IF TBAL>0
- WRITE !,?10,"Please Detach and Return Top Portion with Payment"
- +10 SET Y=""
- SET $PIECE(Y,"=",80)=""
- WRITE !,Y
- +11 WRITE !,"IMPORTANT: Please read the Notice of Rights accompanying this statement!",!
- +12 DO ^PRCAGST1
- +13 QUIT
- MES ;text for no amount due
- +1 WRITE !!,?2,"This statement is being sent to you to provide you with information"
- +2 WRITE !,?2,"concerning transactions affecting your account. If a prepayment offset"
- +3 WRITE !,?2,"a bill or you have made one or more payments or charges were removed,"
- +4 WRITE !,?2,"from your account, you are being sent this statement to confirm these actions.",!!
- +5 QUIT
- +6 ;
- +7 ; Detect GMT-related status for the statement (fetch all patient's bills)
- +8 ; Input: Temporary global ^TMP("PRCAGT",$J,PRDEB)
- +9 ; Output: 1 - 'Yes', 0 - 'No'
- GMT(PRDEB) NEW PRDAT,PRBN,PRGMT
- +1 ; Default
- SET PRGMT=0
- +2 IF $GET(PRDEB)'=""
- SET PRDAT=0
- FOR
- SET PRDAT=$ORDER(^TMP("PRCAGT",$JOB,PRDEB,PRDAT))
- if 'PRDAT
- QUIT
- Begin DoDot:1
- +3 SET PRBN=0
- FOR
- SET PRBN=$ORDER(^TMP("PRCAGT",$JOB,PRDEB,PRDAT,PRBN))
- if 'PRBN
- QUIT
- Begin DoDot:2
- +4 IF $$ISGMTBIL^IBAGMT($PIECE($GET(^PRCA(430,PRBN,0)),U,1))
- SET PRGMT=1
- End DoDot:2
- if PRGMT
- QUIT
- End DoDot:1
- if PRGMT
- QUIT
- +5 QUIT PRGMT
