source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAAPR.m@ 1397

PRCAAPR ;WASH-ISC@ALTOONA,PA/RGY-PATIENT ACCOUNT PROFILE (CONT) ;3/9/94  8:41 AM
V ;;4.5;Accounts Receivable;**198,221**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
EN(PRCATY) ;
 NEW DIC,X,Y,DEBT,PRCADB,DA,PRCA,COUNT,OUT,SEL,BILL,BAT,TRAN,DR,DXS,DTOUT,DIROUT,DIRUT,DUOUT
ASK N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
 K OUT S COUNT=0 R !,"Select DEBTOR NAME or BILL NUMBER: ",X:DTIME I "^"[$E(X) S $P(DEBT,"^",2)="" G Q
 S X=$$UPPER^VALM1(X)
 S Y=$S($O(^PRCA(430,"B",X,0)):$O(^(0)),$O(^PRCA(430,"D",X,0)):$O(^(0)),1:-1)
 I Y>0 S DEBT=$P($G(^PRCA(430,Y,0)),"^",9) I DEBT S PRCADB=$P($G(^RCD(340,DEBT,0)),"^"),^DISV(DUZ,"^PRCA(430,")=Y,$P(DEBT,"^",2)=$$NAM^RCFN01(DEBT) D COMP,EN1^PRCAATR(Y) G:$D(DTOUT) Q G ASK
 S DIC="^RCD(340,",DIC(0)="E" D ^DIC G:Y<0 ASK
 S ^DISV(DUZ,"^RCD(340,")=+Y,PRCADB=$P(Y,"^",2),DEBT=+Y_"^"_$P(@("^"_$P(PRCADB,";",2)_+PRCADB_",0)"),"^")
 D COMP,HDR^PRCAAPR1,HDR2^PRCAAPR1,DIS^PRCAAPR1 G:'$D(DTOUT) ASK
Q K ^TMP("PRCAAPR",$J) Q
COMP ;Compile patient bills
 K ^TMP("PRCAAPR",$J)
 NEW STAT,STAT1,CNT,Y
 S STAT1=0
 F CNT=1:1 S STAT1=+$S(PRCATY="ALL":$O(^PRCA(430,"AS",+DEBT,STAT1)),1:$O(^PRCA(430.3,"AC",+$P(PRCATY,",",CNT),0))) Q:'STAT1  F BILL=0:0 S BILL=$O(^PRCA(430,"AS",+DEBT,STAT1,BILL)) Q:'BILL  D COMP1
 I PRCADB[";DPT(" F BILL=0:0 S BILL=$O(^PRCA(430,"E",+PRCADB,BILL)) Q:'BILL  I PRCATY="ALL"!((","_PRCATY_",")[(","_$P($G(^PRCA(430.3,+$P($G(^PRCA(430,BILL,0)),"^",8),0)),"^",3)_",")) D COMP1
 F BAT=0:0 S BAT=$O(^RCY(344,"AC",PRCADB,BAT)) Q:'BAT  F TRAN=0:0 S TRAN=$O(^RCY(344,"AC",PRCADB,BAT,TRAN)) Q:'TRAN  I $G(^RCY(344,BAT,1,TRAN,0))]"",$P(^(0),"^",5)="" D COMP2
 Q
COMP1 S STAT=$P($G(^PRCA(430.3,+$P($G(^PRCA(430,BILL,0)),"^",8),0)),"^",3) Q:STAT=""
 S X=$G(^PRCA(430,BILL,7)),Y=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
 I $P(^PRCA(430,BILL,0),"^",2)=$O(^PRCA(430.2,"AC",33,0)) S Y=-Y
 S Y=$S($P(^PRCA(430,BILL,0),"^",2)=$O(^PRCA(430.2,"AC",33,0))&(STAT'=112):0,$P(^PRCA(430,BILL,0),"^",9)'=+DEBT:0,",102,107,112,"[(","_STAT_","):Y,1:0)
 S ^TMP("PRCAAPR",$J,"C")=$G(^TMP("PRCAAPR",$J,"C"))+Y
 S ^TMP("PRCAAPR",$J,"C",STAT)=$G(^TMP("PRCAAPR",$J,"C",STAT))+Y_"^"_STAT,^(STAT,BILL)=$P(X,"^",1,5)
 Q
COMP2 ;Compile payments
 S Y=$P(^RCY(344,BAT,1,TRAN,0),"^",4)
 S ^TMP("PRCAAPR",$J,"C")=$G(^TMP("PRCAAPR",$J,"C"))-Y
 S ^TMP("PRCAAPR",$J,"C",99)=$G(^TMP("PRCAAPR",$J,"C",99))-Y_"^99",^TMP("PRCAAPR",$J,"C",99,$P(^RCY(344,BAT,0),"^")_"-"_TRAN)=$P(^RCY(344,BAT,1,TRAN,0),"^",4)
 Q