RCRCVL2 ;ALB/CMS - RC VIEW BILL LIST SORT BUILD ; 09-SEP-97
V ;;4.5;Accounts Receivable;**63,159**;MAR 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
BLDL ; - find data required for the report
N DFN,PRCABN,PRCABN0,RCAGE,RCAMT,RCCNT,RCCUR,RCY
I $O(RCSPT(0)) D BLDPT G BLDLQ Q
S (RCCNT,PRCABN)=0 W !,"Searching Active Bills for match "
F S PRCABN=$O(^PRCA(430,"AC",16,PRCABN)) Q:'PRCABN D GET
BLDLQ K RCSBN,RCCAT,RCCNT,RCSI,RCSIA,RCSIF,RCSPT,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSRC
Q
;
BLDPT ;If pt. selection use E cross-ref
N DFN,PRCABN S (RCCNT,DFN)=0
W !,"Searching TP bills for match "
F S DFN=$O(RCSPT(DFN)) Q:'DFN S PRCABN=0 D
.F S PRCABN=$O(^PRCA(430,"E",DFN,PRCABN)) Q:'PRCABN D GET
Q
;
GET ;
N RCPDIV,RCDIV,RCX
S PRCABN0=$G(^PRCA(430,PRCABN,0))
; - check status must be active
I $P(PRCABN0,U,8)'=16 Q
; - check referral category
S RCCAT="" D RCCAT^RCRCUTL(.RCCAT)
I '$D(RCCAT(+$P(PRCABN0,U,2))) Q
; - check division if necessary
I +$G(RCDIV(0)),'$$DIV^RCRCDIV(PRCABN) Q
; - check the receivable age if necessary
I +$G(RCSAGN)=0,+$G(RCSAGX)=0 G AMT
S RCAGE=$$ACTDT^RCRCUTL(PRCABN) Q:'RCAGE
S RCAGE=$$FMDIFF^XLFDT(DT,RCAGE)
I $G(RCSAGN),RCAGE<RCSAGN Q
I $G(RCSAGX),RCAGE>RCSAGX Q
AMT ; - check the cur bal of bill if necessary
I $G(RCSAMT) S RCAMT=$$BILL^RCJIBFN2(PRCABN) I $P(RCAMT,U,3)<RCSAMT Q
; - exclude receivables referred to Regional Counsel if necessary
I '$G(RCSRC) I $P($G(^PRCA(430,PRCABN,6)),"^",4) Q
; - check debtor insurance carrier
I $D(RCSI),'$$INS Q
S RCCNT=$G(RCCNT)+1 W "."
D SCRN^RCRCVL1(PRCABN)
Q
;
INS() ; Get the Insurance company and check to include
;
N PRCA,RCIN
I $G(RCSIA)="ALL" S Y=1 G INSQ
I $G(RCSIA)="NULL",$P(PRCABN0,U,9)="" S Y=1 G INSQ
I $G(RCSIA)="NULL",+$P(PRCABN0,U,9) S Y=0 G INSQ
I $O(RCSI(0)),$D(RCSI(+$P(PRCABN0,U,9))) S Y=1 G INSQ
I $O(RCSI(0)),'$D(RCSI(+$P(PRCABN0,U,9))) S Y=0 G INSQ
D DEBT^RCRCUTL(PRCABN)
I $G(PRCA("DEBTNM"))="",$G(RCSIF)='"@" S Y=0 G INSQ
I PRCA("DEBTNM")]$G(RCSIL) S Y=0 G INSQ
I $G(RCSIF)="" S Y=1 G INSQ
I $G(RCSIF)]PRCA("DEBTNM") S Y=0 G INSQ
S Y=1
INSQ Q Y
;RCRCVL2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCVL2 2195 printed Dec 13, 2024@01:47:57 Page 2
RCRCVL2 ;ALB/CMS - RC VIEW BILL LIST SORT BUILD ; 09-SEP-97
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
BLDL ; - find data required for the report
+1 NEW DFN,PRCABN,PRCABN0,RCAGE,RCAMT,RCCNT,RCCUR,RCY
+2 IF $ORDER(RCSPT(0))
DO BLDPT
GOTO BLDLQ
QUIT
+3 SET (RCCNT,PRCABN)=0
WRITE !,"Searching Active Bills for match "
+4 FOR
SET PRCABN=$ORDER(^PRCA(430,"AC",16,PRCABN))
if 'PRCABN
QUIT
DO GET
BLDLQ KILL RCSBN,RCCAT,RCCNT,RCSI,RCSIA,RCSIF,RCSPT,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSRC
+1 QUIT
+2 ;
BLDPT ;If pt. selection use E cross-ref
+1 NEW DFN,PRCABN
SET (RCCNT,DFN)=0
+2 WRITE !,"Searching TP bills for match "
+3 FOR
SET DFN=$ORDER(RCSPT(DFN))
if 'DFN
QUIT
SET PRCABN=0
Begin DoDot:1
+4 FOR
SET PRCABN=$ORDER(^PRCA(430,"E",DFN,PRCABN))
if 'PRCABN
QUIT
DO GET
End DoDot:1
+5 QUIT
+6 ;
GET ;
+1 NEW RCPDIV,RCDIV,RCX
+2 SET PRCABN0=$GET(^PRCA(430,PRCABN,0))
+3 ; - check status must be active
+4 IF $PIECE(PRCABN0,U,8)'=16
QUIT
+5 ; - check referral category
+6 SET RCCAT=""
DO RCCAT^RCRCUTL(.RCCAT)
+7 IF '$DATA(RCCAT(+$PIECE(PRCABN0,U,2)))
QUIT
+8 ; - check division if necessary
+9 IF +$GET(RCDIV(0))
IF '$$DIV^RCRCDIV(PRCABN)
QUIT
+10 ; - check the receivable age if necessary
+11 IF +$GET(RCSAGN)=0
IF +$GET(RCSAGX)=0
GOTO AMT
+12 SET RCAGE=$$ACTDT^RCRCUTL(PRCABN)
if 'RCAGE
QUIT
+13 SET RCAGE=$$FMDIFF^XLFDT(DT,RCAGE)
+14 IF $GET(RCSAGN)
IF RCAGE<RCSAGN
QUIT
+15 IF $GET(RCSAGX)
IF RCAGE>RCSAGX
QUIT
AMT ; - check the cur bal of bill if necessary
+1 IF $GET(RCSAMT)
SET RCAMT=$$BILL^RCJIBFN2(PRCABN)
IF $PIECE(RCAMT,U,3)<RCSAMT
QUIT
+2 ; - exclude receivables referred to Regional Counsel if necessary
+3 IF '$GET(RCSRC)
IF $PIECE($GET(^PRCA(430,PRCABN,6)),"^",4)
QUIT
+4 ; - check debtor insurance carrier
+5 IF $DATA(RCSI)
IF '$$INS
QUIT
+6 SET RCCNT=$GET(RCCNT)+1
WRITE "."
+7 DO SCRN^RCRCVL1(PRCABN)
+8 QUIT
+9 ;
INS() ; Get the Insurance company and check to include
+1 ;
+2 NEW PRCA,RCIN
+3 IF $GET(RCSIA)="ALL"
SET Y=1
GOTO INSQ
+4 IF $GET(RCSIA)="NULL"
IF $PIECE(PRCABN0,U,9)=""
SET Y=1
GOTO INSQ
+5 IF $GET(RCSIA)="NULL"
IF +$PIECE(PRCABN0,U,9)
SET Y=0
GOTO INSQ
+6 IF $ORDER(RCSI(0))
IF $DATA(RCSI(+$PIECE(PRCABN0,U,9)))
SET Y=1
GOTO INSQ
+7 IF $ORDER(RCSI(0))
IF '$DATA(RCSI(+$PIECE(PRCABN0,U,9)))
SET Y=0
GOTO INSQ
+8 DO DEBT^RCRCUTL(PRCABN)
+9 IF $GET(PRCA("DEBTNM"))=""
IF $GET(RCSIF)='"@"
SET Y=0
GOTO INSQ
+10 IF PRCA("DEBTNM")]$GET(RCSIL)
SET Y=0
GOTO INSQ
+11 IF $GET(RCSIF)=""
SET Y=1
GOTO INSQ
+12 IF $GET(RCSIF)]PRCA("DEBTNM")
SET Y=0
GOTO INSQ
+13 SET Y=1
INSQ QUIT Y
+1 ;RCRCVL2
