| 1 | PRCASER ;WASH-ISC@ALTOONA,PA/RGY-Accept bill from billing engine ;2/23/95 2:40 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**90,153,203,211**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | NEW PRCAX,PRCASV,PRCAEN,PRCASEG
|
|---|
| 5 | S PRCAX=X,Y=0 F X="SITE","SER","CAT","DEBTOR","FY","AMT","APR","BDT" S Y=Y+1,PRCASV(X)=$P(PRCAX,"^",Y)
|
|---|
| 6 | L +^RCD(340,PRCASV("DEBTOR"),"PRCASER"):30 I '$T S Y="-1^PRCA004^AR Package 'busy' while trying to add transaction." G Q1
|
|---|
| 7 | I ",3,4,5,24,25,"[(","_PRCASV("CAT")_",") S PRCASV("CARE")=PRCASV("CAT"),PRCASV("CAT")=18
|
|---|
| 8 | S PRCASV("FY")=PRCASV("FY")_"^"_PRCASV("AMT")
|
|---|
| 9 | I '$D(PRCASV("PAT")) S PRCASV("PAT")=PRCASV("DEBTOR")
|
|---|
| 10 | S X=$O(^RCD(340,"B",PRCASV("DEBTOR"),0)) D:PRCASV("CAT")]""&X CHKAO I $D(PRCASV("ARREC")) D:PRCASV("AMT") TRAN S Y=PRCASV("ARREC")_"^"_PRCASV("ARBIL")_"^"_$S($D(PRCAEN):PRCAEN,1:"") G Q
|
|---|
| 11 | D ^PRCASVC3 I PRCASV("ARREC")<0,$P(PRCASV("ARREC"),"^",2)]"" S Y=PRCASV("ARREC") G Q
|
|---|
| 12 | I PRCASV("ARBIL")<0 S Y=PRCASV("ARBIL") G Q
|
|---|
| 13 | S $P(PRCASV("FY"),"^",2)=0 D REL^PRCASVC S $P(PRCASV("FY"),"^",2)=PRCASV("AMT") I $D(PRCAERR) S Y=PRCAERR G Q
|
|---|
| 14 | S PRCASEG=$S($D(PRCASV("CARE")):PRCASV("CARE"),$D(PRCASV("CAT")):PRCASV("CAT"),1:0) S:PRCASEG>1 PRCASEG=$P(^PRCA(430.2,PRCASEG,0),"^",3)
|
|---|
| 15 | S DR="8////^S X="_$O(^PRCA(430.3,"AC",112,0))_";20.1////^S X="_PRCASEG
|
|---|
| 16 | S DR=DR_";203////^S X="_$$GETFUNDB^RCXFMSUF(PRCASV("ARREC"),1)
|
|---|
| 17 | I $D(PRCASV("CARE")) S DR=DR_";15.1////^S X="_PRCASV("CARE")
|
|---|
| 18 | S DA=PRCASV("ARREC"),DIE="^PRCA(430," D ^DIE D:PRCASV("AMT")>0 TRAN
|
|---|
| 19 | S Y=PRCASV("ARREC")_"^"_PRCASV("ARBIL")_"^"_$S($D(PRCAEN):PRCAEN,1:"")
|
|---|
| 20 | Q L -^RCD(340,PRCASV("DEBTOR"),"PRCASER")
|
|---|
| 21 | Q1 S X=PRCAX K PRCAERR Q
|
|---|
| 22 | CHKAO ;
|
|---|
| 23 | F Y=0:0 S Y=$O(^PRCA(430,"AS",X,$O(^PRCA(430.3,"AC",112,0)),Y)) Q:'Y D
|
|---|
| 24 | .I $P(^PRCA(430,Y,0),"^",2)=PRCASV("CAT"),$S(PRCASV("CAT")'=$O(^PRCA(430.2,"AC",24,0)):1,$P(^PRCA(430,Y,0),"^",16)=PRCASV("CARE"):1,1:0) S PRCASV("ARREC")=Y,PRCASV("ARBIL")=$P(^PRCA(430,Y,0),"^")
|
|---|
| 25 | .QUIT
|
|---|
| 26 | Q
|
|---|
| 27 | TRAN ;
|
|---|
| 28 | NEW PRCABN,PRCAMT,PRCAA2
|
|---|
| 29 | D SETTR^PRCAUTL S PRCABN=PRCASV("ARREC") D PATTR^PRCAUTL
|
|---|
| 30 | S PRCA("ADJ")=$O(^PRCA(430.3,"AC",1,0)),DIE="^PRCA(433,",DR="[PRCA FY ADJ2 BATCH]",DA=PRCAEN D ^DIE S PRCAA2=$P(^PRCA(433,PRCAEN,4,0),"^",3) D UPFY^PRCADJ,TRANUP^PRCAUTL,UPPRIN^PRCADJ
|
|---|
| 31 | D PREPAY^RCBEPAYP(PRCABN,0)
|
|---|
| 32 | Q
|
|---|
