RCRCRT ;ALB/CMS - RC TRANSACTION PROC OVER INTERFACE ;8/27/97 11:01 AM
V ;;4.5;Accounts Receivable;**63,147,168,169,189,159**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
EN ;Enter at top with the Transaction Type from RC Server via Taskman
;Create the AR Transaction or send Transaction/Comment LOG to RC.
;Input: RCSITE,RCBDT,RCEDT,RCJOB,RCXTYP,RCVAR,RCXMY
;Input: XTMP(RCXTYP,RCJOB,
;RCXTYP:
; CL - Comment Log send all Comments to RC
; TR - Send all Transactions to RC
; DA-1 - DA-3 Decrease Adj.,Bill Status Collected/Close,Contractual Adjustment Yes, Tran. Comment
; DA-4 - Decrease Adj.,Bill Status Cancellation,Contractual Adjustment Yes, Tran. Comment
; DA-5 - DA-10 Decrease Adj.,Bill Status Cancellation,Notify IB of Cancelation, Tran. Comment
; TJ-1 - TJ-5 Termination by RC,Bill Status Write-off, Tran. Comment
; RT - Returned by RC/DOJ,Delete Referral Date in 430
;
N PRCABN,PRCABN0,RCAMT,RCCAT,RCBNAM,RCD,RCERR,RCFL,RCL,RCCMSG,RCTR,RCTYP,XMZ
K ^TMP("RCRCAT",$J,"XM") S RCCMSG=""
S RCXMZ=$P($G(^XTMP($G(RCXTYP,"UNK"),+$G(RCXMZ),0)),U,4) I 'RCXMZ G ENQ
S RCL=0 F S RCL=$O(^XTMP(RCXTYP,RCXMZ,RCL)) Q:'RCL S RCD=^(RCL) D
.I RCD["$$RC$" S RCTYP=$P(RCD,"$",4) Q
.I RCD["$END$" Q
.S RCBNAM=$P(RCD,U,1),RCAMT=+$P(RCD,U,2)
.S PRCABN=$O(^PRCA(430,"B",RCBNAM,0))
.I 'PRCABN S RCCMSG="E;Bill "_RCBNAM_" does not exist at this medical center" Q
.S RCD=$$REFST^RCRCUTL(PRCABN)
.I ('RCD)!("RCDCDOJ"'[$P(RCD,U,2)) S RCCMSG="E;Bill "_RCBNAM_" is not currently referred to RC." Q
.I (RCTYP="CL")!(RCTYP="TR") Q
.S PRCABN0=$G(^PRCA(430,PRCABN,0))
.I $P(PRCABN0,U,8)'=16 S RCCMSG="E;Bill "_RCBNAM_" is no longer Active at medical center." Q
.D RCCAT^RCRCUTL(.RCCAT)
.I +$G(RCCAT(+$P(PRCABN0,U,2)))'=1 S RCCMSG="E;Bill "_RCBNAM_" Category is not electronically referred." Q
.I "TJDA"[$E(RCTYP,1,2) D
..I RCAMT'=+$P(RCD,U,3) S RCCMSG="E;Bill "_RCBNAM_" for $"_RCAMT_" does not equal AR Referred Amount of $"_+$P(RCD,U,3)_". AR Site Problem!" Q
..S RCD=+$P($$BILL^RCJIBFN2(PRCABN),U,3)
..I RCAMT'=RCD S RCCMSG="E;Bill "_RCBNAM_" for $"_RCD_" does not equal the AR Current Balance. RC may need to Return Bill!" Q
;
I RCCMSG]"" S XMZ=+RCXMZ D SEND^RCRCSRV G ENQ
;
I (RCTYP="CL")!(RCTYP="TR") D TR G ENQ
;
S RCTR=$S(RCTYP="RT":6,$E(RCTYP,1,2)="DA":35,$E(RCTYP,1,2)="TJ":29,1:0)
I RCTR D TRAN
;
ENQ K ^XTMP(RCXTYP,RCXMZ)
K RCSITE,RCBDT,RCEDT,RCJOB,RCXTYP,RCVAR,RCXMY,RCXMZ
Q
;
REF ;Entry point from Review/Refer Protocol
;Refer to RC (3) or Re-Establish to RC/DOJ (5) send to RC
;Input: PRCABN, RCCOM (Optional)
N DA,DIE,DR,PRCAEN,RCBAL,RCI,RCTYP,RC7,X,Y,RCCOM1
S DA=PRCABN,DIC="^PRCA(430," D LCK^PRCAUPD
S RCCODE="RC"
S RCTYP=$S($P($G(^PRCA(430,PRCABN,6)),U,4):5,1:3)
S RCCOM1=$P($G(^PRCA(430,PRCABN,6)),U,22,23)
S:RCCOM1 RCCOM1=$$EXTERNAL^DILFD(430,68.94,"",$P(RCCOM1,"^"))_$S($L($P(RCCOM1,"^",2)):" - "_$P(RCCOM1,"^",2),1:"")
S RCBAL=0,RC7=$G(^PRCA(430,PRCABN,7))
F RCI=1:1:5 S RCBAL=RCBAL+$P(RC7,U,RCI)
D SETTR^PRCAUTL,PATTR^PRCAUTL I '$D(PRCAEN) G REFQ
S DA=PRCAEN,DIE="^PRCA(433,",DR="[PRCAC RC REFER]" D ^DIE
I $G(RCCOM)]"" D COM(PRCAEN,RCCOM)
S DR=$S(RCTYP=5:"68.2////"_DT_";",1:"")_"64////"_DT_";65////^S X=""RC"";66////"_RCBAL
S DA=PRCABN,DIE="^PRCA(430," D ^DIE
REFQ L -^PRCA(430,PRCABN)
Q
;
COM(PRCAEN,RCCOM,ERR) ;Update AR Transaction Comments
N X,Y
I '$D(^PRCA(433,+$G(PRCAEN),0)) G COMQ
S COM(1,1)=RCCOM
S:$L($G(RCCOM1)) COM(1,2)=RCCOM1
D WP^DIE(433,PRCAEN_",",41,"A","COM(1)","ERR(0)")
COMQ Q
;
INC ;Increase Referred TP Bill called by Protocol
N DA,DIE,DIR,DR,DTOUT,DUOUT,PRCA,PRCABN,PRCAEN,RCBAL,RCBN,RCEN,RCOUT,RCSP,RCY,X,Y
D FULL^VALM1
I '$O(^TMP("RCRCAL",$J,"SEL",0)) W !!,"NO SELECTED ITEMS FROM LIST!" G INCQ
W !! S DIR("A",1)="Increasing bill(s) on highlighted Selection List "
S DIR("A")="Okay to continue ",DIR("?")="Enter Yes to Continue"
D ASK^RCRCACP K DIR I $G(Y)'=1 G INCQ
S RCY=0 F S RCY=$O(^TMP("RCRCAL",$J,"SEL",RCY)) Q:('RCY)!($G(RCOUT)) D
. S PRCABN=+$P($G(^TMP("RCRCALX",$J,RCY)),U,2)
. I '$D(^PRCA(430,PRCABN,0)) Q
. W !!,?5,"Patient",?22,"Bill #",?33,"Cat.",?62,"Orig Amt",?72,"Cur Bal"
. W !,$G(^TMP("RCRCAL",$J,RCY,0))
. ; get the balance before the adjustment
. S RCBAL=+$P($$BILL^RCJIBFN2(PRCABN),U,3)
. ; create increase adjustment
. D ADJBILL^RCBEADJ("INCREASE",PRCABN)
. ; get the balance after the adjustment
. S X=+$P($$BILL^RCJIBFN2(PRCABN),U,3)
. I RCBAL=X W !!,"** Bill not Increased **",! G INCX
. S RCBAL=X,DA=PRCABN,DIE="^PRCA(430,",DR="66///^S X="_RCBAL D ^DIE
. S RCSP="",RCBAL=$J(RCBAL,".",2),$E(RCSP,10-$L($E(RCBAL,1,10)))=" ",RCBAL=RCSP_RCBAL
. D FLDTEXT^VALM10(RCY,"CURAMT",RCBAL)
. I '$G(PRCAEN) S PRCAEN=$O(^PRCA(433,"C",PRCABN,9999999),-1)
. D PF^RCRCAT("I")
INCX . K DIR,PRCA,PRCAEN
. I '$O(^TMP("RCRCAL",$J,"SEL",RCY)) Q
. W !! S DIR("A")="Continue Increasing Selected Bills ",DIR("?")="Enter Yes to Continue to next bill"
. D ASK^RCRCACP K DIR I $G(Y)'=1 S RCOUT=1
;
INCQ K DIR D PAUSE^VALM1 S VALMBCK="R"
Q
;
TR ;Send Transactions or Comment Log to RC for bill
N PRCA,PRCAEN,RCI,RCXCNT,X,Y,RCSITE,RCDOM,RCBDIV,RCDIV S RCXCNT=0
D BNVAR^RCRCUTL(PRCABN)
D DEBT^RCRCUTL(PRCABN)
S RCSITE=$$SITE^RCMSITE
D RCDIV^RCRCDIV(.RCDIV)
S PRCAEN=0 F S PRCAEN=$O(^PRCA(433,"C",PRCABN,PRCAEN)) Q:'PRCAEN D
.I RCTYP="CL",$P($G(^PRCA(433,PRCAEN,1)),U,2)'=45 Q
.D SET^RCRCAT1
;
I '$O(^TMP("RCRCAT",$J,"XM",PRCABN,0)) D
.S ^TMP("RCRCAT",$J,"XM",PRCABN,1,1)="BN1^"_PRCA("BNAME")_U_PRCA("DEBTNM")
.S ^TMP("RCRCAT",$J,"XM",PRCABN,1,2)="TR1^0^0"
.S ^TMP("RCRCAT",$J,"XM",PRCABN,1,3)="COMMENT: No "_$S(RCTYP="CL":"Comment ",1:"")_"Transactions at site for Bill "_PRCA("BNAME")_"."
I $G(RCDIV(0)) S RCBDIV=$$DIV^IBJDF2(PRCABN) S X=0 F S X=$O(RCDIV(X)) Q:'X D
.I X=+RCBDIV S RCDOM=$P(RCDIV(X),"^",6)
I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
D SEND^RCRCAT
K ^TMP("RCRCAT",$J,"XM")
TRQ Q
;
TRAN ;Process Termination, Returned and Decrease Transactions from RC
;Input: PRCABN,PRCABN0,RCTYP,RCBNAM,RCAMT,RCTR=6,29 or 35
;
N DA,DIC,DIE,DR,LN,PRCA,PRCAA2,PRCAEN,PRCAQNM,X,XMCHAN,XMZ,XMY,XMDUZ,XMSUB,XMTEXT,Y
N RCAMT,RCAD,RCCA,RCCC,RCCOM,RCDT,RCERR,RCI,RCIB,RCMF,RCO,RCPB
S DA=PRCABN,DIC="^PRCA(430,",XMCHAN=1 D LCK^PRCAUPD
D SETTR^PRCAUTL,PATTR^PRCAUTL I '$D(PRCAEN) Q
S RCI=$O(^RCT(349.4,"B",RCTYP,0)),RCI=$G(^RCT(349.4,+RCI,0))
S PRCA("STATUS")=$P(RCI,U,3),RCCA=$P(RCI,U,4),RCDT=DT
S RCAMT=0,RCI=$G(^PRCA(430,PRCABN,7))
F X=1:1:5 S RCAMT=RCAMT+$P(RCI,U,X)
S RCPB=$P(RCI,U,1),RCIB=$P(RCI,U,2),RCAD=$P(RCI,U,3),RCMF=$P(RCI,U,4),RCCC=$P(RCI,U,5)
I RCTR=35 S RCAMT=-RCAMT
S DA=PRCAEN,DIE="^PRCA(433,",DR="[PRCAC RC TRAN]" D ^DIE
S RCCOM=RCTYP_" Transaction created electronically by local Regional Counsel Office"
D COM(PRCAEN,RCCOM)
S DA=PRCAEN,DR="7///^S X=""RC""",DIE="^PRCA(433," D ^DIE
;
;If action is not a Returned by RC/DOJ
I RCTR'=6 D
.S RCI=$P($G(^PRCA(430,PRCABN,6)),U,5)
.I RCI="DC" S $P(^PRCA(430,PRCABN,6),U,5)="RC"
.D UPSTATS^PRCAUT2
.S PRCAA2=$G(^PRCA(433,PRCAEN,4,0))
.I $P(PRCAA2,U,4) D
..S PRCAA2=$P(PRCAA2,U,3)
..S $P(^PRCA(433,PRCAEN,4,PRCAA2,0),U,2,5)=RCAMT_"^^1^"_RCAMT
;
;If action is a Decrease
I RCTR=35 D G TRANQ
.S DA=PRCABN,DIE="^PRCA(430,"
.S DR="71///^S X=0;72///^S X=0;73///^S X=0;74///^S X=0;75///^S X=0" D ^DIE
.S PRCAQNM=1 D EN1^PRCADJ
.S DA=PRCAEN,DIE="^PRCA(433,",DR="14////^S X="_+PRCAQNM
.I RCCA S DR=DR_";88////1"
.D ^DIE
.I RCCA=1 D
..S RCO=$P(^PRCA(430,PRCABN,0),U,3),RCAMT=RCO+RCAMT
..D BULL^IBCNSBL2(PRCABN,RCO,$$PAID^PRCAFN1(+PRCABN))
.I '$$ACCK^PRCAACC(PRCABN),'($P($G(^PRCA(433,+PRCAEN,8)),U,8)) D
..D EN^PRCAFBDM(PRCABN,RCAMT,RCTR,RCDT,PRCAEN,.RCERR)
.L -^PRCA(430,PRCABN)
;
;If action is a Returned by RC/DOJ
RT I RCTR=6 D G TRANQ
.S DA=PRCABN,DIE="^PRCA(430,"
.S DR="64///@;65///@;66///@;68.3///^S X="_RCDT D ^DIE
.S DA=PRCAEN,DIE="^PRCA(433,",DR="81///^S X="_RCAMT D ^DIE
.L -^PRCA(430,PRCABN)
.S XMDUZ="ACCOUNTS RECEIVABLE RC SERVER",XMSUB="AR/RC - REFERRED AR BILL RETURNED BY RC"
.S XMY("G.RC RC REFERRALS")=""
.S LN(1)=" Referred TP Bill "_$P(^PRCA(430,PRCABN,0),U,1)_" was returned"
.S LN(2)=" by Regional Counsel. Return MAY be because"
.S LN(3)=" of a reconciliation issue."
.S XMTEXT="LN(" D ^XMD
;
;If action is Termination by RC/DOJ
I RCTR=29 D G TRANQ
.S DA=PRCAEN,DIE="^PRCA(433,",DR="17///9;81///^S X="_RCAMT D ^DIE
.I '$$ACCK^PRCAACC(PRCABN) D FMSDOC^RCWROFF(PRCAEN)
.L -^PRCA(430,PRCABN)
;
TRANQ Q
;RCRCRT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCRT 8689 printed Apr 09, 2024@20:45:55 Page 2
RCRCRT ;ALB/CMS - RC TRANSACTION PROC OVER INTERFACE ;8/27/97 11:01 AM
V ;;4.5;Accounts Receivable;**63,147,168,169,189,159**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
EN ;Enter at top with the Transaction Type from RC Server via Taskman
+1 ;Create the AR Transaction or send Transaction/Comment LOG to RC.
+2 ;Input: RCSITE,RCBDT,RCEDT,RCJOB,RCXTYP,RCVAR,RCXMY
+3 ;Input: XTMP(RCXTYP,RCJOB,
+4 ;RCXTYP:
+5 ; CL - Comment Log send all Comments to RC
+6 ; TR - Send all Transactions to RC
+7 ; DA-1 - DA-3 Decrease Adj.,Bill Status Collected/Close,Contractual Adjustment Yes, Tran. Comment
+8 ; DA-4 - Decrease Adj.,Bill Status Cancellation,Contractual Adjustment Yes, Tran. Comment
+9 ; DA-5 - DA-10 Decrease Adj.,Bill Status Cancellation,Notify IB of Cancelation, Tran. Comment
+10 ; TJ-1 - TJ-5 Termination by RC,Bill Status Write-off, Tran. Comment
+11 ; RT - Returned by RC/DOJ,Delete Referral Date in 430
+12 ;
+13 NEW PRCABN,PRCABN0,RCAMT,RCCAT,RCBNAM,RCD,RCERR,RCFL,RCL,RCCMSG,RCTR,RCTYP,XMZ
+14 KILL ^TMP("RCRCAT",$JOB,"XM")
SET RCCMSG=""
+15 SET RCXMZ=$PIECE($GET(^XTMP($GET(RCXTYP,"UNK"),+$GET(RCXMZ),0)),U,4)
IF 'RCXMZ
GOTO ENQ
+16 SET RCL=0
FOR
SET RCL=$ORDER(^XTMP(RCXTYP,RCXMZ,RCL))
if 'RCL
QUIT
SET RCD=^(RCL)
Begin DoDot:1
+17 IF RCD["$$RC$"
SET RCTYP=$PIECE(RCD,"$",4)
QUIT
+18 IF RCD["$END$"
QUIT
+19 SET RCBNAM=$PIECE(RCD,U,1)
SET RCAMT=+$PIECE(RCD,U,2)
+20 SET PRCABN=$ORDER(^PRCA(430,"B",RCBNAM,0))
+21 IF 'PRCABN
SET RCCMSG="E;Bill "_RCBNAM_" does not exist at this medical center"
QUIT
+22 SET RCD=$$REFST^RCRCUTL(PRCABN)
+23 IF ('RCD)!("RCDCDOJ"'[$PIECE(RCD,U,2))
SET RCCMSG="E;Bill "_RCBNAM_" is not currently referred to RC."
QUIT
+24 IF (RCTYP="CL")!(RCTYP="TR")
QUIT
+25 SET PRCABN0=$GET(^PRCA(430,PRCABN,0))
+26 IF $PIECE(PRCABN0,U,8)'=16
SET RCCMSG="E;Bill "_RCBNAM_" is no longer Active at medical center."
QUIT
+27 DO RCCAT^RCRCUTL(.RCCAT)
+28 IF +$GET(RCCAT(+$PIECE(PRCABN0,U,2)))'=1
SET RCCMSG="E;Bill "_RCBNAM_" Category is not electronically referred."
QUIT
+29 IF "TJDA"[$EXTRACT(RCTYP,1,2)
Begin DoDot:2
+30 IF RCAMT'=+$PIECE(RCD,U,3)
SET RCCMSG="E;Bill "_RCBNAM_" for $"_RCAMT_" does not equal AR Referred Amount of $"_+$PIECE(RCD,U,3)_". AR Site Problem!"
QUIT
+31 SET RCD=+$PIECE($$BILL^RCJIBFN2(PRCABN),U,3)
+32 IF RCAMT'=RCD
SET RCCMSG="E;Bill "_RCBNAM_" for $"_RCD_" does not equal the AR Current Balance. RC may need to Return Bill!"
QUIT
End DoDot:2
End DoDot:1
+33 ;
+34 IF RCCMSG]""
SET XMZ=+RCXMZ
DO SEND^RCRCSRV
GOTO ENQ
+35 ;
+36 IF (RCTYP="CL")!(RCTYP="TR")
DO TR
GOTO ENQ
+37 ;
+38 SET RCTR=$SELECT(RCTYP="RT":6,$EXTRACT(RCTYP,1,2)="DA":35,$EXTRACT(RCTYP,1,2)="TJ":29,1:0)
+39 IF RCTR
DO TRAN
+40 ;
ENQ KILL ^XTMP(RCXTYP,RCXMZ)
+1 KILL RCSITE,RCBDT,RCEDT,RCJOB,RCXTYP,RCVAR,RCXMY,RCXMZ
+2 QUIT
+3 ;
REF ;Entry point from Review/Refer Protocol
+1 ;Refer to RC (3) or Re-Establish to RC/DOJ (5) send to RC
+2 ;Input: PRCABN, RCCOM (Optional)
+3 NEW DA,DIE,DR,PRCAEN,RCBAL,RCI,RCTYP,RC7,X,Y,RCCOM1
+4 SET DA=PRCABN
SET DIC="^PRCA(430,"
DO LCK^PRCAUPD
+5 SET RCCODE="RC"
+6 SET RCTYP=$SELECT($PIECE($GET(^PRCA(430,PRCABN,6)),U,4):5,1:3)
+7 SET RCCOM1=$PIECE($GET(^PRCA(430,PRCABN,6)),U,22,23)
+8 if RCCOM1
SET RCCOM1=$$EXTERNAL^DILFD(430,68.94,"",$PIECE(RCCOM1,"^"))_$SELECT($LENGTH($PIECE(RCCOM1,"^",2)):" - "_$PIECE(RCCOM1,"^",2),1:"")
+9 SET RCBAL=0
SET RC7=$GET(^PRCA(430,PRCABN,7))
+10 FOR RCI=1:1:5
SET RCBAL=RCBAL+$PIECE(RC7,U,RCI)
+11 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
IF '$DATA(PRCAEN)
GOTO REFQ
+12 SET DA=PRCAEN
SET DIE="^PRCA(433,"
SET DR="[PRCAC RC REFER]"
DO ^DIE
+13 IF $GET(RCCOM)]""
DO COM(PRCAEN,RCCOM)
+14 SET DR=$SELECT(RCTYP=5:"68.2////"_DT_";",1:"")_"64////"_DT_";65////^S X=""RC"";66////"_RCBAL
+15 SET DA=PRCABN
SET DIE="^PRCA(430,"
DO ^DIE
REFQ LOCK -^PRCA(430,PRCABN)
+1 QUIT
+2 ;
COM(PRCAEN,RCCOM,ERR) ;Update AR Transaction Comments
+1 NEW X,Y
+2 IF '$DATA(^PRCA(433,+$GET(PRCAEN),0))
GOTO COMQ
+3 SET COM(1,1)=RCCOM
+4 if $LENGTH($GET(RCCOM1))
SET COM(1,2)=RCCOM1
+5 DO WP^DIE(433,PRCAEN_",",41,"A","COM(1)","ERR(0)")
COMQ QUIT
+1 ;
INC ;Increase Referred TP Bill called by Protocol
+1 NEW DA,DIE,DIR,DR,DTOUT,DUOUT,PRCA,PRCABN,PRCAEN,RCBAL,RCBN,RCEN,RCOUT,RCSP,RCY,X,Y
+2 DO FULL^VALM1
+3 IF '$ORDER(^TMP("RCRCAL",$JOB,"SEL",0))
WRITE !!,"NO SELECTED ITEMS FROM LIST!"
GOTO INCQ
+4 WRITE !!
SET DIR("A",1)="Increasing bill(s) on highlighted Selection List "
+5 SET DIR("A")="Okay to continue "
SET DIR("?")="Enter Yes to Continue"
+6 DO ASK^RCRCACP
KILL DIR
IF $GET(Y)'=1
GOTO INCQ
+7 SET RCY=0
FOR
SET RCY=$ORDER(^TMP("RCRCAL",$JOB,"SEL",RCY))
if ('RCY)!($GET(RCOUT))
QUIT
Begin DoDot:1
+8 SET PRCABN=+$PIECE($GET(^TMP("RCRCALX",$JOB,RCY)),U,2)
+9 IF '$DATA(^PRCA(430,PRCABN,0))
QUIT
+10 WRITE !!,?5,"Patient",?22,"Bill #",?33,"Cat.",?62,"Orig Amt",?72,"Cur Bal"
+11 WRITE !,$GET(^TMP("RCRCAL",$JOB,RCY,0))
+12 ; get the balance before the adjustment
+13 SET RCBAL=+$PIECE($$BILL^RCJIBFN2(PRCABN),U,3)
+14 ; create increase adjustment
+15 DO ADJBILL^RCBEADJ("INCREASE",PRCABN)
+16 ; get the balance after the adjustment
+17 SET X=+$PIECE($$BILL^RCJIBFN2(PRCABN),U,3)
+18 IF RCBAL=X
WRITE !!,"** Bill not Increased **",!
GOTO INCX
+19 SET RCBAL=X
SET DA=PRCABN
SET DIE="^PRCA(430,"
SET DR="66///^S X="_RCBAL
DO ^DIE
+20 SET RCSP=""
SET RCBAL=$JUSTIFY(RCBAL,".",2)
SET $EXTRACT(RCSP,10-$LENGTH($EXTRACT(RCBAL,1,10)))=" "
SET RCBAL=RCSP_RCBAL
+21 DO FLDTEXT^VALM10(RCY,"CURAMT",RCBAL)
+22 IF '$GET(PRCAEN)
SET PRCAEN=$ORDER(^PRCA(433,"C",PRCABN,9999999),-1)
+23 DO PF^RCRCAT("I")
INCX KILL DIR,PRCA,PRCAEN
+1 IF '$ORDER(^TMP("RCRCAL",$JOB,"SEL",RCY))
QUIT
+2 WRITE !!
SET DIR("A")="Continue Increasing Selected Bills "
SET DIR("?")="Enter Yes to Continue to next bill"
+3 DO ASK^RCRCACP
KILL DIR
IF $GET(Y)'=1
SET RCOUT=1
End DoDot:1
+4 ;
INCQ KILL DIR
DO PAUSE^VALM1
SET VALMBCK="R"
+1 QUIT
+2 ;
TR ;Send Transactions or Comment Log to RC for bill
+1 NEW PRCA,PRCAEN,RCI,RCXCNT,X,Y,RCSITE,RCDOM,RCBDIV,RCDIV
SET RCXCNT=0
+2 DO BNVAR^RCRCUTL(PRCABN)
+3 DO DEBT^RCRCUTL(PRCABN)
+4 SET RCSITE=$$SITE^RCMSITE
+5 DO RCDIV^RCRCDIV(.RCDIV)
+6 SET PRCAEN=0
FOR
SET PRCAEN=$ORDER(^PRCA(433,"C",PRCABN,PRCAEN))
if 'PRCAEN
QUIT
Begin DoDot:1
+7 IF RCTYP="CL"
IF $PIECE($GET(^PRCA(433,PRCAEN,1)),U,2)'=45
QUIT
+8 DO SET^RCRCAT1
End DoDot:1
+9 ;
+10 IF '$ORDER(^TMP("RCRCAT",$JOB,"XM",PRCABN,0))
Begin DoDot:1
+11 SET ^TMP("RCRCAT",$JOB,"XM",PRCABN,1,1)="BN1^"_PRCA("BNAME")_U_PRCA("DEBTNM")
+12 SET ^TMP("RCRCAT",$JOB,"XM",PRCABN,1,2)="TR1^0^0"
+13 SET ^TMP("RCRCAT",$JOB,"XM",PRCABN,1,3)="COMMENT: No "_$SELECT(RCTYP="CL":"Comment ",1:"")_"Transactions at site for Bill "_PRCA("BNAME")_"."
End DoDot:1
+14 IF $GET(RCDIV(0))
SET RCBDIV=$$DIV^IBJDF2(PRCABN)
SET X=0
FOR
SET X=$ORDER(RCDIV(X))
if 'X
QUIT
Begin DoDot:1
+15 IF X=+RCBDIV
SET RCDOM=$PIECE(RCDIV(X),"^",6)
End DoDot:1
+16 IF $GET(RCDOM)=""
SET RCDOM=$$RCDOM^RCRCUTL
+17 DO SEND^RCRCAT
+18 KILL ^TMP("RCRCAT",$JOB,"XM")
TRQ QUIT
+1 ;
TRAN ;Process Termination, Returned and Decrease Transactions from RC
+1 ;Input: PRCABN,PRCABN0,RCTYP,RCBNAM,RCAMT,RCTR=6,29 or 35
+2 ;
+3 NEW DA,DIC,DIE,DR,LN,PRCA,PRCAA2,PRCAEN,PRCAQNM,X,XMCHAN,XMZ,XMY,XMDUZ,XMSUB,XMTEXT,Y
+4 NEW RCAMT,RCAD,RCCA,RCCC,RCCOM,RCDT,RCERR,RCI,RCIB,RCMF,RCO,RCPB
+5 SET DA=PRCABN
SET DIC="^PRCA(430,"
SET XMCHAN=1
DO LCK^PRCAUPD
+6 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
IF '$DATA(PRCAEN)
QUIT
+7 SET RCI=$ORDER(^RCT(349.4,"B",RCTYP,0))
SET RCI=$GET(^RCT(349.4,+RCI,0))
+8 SET PRCA("STATUS")=$PIECE(RCI,U,3)
SET RCCA=$PIECE(RCI,U,4)
SET RCDT=DT
+9 SET RCAMT=0
SET RCI=$GET(^PRCA(430,PRCABN,7))
+10 FOR X=1:1:5
SET RCAMT=RCAMT+$PIECE(RCI,U,X)
+11 SET RCPB=$PIECE(RCI,U,1)
SET RCIB=$PIECE(RCI,U,2)
SET RCAD=$PIECE(RCI,U,3)
SET RCMF=$PIECE(RCI,U,4)
SET RCCC=$PIECE(RCI,U,5)
+12 IF RCTR=35
SET RCAMT=-RCAMT
+13 SET DA=PRCAEN
SET DIE="^PRCA(433,"
SET DR="[PRCAC RC TRAN]"
DO ^DIE
+14 SET RCCOM=RCTYP_" Transaction created electronically by local Regional Counsel Office"
+15 DO COM(PRCAEN,RCCOM)
+16 SET DA=PRCAEN
SET DR="7///^S X=""RC"""
SET DIE="^PRCA(433,"
DO ^DIE
+17 ;
+18 ;If action is not a Returned by RC/DOJ
+19 IF RCTR'=6
Begin DoDot:1
+20 SET RCI=$PIECE($GET(^PRCA(430,PRCABN,6)),U,5)
+21 IF RCI="DC"
SET $PIECE(^PRCA(430,PRCABN,6),U,5)="RC"
+22 DO UPSTATS^PRCAUT2
+23 SET PRCAA2=$GET(^PRCA(433,PRCAEN,4,0))
+24 IF $PIECE(PRCAA2,U,4)
Begin DoDot:2
+25 SET PRCAA2=$PIECE(PRCAA2,U,3)
+26 SET $PIECE(^PRCA(433,PRCAEN,4,PRCAA2,0),U,2,5)=RCAMT_"^^1^"_RCAMT
End DoDot:2
End DoDot:1
+27 ;
+28 ;If action is a Decrease
+29 IF RCTR=35
Begin DoDot:1
+30 SET DA=PRCABN
SET DIE="^PRCA(430,"
+31 SET DR="71///^S X=0;72///^S X=0;73///^S X=0;74///^S X=0;75///^S X=0"
DO ^DIE
+32 SET PRCAQNM=1
DO EN1^PRCADJ
+33 SET DA=PRCAEN
SET DIE="^PRCA(433,"
SET DR="14////^S X="_+PRCAQNM
+34 IF RCCA
SET DR=DR_";88////1"
+35 DO ^DIE
+36 IF RCCA=1
Begin DoDot:2
+37 SET RCO=$PIECE(^PRCA(430,PRCABN,0),U,3)
SET RCAMT=RCO+RCAMT
+38 DO BULL^IBCNSBL2(PRCABN,RCO,$$PAID^PRCAFN1(+PRCABN))
End DoDot:2
+39 IF '$$ACCK^PRCAACC(PRCABN)
IF '($PIECE($GET(^PRCA(433,+PRCAEN,8)),U,8))
Begin DoDot:2
+40 DO EN^PRCAFBDM(PRCABN,RCAMT,RCTR,RCDT,PRCAEN,.RCERR)
End DoDot:2
+41 LOCK -^PRCA(430,PRCABN)
End DoDot:1
GOTO TRANQ
+42 ;
+43 ;If action is a Returned by RC/DOJ
RT IF RCTR=6
Begin DoDot:1
+1 SET DA=PRCABN
SET DIE="^PRCA(430,"
+2 SET DR="64///@;65///@;66///@;68.3///^S X="_RCDT
DO ^DIE
+3 SET DA=PRCAEN
SET DIE="^PRCA(433,"
SET DR="81///^S X="_RCAMT
DO ^DIE
+4 LOCK -^PRCA(430,PRCABN)
+5 SET XMDUZ="ACCOUNTS RECEIVABLE RC SERVER"
SET XMSUB="AR/RC - REFERRED AR BILL RETURNED BY RC"
+6 SET XMY("G.RC RC REFERRALS")=""
+7 SET LN(1)=" Referred TP Bill "_$PIECE(^PRCA(430,PRCABN,0),U,1)_" was returned"
+8 SET LN(2)=" by Regional Counsel. Return MAY be because"
+9 SET LN(3)=" of a reconciliation issue."
+10 SET XMTEXT="LN("
DO ^XMD
End DoDot:1
GOTO TRANQ
+11 ;
+12 ;If action is Termination by RC/DOJ
+13 IF RCTR=29
Begin DoDot:1
+14 SET DA=PRCAEN
SET DIE="^PRCA(433,"
SET DR="17///9;81///^S X="_RCAMT
DO ^DIE
+15 IF '$$ACCK^PRCAACC(PRCABN)
DO FMSDOC^RCWROFF(PRCAEN)
+16 LOCK -^PRCA(430,PRCABN)
End DoDot:1
GOTO TRANQ
+17 ;
TRANQ QUIT
+1 ;RCRCRT
