| 1 | PRCADJ ;SF-ISC/YJK,ALB/CMS - ADJUSTMENT TRANSACTION ;9/7/95 10:58 AM
|
|---|
| 2 | ;;4.5;Accounts Receivable;**21,67,48,89,63,111,123,131,134,169**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | UPPRIN ;Update Prin bal
|
|---|
| 9 | N DA,DIE,DR,X,Y
|
|---|
| 10 | Q:('$D(PRCABN))!('$D(PRCAMT))
|
|---|
| 11 | Q:'$D(^PRCA(430,+PRCABN,7))
|
|---|
| 12 | S PRCAMT("C")=$P(^PRCA(430,+PRCABN,7),U,1)+PRCAMT
|
|---|
| 13 | S DA=+PRCABN,DIE="^PRCA(430,",DR="71////^S X="_PRCAMT("C") D ^DIE
|
|---|
| 14 | S (X,PRCAMT("C"))=$G(^PRCA(430,+PRCABN,7))
|
|---|
| 15 | I ($P($G(^PRCA(430,+$G(PRCABN),0)),"^",2)=$O(^PRCA(430.2,"AC",33,0))),($P($G(^PRCA(430,+PRCABN,0)),U,8)'=$O(^PRCA(430.3,"AC",112,0))) Q
|
|---|
| 16 | I $P(X,"^",1)+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)=0 D
|
|---|
| 17 | .S PRCA("SDT")=DT,PRCA("STATUS")=$O(^PRCA(430.3,"AC",111,0))
|
|---|
| 18 | .D CHK,UPSTATS^PRCAUT2,EOB
|
|---|
| 19 | S RCREF=$P($G(^PRCA(430,+PRCABN,6)),U,5)
|
|---|
| 20 | I RCREF]"" D
|
|---|
| 21 | .S RCREF=$S(RCREF="DC":"RC",1:RCREF)
|
|---|
| 22 | .S DA=+PRCAEN,DIE="^PRCA(433,",DR="7///^S X=RCREF" D ^DIE
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | EOB ;Another payer bulletin call
|
|---|
| 26 | I ($P($G(^PRCA(433,+PRCAEN,8)),"^",8)),($P($G(^PRCA(430.2,+$P($G(^PRCA(430,+PRCABN,0)),U,2),0)),U,6)="T") D
|
|---|
| 27 | .S PRCAMT("O")=$P($G(^PRCA(430,+PRCABN,0)),"^",3)
|
|---|
| 28 | .S PRCAMT=PRCAMT("O")+PRCAMT
|
|---|
| 29 | .D BULL^IBCNSBL2(PRCABN,PRCAMT("O"),$$PAID^PRCAFN1(+PRCABN))
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | DIE ;Edit AR Transaction
|
|---|
| 33 | N DA,DIE,DR
|
|---|
| 34 | S DR=PRCATEMP,DIE="^PRCA(433,",DA=PRCAEN D ^DIE
|
|---|
| 35 | I '$D(PRCAMT) S PRCAD("DELETE")=1
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | UPFY ;Update 433 FY multiple
|
|---|
| 39 | Q:('$D(PRCAMT))!('$D(PRCAA2))
|
|---|
| 40 | S $P(^PRCA(433,PRCAEN,4,PRCAA2,0),U,5)=PRCAMT
|
|---|
| 41 | S $P(^PRCA(433,PRCAEN,4,PRCAA2,0),U,2)=$P(^PRCA(433,PRCAEN,4,PRCAA2,0),U,2)+PRCAMT,$P(^(0),U,4)=1
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | EN1 ;Get Adj. No. Called from within 433 PRCA FY Input Templates
|
|---|
| 45 | Q:'$D(PRCABN)
|
|---|
| 46 | NEW X
|
|---|
| 47 | F X=0:0 S X=$O(^PRCA(433,"C",PRCABN,X)) Q:'X I $P($G(^PRCA(433,X,1)),"^",4) I $P(^(1),"^",2)=1!($P(^(1),"^",2)=35) S PRCAQNM=$P(^(1),"^",4)+1
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | CHK ;Check for payment transactions or contractual adjustment
|
|---|
| 51 | NEW DIR,X,Y
|
|---|
| 52 | I $D(^PRCA(433,+$G(PRCAEN),8)),$P(^(8),"^",8) D Q
|
|---|
| 53 | .S DIR("B")=$P($G(^PRCA(430.3,+PRCA("STATUS"),0)),"^"),DIR("A")="FINAL STATUS",DIR(0)="SOBX^CA:CANCELLATION;CO:COLLECTED/CLOSED"
|
|---|
| 54 | .S DIR("?",1)="Enter either:"
|
|---|
| 55 | .S DIR("?",2)=" 'CA' for 'CANCELLATION'"
|
|---|
| 56 | .S DIR("?",3)=" 'CO' for 'COLLECTED/CLOSED'"
|
|---|
| 57 | .S DIR("?",4)="These are the only selectable statuses."
|
|---|
| 58 | .S DIR("?")="An up-arrow or <RETURN> will accept the default of 'CANCELLATION' because status is required."
|
|---|
| 59 | .D ^DIR Q:Y="" I Y="CO" S PRCA("STATUS")=$O(^PRCA(430.3,"AC",108,0))
|
|---|
| 60 | F X=0:0 S X=$O(^PRCA(433,"C",PRCABN,X)) Q:'X I ",2,7,20,"[(","_$P($G(^PRCA(430.3,+$P($G(^PRCA(433,X,1)),"^",2),0)),"^",3)_",") S PRCA("STATUS")=$O(^PRCA(430.3,"AC",108,0)) Q
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | UPFYRC ;Update 433
|
|---|
| 64 | Q:('$D(PRCAMT))!('$D(PRCAA2))
|
|---|
| 65 | S $P(^PRCA(433,PRCAEN,4,PRCAA2,0),U,5)=PRCAMT
|
|---|
| 66 | S $P(^PRCA(433,PRCAEN,4,PRCAA2,0),U,2)=$G(PRCAPBAL)+PRCAMT,$P(^(0),U,4)=1
|
|---|
| 67 | Q
|
|---|
