RCRCAL ;ALB/CMS - RC VIEW BILL LIST ; 27-AUG-1997
V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; -- main entry point for RCRC VIEW BILL LIST
D EN^VALM("RCRC ACTION BILL LIST")
Q
;
HDR ; -- header code
S VALMHDR(1)=""
S VALMHDR(2)="Third Party Active Referrals"
S VALMSG=$S(+$G(VALMCNT)=0:"NO RECORDS FOUND",1:"|r Ref RC|* Cat C/Hold|+ Multi Ins|x Ret by RC|")
Q
;
INIT ; -- init variables and list array
K ^TMP("RCRCAL",$J),^TMP("RCRCALX",$J),^TMP("RCRCALPT",$J)
K ^TMP("IBJTLA",$J),^TMP("IBJTLAX",$J),^TMP("RCRCAC",$J)
S VALMCNT=0 D BLDL^RCRCAL1
;
INITQ Q
;
IB ;Create IB global
N RCL,RCLNM,RCT,RCY,VALMY,RCSELN,VALMCNT S (RCT,RCY)=0
S RCLNM="IBJT ACTIVE LIST"
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S RCSELN=0 F S RCSELN=$O(VALMY(RCSELN)) Q:'RCSELN D
. S DFN=+$P($G(^TMP("RCRCALPT",$J,RCSELN)),U,1)
. I +DFN S RCT=RCT+1 I '$D(RCL("B",DFN)) S RCL(RCT)=DFN,RCL("B",DFN)=""
S RCY=0 F S RCY=$O(RCL(RCY)) Q:'RCY D
. S DFN=RCL(RCY)
. W !,"Getting bill information " D EN^IBJTLA
S VALMBCK="R"
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("RCRCAL",$J),^TMP("RCRCALX",$J),^TMP("RCRCALPT",$J),^TMP("RCRCAC",$J)
K ^TMP("IBJTLA",$J),^TMP("IBJTLAX",$J),^TMP("VALM DATA",$J)
K DFN,PRCABN,RCOUT,VALMCNT,VALMBCK
D CLEAR^VALM1,CLEAN^VALM10
Q
;
OPT ; Entry Point for Third Party Review/Referral
D EN^RCRCALB
I $G(RCOUT) G OPTQ
D EN^RCRCAL
OPTQ K DFN,RCOUT,VALMBCK
Q
;RCRCAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCAL 1565 printed Dec 13, 2024@01:47:28 Page 2
RCRCAL ;ALB/CMS - RC VIEW BILL LIST ; 27-AUG-1997
V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
EN ; -- main entry point for RCRC VIEW BILL LIST
+1 DO EN^VALM("RCRC ACTION BILL LIST")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)=""
+2 SET VALMHDR(2)="Third Party Active Referrals"
+3 SET VALMSG=$SELECT(+$GET(VALMCNT)=0:"NO RECORDS FOUND",1:"|r Ref RC|* Cat C/Hold|+ Multi Ins|x Ret by RC|")
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("RCRCAL",$JOB),^TMP("RCRCALX",$JOB),^TMP("RCRCALPT",$JOB)
+2 KILL ^TMP("IBJTLA",$JOB),^TMP("IBJTLAX",$JOB),^TMP("RCRCAC",$JOB)
+3 SET VALMCNT=0
DO BLDL^RCRCAL1
+4 ;
INITQ QUIT
+1 ;
IB ;Create IB global
+1 NEW RCL,RCLNM,RCT,RCY,VALMY,RCSELN,VALMCNT
SET (RCT,RCY)=0
+2 SET RCLNM="IBJT ACTIVE LIST"
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET RCSELN=0
FOR
SET RCSELN=$ORDER(VALMY(RCSELN))
if 'RCSELN
QUIT
Begin DoDot:1
+5 SET DFN=+$PIECE($GET(^TMP("RCRCALPT",$JOB,RCSELN)),U,1)
+6 IF +DFN
SET RCT=RCT+1
IF '$DATA(RCL("B",DFN))
SET RCL(RCT)=DFN
SET RCL("B",DFN)=""
End DoDot:1
+7 SET RCY=0
FOR
SET RCY=$ORDER(RCL(RCY))
if 'RCY
QUIT
Begin DoDot:1
+8 SET DFN=RCL(RCY)
+9 WRITE !,"Getting bill information "
DO EN^IBJTLA
End DoDot:1
+10 SET VALMBCK="R"
+11 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("RCRCAL",$JOB),^TMP("RCRCALX",$JOB),^TMP("RCRCALPT",$JOB),^TMP("RCRCAC",$JOB)
+2 KILL ^TMP("IBJTLA",$JOB),^TMP("IBJTLAX",$JOB),^TMP("VALM DATA",$JOB)
+3 KILL DFN,PRCABN,RCOUT,VALMCNT,VALMBCK
+4 DO CLEAR^VALM1
DO CLEAN^VALM10
+5 QUIT
+6 ;
OPT ; Entry Point for Third Party Review/Referral
+1 DO EN^RCRCALB
+2 IF $GET(RCOUT)
GOTO OPTQ
+3 DO EN^RCRCAL
OPTQ KILL DFN,RCOUT,VALMBCK
+1 QUIT
+2 ;RCRCAL