RCRCACP ;ALB/CMS - RC THIRD PARTY REFERRAL ACTION CODE LIST ; 06-JUN-00
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
TCD ;view of TRANSACTION CODE list
NEW RCDA,RCY,RC0,X S (VALMCNT,X)=""
K ^TMP("RCRCAC",$J)
S RCDA=0 F S RCDA=$O(^RCT(349.4,RCDA)) Q:'RCDA D
.S RC0=^RCT(349.4,RCDA,0)
.I $P(RC0,U,1)="PP" Q
.S VALMCNT=+$G(VALMCNT)+1
.S RCY=VALMCNT,X=$$SETFLD^VALM1(RCY,X,"NUMBER")
.S RCY=$P(RC0,U,1),X=$$SETFLD^VALM1(RCY,X,"CODE")
.S RCY=$P(RC0,U,2),X=$$SETFLD^VALM1(RCY,X,"NAME")
.S ^TMP("RCRCAC",$J,VALMCNT,0)=X
.S ^TMP("RCRCAC",$J,"IDX",VALMCNT,VALMCNT)=RCDA
.Q
I VALMCNT=0 S VALMSG="NOTHING TO REPORT"
TCDQ Q
;
TRD(D0) ;Display Transaction Profile
N DXS,J,I,PRCAIO,PRCAIO,PRCATYP,X,Y,Z
S PRCAIO=IO,PRCAIO(0)=IO(0)
W @IOF,!,?12,"TRANSACTION PROFILE",!
D ^PRCATR3,ENF^IBOLK
W !!
TRDQ Q
;
EOB ;Process the EOB Codes
N CNT,D,DA,DIC,DIE,DR,PRCA,PRCABN,PRCABN0,PRCAEN,PRCATN,RCCAT,RCCOM,RCCNT,RCOUT,RCSEL,RCXMB,RCY,X,XMZ,Y
N DIR,DIRUT,DIROUT,DTOUT,DUOUT S RCOUT=0
D FULL^VALM1
I '$O(^TMP("RCRCBL",$J,"SEL",0)) W !!,"NO PAYMENT TRANSACTION SELECTED !!",! G EOBQ
I '$O(^PRCA(433,"AEOB",0)) W !!,"ALL TP BILLS ARE PROCESSED !!" G EOBQ
D RCCAT^RCRCUTL(.RCCAT) K DIR
S RCSEL=0 F S RCSEL=$O(^TMP("RCRCBL",$J,"SEL",RCSEL)) Q:('RCSEL)!(RCOUT=1) S RCCNT=$G(^(RCSEL)) D
.S PRCATN=+$P($G(^TMP("RCRCBLX",$J,RCSEL)),U,2),RCCNT=+RCCNT
.S PRCABN=$P($G(^PRCA(433,PRCATN,0)),U,2)
.I '$D(^PRCA(433,"AEOB",PRCABN,PRCATN)) W !!," Item ",RCSEL,". Transaction Number ",PRCATN," is processed.",! D PAUSE^VALM1 Q
.D BNVAR^RCRCUTL(PRCABN)
.D TRD(PRCATN)
.S DA=PRCATN,DIE(0)="AQEZ",DIE="^PRCA(433,",DR="54" D ^DIE
.K DIR W ! S DIR("A")="Ready to process payment information"
.S DIR("?")="Enter 'Yes' to transmit the payment to RC and update the referral amount."
.D ASK K DIR I $G(Y)="^" S RCOUT=1
.I ($G(Y)'=1)!(RCOUT=1) S ^PRCA(433,"AEOB",+PRCABN,+PRCATN)="" Q
.S RCCOM=$P($G(^PRCA(433,PRCATN,5)),U,4)
.I RCCOM]"" S RCCOM="Payment EOB CODE: "_RCCOM D COM^RCRCRT(PRCATN,RCCOM)
.S DA=PRCABN,DIE="^PRCA(430,",DR="66///^S X="_+$G(^PRCA(430,PRCABN,7)) D ^DIE
.K ^PRCA(433,"AEOB",PRCABN,PRCATN)
.D FLDTEXT^VALM10(RCSEL,"DEBTOR","Processed ")
.I $P($G(RCCAT(+$P(^PRCA(430,PRCABN,0),U,2))),U,1)'=1 Q
.S Y=$G(^PRCA(433,PRCATN,1))
.S RCXMB(2,0)=$G(PRCA("BNAME"),"UNK")_U_PRCATN_U_$P($P(Y,U,9),".",1)_U_+$P(Y,U,5)
.S RCXMB(3,0)="EOB^"_$P($G(^PRCA(433,PRCATN,5)),U,4)
.D EOBS
.S RCCOM="Payment information sent to RC in MM# "_$G(XMZ) D COM^RCRCRT(PRCATN,RCCOM)
.Q
EOBQ I $G(RCOUT)=1,$O(^PRCA(433,"AEOB",0)) D
.W !!," NOTICE: All bills pending EOB processing should be processed inorder"
.W !,?9,"to electronically send Partial Payment information to Regional Counsel"
.W !,?9,"and update the bill referral amount. Not processing may cause the"
.W !,?9,"referral amount to be out-of-balance with Regional Counsel.",!
D PAUSE^VALM1 S VALMBCK="R"
Q
;
EOBS ;Send Partial Payment data to RC
N RCBDIV,RCCOM,RCDIV,RCDOM,RCSITE,RCSUB,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,X,Y
I '$O(RCXMB(0)) G EOBSQ
S RCSITE=$$SITE^RCMSITE
D RCDIV^RCRCDIV(.RCDIV)
I $O(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),U,6)
I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
S XMDUZ=DUZ,(RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_" PARTIAL PAYMENT"
S RCWHO=RCDOM,XMY(RCWHO)="",XMY(DUZ)=""
S RCXMB(1,0)="$$RC$PP$$"_RCSITE_"$S.RC RC SERV"
S RCXMB(4,0)="$END$1$"
S XMTEXT="RCXMB(",XMCHAN=1 D ^XMD
S RCCOM="Sent Payment Transaction to RC in MM# "_$G(XMZ)
I $G(XMZ) D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
W !!,?10,RCCOM,!
EOBSQ Q
;
ASK ;Ask Yes or No Caller send DIR("A"),DIR("?")
N DIROUT,DUOUT,DTOUT,DIRUT
S DIR(0)="Y",DIR("B")="Yes" D ^DIR
ASKQ Q
;
REQ ;Transmit a Action Request to RC
N DIR,PRCABN,RCCOM,RCY,VALMCNT,VALMY,X,Y
I '$O(^TMP("RCRCAL",$J,"SEL",0)) W !,"NO BILLS SELECTED!",!,"No selected items from Bill List" G REQQ
D EN^VALM2($G(XQORNOD(0)),"SO") I '$O(VALMY(0)) G REQQ
D FULL^VALM1
S RCCOM=$G(^TMP("RCRCAC",$J,+$O(VALMY(0)),0))
W !!,"You Selected: "_RCCOM
W !!,"This action creates an AR Comment Transaction requesting that a "_RCCOM
W !,"action be applied by Regional Counsel to the bills on the highlighted"
W !,"selection list. You can then edit the Comment Transaction request"
W !,"and transmit the request to RC.",!
;
S RCCOM=^TMP("RCRCAC",$J,"IDX",+RCCOM,+RCCOM),RCCOM=$P($G(^RCT(349.4,+RCCOM,0)),U,1)
S RCCOM="I am requesting that a "_RCCOM_" be applied to this bill."
K DIR S DIR("A")="Okay to Create a Comment Transaction "
S DIR("?")="Enter Yes to create a Comment Transaction or No to exit."
D ASK K DIR I $G(Y)'=1 G REQQ
K ^TMP("RCRCAC",$J,"XM")
S RCY=0 F S RCY=$O(^TMP("RCRCAL",$J,"SEL",RCY)) Q:'RCY D
.S PRCABN=+$P($G(^TMP("RCRCALX",$J,RCY)),U,2),PRCAEN=0
.D CCOM
.Q
I '$O(^TMP("RCRCAC",$J,"XM",0)) G REQQ
K DIR S DIR("A")="Send Request to RC now ",DIR("?")="Enter Yes if to transmit the created Comment entries"
D ASK I $G(Y)=1 D SND
;
REQQ K ^TMP("RCRCAC",$J,"XM")
K DIR D PAUSE^VALM1 S XQORM("B")="Quit",VALMBCK="R"
Q
;
CCOM ;Create Comment Transaction
;Input: PRCABN
N DA,DIC,DIE,DR,D0,PRCA,PRCABN0,PRCAD,PRCAEN,PRCAMT,X,Y
S PRCABN0=$G(^PRCA(430,+$G(PRCABN),0))
I 'PRCABN0 W !,PRCABN_" NOT A VALID AR BILL!",! G CCOMQ
W !!,"Bill No. # "_$P(PRCABN0,U,1)
D SETTR^PRCAUTL,PATTR^PRCAUTL
I '$D(PRCAEN) W "COULD NOT CREATE A TRANSACTION AT THIS TIME!",!,"Try again later." G CCOMQ
I $G(RCCOM)]"" D COM^RCRCRT(PRCAEN,RCCOM)
S DIE="^PRCA(433,",DA=PRCAEN,DR="[PRCA COMMENT]" D ^DIE
S DR="4////^S X=2" D ^DIE
S ^TMP("RCRCAC",$J,"XM",PRCABN,PRCAEN)=""
CCOMQ Q
;
SND ;Send data to RC
N PRCABN,PRCAEN,PRCA,RCXCNT,X,Y,RCSITE,RCDIV,RCDOM,RCBDIV
K ^TMP("RCRCAT",$J,"XM") S RCXCNT=0
S RCSITE=$$SITE^RCMSITE
D RCDIV^RCRCDIV(.RCDIV)
S PRCABN=0 F S PRCABN=$O(^TMP("RCRCAC",$J,"XM",PRCABN)) Q:'PRCABN D
.D BNVAR^RCRCUTL(PRCABN)
.D DEBT^RCRCUTL(PRCABN)
.S PRCAEN=0 F S PRCAEN=$O(^TMP("RCRCAC",$J,"XM",PRCABN,PRCAEN)) Q:'PRCAEN D
..D SET^RCRCAT1
..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")
SNDQ Q
;RCRCACP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCACP 6423 printed Dec 13, 2024@01:47:27 Page 2
RCRCACP ;ALB/CMS - RC THIRD PARTY REFERRAL ACTION CODE LIST ; 06-JUN-00
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
+3 ;
TCD ;view of TRANSACTION CODE list
+1 NEW RCDA,RCY,RC0,X
SET (VALMCNT,X)=""
+2 KILL ^TMP("RCRCAC",$JOB)
+3 SET RCDA=0
FOR
SET RCDA=$ORDER(^RCT(349.4,RCDA))
if 'RCDA
QUIT
Begin DoDot:1
+4 SET RC0=^RCT(349.4,RCDA,0)
+5 IF $PIECE(RC0,U,1)="PP"
QUIT
+6 SET VALMCNT=+$GET(VALMCNT)+1
+7 SET RCY=VALMCNT
SET X=$$SETFLD^VALM1(RCY,X,"NUMBER")
+8 SET RCY=$PIECE(RC0,U,1)
SET X=$$SETFLD^VALM1(RCY,X,"CODE")
+9 SET RCY=$PIECE(RC0,U,2)
SET X=$$SETFLD^VALM1(RCY,X,"NAME")
+10 SET ^TMP("RCRCAC",$JOB,VALMCNT,0)=X
+11 SET ^TMP("RCRCAC",$JOB,"IDX",VALMCNT,VALMCNT)=RCDA
+12 QUIT
End DoDot:1
+13 IF VALMCNT=0
SET VALMSG="NOTHING TO REPORT"
TCDQ QUIT
+1 ;
TRD(D0) ;Display Transaction Profile
+1 NEW DXS,J,I,PRCAIO,PRCAIO,PRCATYP,X,Y,Z
+2 SET PRCAIO=IO
SET PRCAIO(0)=IO(0)
+3 WRITE @IOF,!,?12,"TRANSACTION PROFILE",!
+4 DO ^PRCATR3
DO ENF^IBOLK
+5 WRITE !!
TRDQ QUIT
+1 ;
EOB ;Process the EOB Codes
+1 NEW CNT,D,DA,DIC,DIE,DR,PRCA,PRCABN,PRCABN0,PRCAEN,PRCATN,RCCAT,RCCOM,RCCNT,RCOUT,RCSEL,RCXMB,RCY,X,XMZ,Y
+2 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT
SET RCOUT=0
+3 DO FULL^VALM1
+4 IF '$ORDER(^TMP("RCRCBL",$JOB,"SEL",0))
WRITE !!,"NO PAYMENT TRANSACTION SELECTED !!",!
GOTO EOBQ
+5 IF '$ORDER(^PRCA(433,"AEOB",0))
WRITE !!,"ALL TP BILLS ARE PROCESSED !!"
GOTO EOBQ
+6 DO RCCAT^RCRCUTL(.RCCAT)
KILL DIR
+7 SET RCSEL=0
FOR
SET RCSEL=$ORDER(^TMP("RCRCBL",$JOB,"SEL",RCSEL))
if ('RCSEL)!(RCOUT=1)
QUIT
SET RCCNT=$GET(^(RCSEL))
Begin DoDot:1
+8 SET PRCATN=+$PIECE($GET(^TMP("RCRCBLX",$JOB,RCSEL)),U,2)
SET RCCNT=+RCCNT
+9 SET PRCABN=$PIECE($GET(^PRCA(433,PRCATN,0)),U,2)
+10 IF '$DATA(^PRCA(433,"AEOB",PRCABN,PRCATN))
WRITE !!," Item ",RCSEL,". Transaction Number ",PRCATN," is processed.",!
DO PAUSE^VALM1
QUIT
+11 DO BNVAR^RCRCUTL(PRCABN)
+12 DO TRD(PRCATN)
+13 SET DA=PRCATN
SET DIE(0)="AQEZ"
SET DIE="^PRCA(433,"
SET DR="54"
DO ^DIE
+14 KILL DIR
WRITE !
SET DIR("A")="Ready to process payment information"
+15 SET DIR("?")="Enter 'Yes' to transmit the payment to RC and update the referral amount."
+16 DO ASK
KILL DIR
IF $GET(Y)="^"
SET RCOUT=1
+17 IF ($GET(Y)'=1)!(RCOUT=1)
SET ^PRCA(433,"AEOB",+PRCABN,+PRCATN)=""
QUIT
+18 SET RCCOM=$PIECE($GET(^PRCA(433,PRCATN,5)),U,4)
+19 IF RCCOM]""
SET RCCOM="Payment EOB CODE: "_RCCOM
DO COM^RCRCRT(PRCATN,RCCOM)
+20 SET DA=PRCABN
SET DIE="^PRCA(430,"
SET DR="66///^S X="_+$GET(^PRCA(430,PRCABN,7))
DO ^DIE
+21 KILL ^PRCA(433,"AEOB",PRCABN,PRCATN)
+22 DO FLDTEXT^VALM10(RCSEL,"DEBTOR","Processed ")
+23 IF $PIECE($GET(RCCAT(+$PIECE(^PRCA(430,PRCABN,0),U,2))),U,1)'=1
QUIT
+24 SET Y=$GET(^PRCA(433,PRCATN,1))
+25 SET RCXMB(2,0)=$GET(PRCA("BNAME"),"UNK")_U_PRCATN_U_$PIECE($PIECE(Y,U,9),".",1)_U_+$PIECE(Y,U,5)
+26 SET RCXMB(3,0)="EOB^"_$PIECE($GET(^PRCA(433,PRCATN,5)),U,4)
+27 DO EOBS
+28 SET RCCOM="Payment information sent to RC in MM# "_$GET(XMZ)
DO COM^RCRCRT(PRCATN,RCCOM)
+29 QUIT
End DoDot:1
EOBQ IF $GET(RCOUT)=1
IF $ORDER(^PRCA(433,"AEOB",0))
Begin DoDot:1
+1 WRITE !!," NOTICE: All bills pending EOB processing should be processed inorder"
+2 WRITE !,?9,"to electronically send Partial Payment information to Regional Counsel"
+3 WRITE !,?9,"and update the bill referral amount. Not processing may cause the"
+4 WRITE !,?9,"referral amount to be out-of-balance with Regional Counsel.",!
End DoDot:1
+5 DO PAUSE^VALM1
SET VALMBCK="R"
+6 QUIT
+7 ;
EOBS ;Send Partial Payment data to RC
+1 NEW RCBDIV,RCCOM,RCDIV,RCDOM,RCSITE,RCSUB,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,X,Y
+2 IF '$ORDER(RCXMB(0))
GOTO EOBSQ
+3 SET RCSITE=$$SITE^RCMSITE
+4 DO RCDIV^RCRCDIV(.RCDIV)
+5 IF $ORDER(RCDIV(0))
SET RCBDIV=$$DIV^IBJDF2(PRCABN)
SET X=0
FOR
SET X=$ORDER(RCDIV(X))
if 'X
QUIT
Begin DoDot:1
+6 IF X=+RCBDIV
SET RCDOM=$PIECE(RCDIV(X),U,6)
End DoDot:1
+7 IF $GET(RCDOM)=""
SET RCDOM=$$RCDOM^RCRCUTL
+8 SET XMDUZ=DUZ
SET (RCSUB,XMSUB)="AR/RC - "_$GET(RCSITE,"UNK")_" PARTIAL PAYMENT"
+9 SET RCWHO=RCDOM
SET XMY(RCWHO)=""
SET XMY(DUZ)=""
+10 SET RCXMB(1,0)="$$RC$PP$$"_RCSITE_"$S.RC RC SERV"
+11 SET RCXMB(4,0)="$END$1$"
+12 SET XMTEXT="RCXMB("
SET XMCHAN=1
DO ^XMD
+13 SET RCCOM="Sent Payment Transaction to RC in MM# "_$GET(XMZ)
+14 IF $GET(XMZ)
DO ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
+15 WRITE !!,?10,RCCOM,!
EOBSQ QUIT
+1 ;
ASK ;Ask Yes or No Caller send DIR("A"),DIR("?")
+1 NEW DIROUT,DUOUT,DTOUT,DIRUT
+2 SET DIR(0)="Y"
SET DIR("B")="Yes"
DO ^DIR
ASKQ QUIT
+1 ;
REQ ;Transmit a Action Request to RC
+1 NEW DIR,PRCABN,RCCOM,RCY,VALMCNT,VALMY,X,Y
+2 IF '$ORDER(^TMP("RCRCAL",$JOB,"SEL",0))
WRITE !,"NO BILLS SELECTED!",!,"No selected items from Bill List"
GOTO REQQ
+3 DO EN^VALM2($GET(XQORNOD(0)),"SO")
IF '$ORDER(VALMY(0))
GOTO REQQ
+4 DO FULL^VALM1
+5 SET RCCOM=$GET(^TMP("RCRCAC",$JOB,+$ORDER(VALMY(0)),0))
+6 WRITE !!,"You Selected: "_RCCOM
+7 WRITE !!,"This action creates an AR Comment Transaction requesting that a "_RCCOM
+8 WRITE !,"action be applied by Regional Counsel to the bills on the highlighted"
+9 WRITE !,"selection list. You can then edit the Comment Transaction request"
+10 WRITE !,"and transmit the request to RC.",!
+11 ;
+12 SET RCCOM=^TMP("RCRCAC",$JOB,"IDX",+RCCOM,+RCCOM)
SET RCCOM=$PIECE($GET(^RCT(349.4,+RCCOM,0)),U,1)
+13 SET RCCOM="I am requesting that a "_RCCOM_" be applied to this bill."
+14 KILL DIR
SET DIR("A")="Okay to Create a Comment Transaction "
+15 SET DIR("?")="Enter Yes to create a Comment Transaction or No to exit."
+16 DO ASK
KILL DIR
IF $GET(Y)'=1
GOTO REQQ
+17 KILL ^TMP("RCRCAC",$JOB,"XM")
+18 SET RCY=0
FOR
SET RCY=$ORDER(^TMP("RCRCAL",$JOB,"SEL",RCY))
if 'RCY
QUIT
Begin DoDot:1
+19 SET PRCABN=+$PIECE($GET(^TMP("RCRCALX",$JOB,RCY)),U,2)
SET PRCAEN=0
+20 DO CCOM
+21 QUIT
End DoDot:1
+22 IF '$ORDER(^TMP("RCRCAC",$JOB,"XM",0))
GOTO REQQ
+23 KILL DIR
SET DIR("A")="Send Request to RC now "
SET DIR("?")="Enter Yes if to transmit the created Comment entries"
+24 DO ASK
IF $GET(Y)=1
DO SND
+25 ;
REQQ KILL ^TMP("RCRCAC",$JOB,"XM")
+1 KILL DIR
DO PAUSE^VALM1
SET XQORM("B")="Quit"
SET VALMBCK="R"
+2 QUIT
+3 ;
CCOM ;Create Comment Transaction
+1 ;Input: PRCABN
+2 NEW DA,DIC,DIE,DR,D0,PRCA,PRCABN0,PRCAD,PRCAEN,PRCAMT,X,Y
+3 SET PRCABN0=$GET(^PRCA(430,+$GET(PRCABN),0))
+4 IF 'PRCABN0
WRITE !,PRCABN_" NOT A VALID AR BILL!",!
GOTO CCOMQ
+5 WRITE !!,"Bill No. # "_$PIECE(PRCABN0,U,1)
+6 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
+7 IF '$DATA(PRCAEN)
WRITE "COULD NOT CREATE A TRANSACTION AT THIS TIME!",!,"Try again later."
GOTO CCOMQ
+8 IF $GET(RCCOM)]""
DO COM^RCRCRT(PRCAEN,RCCOM)
+9 SET DIE="^PRCA(433,"
SET DA=PRCAEN
SET DR="[PRCA COMMENT]"
DO ^DIE
+10 SET DR="4////^S X=2"
DO ^DIE
+11 SET ^TMP("RCRCAC",$JOB,"XM",PRCABN,PRCAEN)=""
CCOMQ QUIT
+1 ;
SND ;Send data to RC
+1 NEW PRCABN,PRCAEN,PRCA,RCXCNT,X,Y,RCSITE,RCDIV,RCDOM,RCBDIV
+2 KILL ^TMP("RCRCAT",$JOB,"XM")
SET RCXCNT=0
+3 SET RCSITE=$$SITE^RCMSITE
+4 DO RCDIV^RCRCDIV(.RCDIV)
+5 SET PRCABN=0
FOR
SET PRCABN=$ORDER(^TMP("RCRCAC",$JOB,"XM",PRCABN))
if 'PRCABN
QUIT
Begin DoDot:1
+6 DO BNVAR^RCRCUTL(PRCABN)
+7 DO DEBT^RCRCUTL(PRCABN)
+8 SET PRCAEN=0
FOR
SET PRCAEN=$ORDER(^TMP("RCRCAC",$JOB,"XM",PRCABN,PRCAEN))
if 'PRCAEN
QUIT
Begin DoDot:2
+9 DO SET^RCRCAT1
+10 IF $GET(RCDIV(0))
SET RCBDIV=$$DIV^IBJDF2(PRCABN)
SET X=0
FOR
SET X=$ORDER(RCDIV(X))
if 'X
QUIT
Begin DoDot:3
+11 IF X=+RCBDIV
SET RCDOM=$PIECE(RCDIV(X),"^",6)
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF $GET(RCDOM)=""
SET RCDOM=$$RCDOM^RCRCUTL
+13 DO SEND^RCRCAT
+14 KILL ^TMP("RCRCAT",$JOB,"XM")
SNDQ QUIT
+1 ;RCRCACP
