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 Oct 16, 2024@17:40:36 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
