- 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 Feb 18, 2025@23:13:50 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