RCRCBL1 ;ALB/CMS - EOB PROCESSING LIST BUILD ; 09/02/97
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
BLDL ; build active list for EOB processing list
; Returns: TMP("RCRCBL", TMP("RCRCBLBX" and VALMCNT
;
K ^TMP("RCRCBL",$J,"B")
;
N CNT,PRCABN,PRCATN,RCCNT,RCY
S (RCCNT,CNT,PRCABN,PRCATN)=0
F S PRCABN=$O(^PRCA(433,"AEOB",PRCABN)) Q:'PRCABN D
.I +$G(RCDIV(0)),'$$DIV^RCRCDIV(PRCABN) Q
.S PRCATN=0 F S PRCATN=$O(^PRCA(433,"AEOB",PRCABN,PRCATN)) Q:'PRCATN D
..S RCCNT=$G(RCCNT)+1
..D SCRN(PRCATN,RCCNT,PRCABN)
..QUIT
;
;Add findings to list sorted by Pt. Name then Activation date
D RESL
;
BLDLQ K RCSTN,RCSI,RCSIF,RCSIL,RCRCI Q
;
SCRN(PRCATN,RCCNT,PRCABN) ;
; add bill to screen list "B" sort (must Re Sequence List after)
; Send: PRCATN,RCCNT,PRCABN
I '$G(^PRCA(433,+$G(PRCATN),0)) G SCRNQ
N PRCA,RCY,RCBN0,RCTN0,RCTN1,X,Y S X=""
S RCTN0=$G(^PRCA(433,+PRCATN,0))
S RCTN1=$G(^PRCA(433,+PRCATN,1))
S RCBN0=$G(^PRCA(430,+PRCABN,0))
D BNVAR^RCRCUTL(PRCABN),DEBT^RCRCUTL(PRCABN)
S RCY=$G(RCCNT),X=$$SETFLD^VALM1(RCY,X,"NUMBER")
S RCY=$P($G(^DPT(+$P(RCBN0,U,7),0),"UNK"),U,1),X=$$SETFLD^VALM1(RCY,X,"PATIENT")
S RCY=$P($P(RCBN0,U,1),"-",2),X=$$SETFLD^VALM1(RCY,X,"BILL")
S RCY=+$P(RCTN0,U,1),X=$$SETFLD^VALM1(RCY,X,"TRAN")
S RCY=$G(PRCA("DEBTNM")),X=$$SETFLD^VALM1(RCY,X,"DEBTOR")
S RCY=$$DATE(+$P(RCTN1,U,9)),X=$$SETFLD^VALM1(RCY,X,"DATE")
S RCY=+$P(RCTN1,U,5),X=$$SETFLD^VALM1($J(+RCY,9,2),X,"AMOUNT")
S ^TMP("RCRCBL",$J,"B",$G(PRCA("DEBTNM"),"UNK"),$P($G(^DPT(+$P(RCBN0,U,7),0),"UNK"),U,1),+PRCATN)=X
SCRNQ Q
;
DATE(X) ; date in external format
N Y S Y="" I X?7N.E S Y=$$FMTE^XLFDT(X,"5ZD")
Q Y
;
RESL ;Build or Rebuild and sequence List with added or subtracted bill
N PRCATN,RCDBT,RCPT,X,Y
I '$D(^TMP("RCRCBL",$J,"B")) G RESLQ
S VALMCNT=0
S RCDBT="" F S RCDBT=$O(^TMP("RCRCBL",$J,"B",RCDBT)) Q:RCDBT="" S RCPT="" F S RCPT=$O(^TMP("RCRCBL",$J,"B",RCDBT,RCPT)) Q:RCPT="" D
.S PRCATN=0 F S PRCATN=$O(^TMP("RCRCBL",$J,"B",RCDBT,RCPT,PRCATN)) Q:'PRCATN D
..S VALMCNT=VALMCNT+1
..S X=^TMP("RCRCBL",$J,"B",RCDBT,RCPT,PRCATN)
..S RCY=VALMCNT,X=$$SETFLD^VALM1(RCY,X,"NUMBER")
..S ^TMP("RCRCBL",$J,VALMCNT,0)=X
..S ^TMP("RCRCBL",$J,"IDX",VALMCNT,VALMCNT)=""
..S ^TMP("RCRCBLX",$J,VALMCNT)=VALMCNT_U_PRCATN
..D FLDCTRL^VALM10(VALMCNT)
RESLQ Q
;RCRCBL1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCBL1 2439 printed Apr 09, 2024@20:44:18 Page 2
RCRCBL1 ;ALB/CMS - EOB PROCESSING LIST BUILD ; 09/02/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 ;
BLDL ; build active list for EOB processing list
+1 ; Returns: TMP("RCRCBL", TMP("RCRCBLBX" and VALMCNT
+2 ;
+3 KILL ^TMP("RCRCBL",$JOB,"B")
+4 ;
+5 NEW CNT,PRCABN,PRCATN,RCCNT,RCY
+6 SET (RCCNT,CNT,PRCABN,PRCATN)=0
+7 FOR
SET PRCABN=$ORDER(^PRCA(433,"AEOB",PRCABN))
if 'PRCABN
QUIT
Begin DoDot:1
+8 IF +$GET(RCDIV(0))
IF '$$DIV^RCRCDIV(PRCABN)
QUIT
+9 SET PRCATN=0
FOR
SET PRCATN=$ORDER(^PRCA(433,"AEOB",PRCABN,PRCATN))
if 'PRCATN
QUIT
Begin DoDot:2
+10 SET RCCNT=$GET(RCCNT)+1
+11 DO SCRN(PRCATN,RCCNT,PRCABN)
+12 QUIT
End DoDot:2
End DoDot:1
+13 ;
+14 ;Add findings to list sorted by Pt. Name then Activation date
+15 DO RESL
+16 ;
BLDLQ KILL RCSTN,RCSI,RCSIF,RCSIL,RCRCI
QUIT
+1 ;
SCRN(PRCATN,RCCNT,PRCABN) ;
+1 ; add bill to screen list "B" sort (must Re Sequence List after)
+2 ; Send: PRCATN,RCCNT,PRCABN
+3 IF '$GET(^PRCA(433,+$GET(PRCATN),0))
GOTO SCRNQ
+4 NEW PRCA,RCY,RCBN0,RCTN0,RCTN1,X,Y
SET X=""
+5 SET RCTN0=$GET(^PRCA(433,+PRCATN,0))
+6 SET RCTN1=$GET(^PRCA(433,+PRCATN,1))
+7 SET RCBN0=$GET(^PRCA(430,+PRCABN,0))
+8 DO BNVAR^RCRCUTL(PRCABN)
DO DEBT^RCRCUTL(PRCABN)
+9 SET RCY=$GET(RCCNT)
SET X=$$SETFLD^VALM1(RCY,X,"NUMBER")
+10 SET RCY=$PIECE($GET(^DPT(+$PIECE(RCBN0,U,7),0),"UNK"),U,1)
SET X=$$SETFLD^VALM1(RCY,X,"PATIENT")
+11 SET RCY=$PIECE($PIECE(RCBN0,U,1),"-",2)
SET X=$$SETFLD^VALM1(RCY,X,"BILL")
+12 SET RCY=+$PIECE(RCTN0,U,1)
SET X=$$SETFLD^VALM1(RCY,X,"TRAN")
+13 SET RCY=$GET(PRCA("DEBTNM"))
SET X=$$SETFLD^VALM1(RCY,X,"DEBTOR")
+14 SET RCY=$$DATE(+$PIECE(RCTN1,U,9))
SET X=$$SETFLD^VALM1(RCY,X,"DATE")
+15 SET RCY=+$PIECE(RCTN1,U,5)
SET X=$$SETFLD^VALM1($JUSTIFY(+RCY,9,2),X,"AMOUNT")
+16 SET ^TMP("RCRCBL",$JOB,"B",$GET(PRCA("DEBTNM"),"UNK"),$PIECE($GET(^DPT(+$PIECE(RCBN0,U,7),0),"UNK"),U,1),+PRCATN)=X
SCRNQ QUIT
+1 ;
DATE(X) ; date in external format
+1 NEW Y
SET Y=""
IF X?7N.E
SET Y=$$FMTE^XLFDT(X,"5ZD")
+2 QUIT Y
+3 ;
RESL ;Build or Rebuild and sequence List with added or subtracted bill
+1 NEW PRCATN,RCDBT,RCPT,X,Y
+2 IF '$DATA(^TMP("RCRCBL",$JOB,"B"))
GOTO RESLQ
+3 SET VALMCNT=0
+4 SET RCDBT=""
FOR
SET RCDBT=$ORDER(^TMP("RCRCBL",$JOB,"B",RCDBT))
if RCDBT=""
QUIT
SET RCPT=""
FOR
SET RCPT=$ORDER(^TMP("RCRCBL",$JOB,"B",RCDBT,RCPT))
if RCPT=""
QUIT
Begin DoDot:1
+5 SET PRCATN=0
FOR
SET PRCATN=$ORDER(^TMP("RCRCBL",$JOB,"B",RCDBT,RCPT,PRCATN))
if 'PRCATN
QUIT
Begin DoDot:2
+6 SET VALMCNT=VALMCNT+1
+7 SET X=^TMP("RCRCBL",$JOB,"B",RCDBT,RCPT,PRCATN)
+8 SET RCY=VALMCNT
SET X=$$SETFLD^VALM1(RCY,X,"NUMBER")
+9 SET ^TMP("RCRCBL",$JOB,VALMCNT,0)=X
+10 SET ^TMP("RCRCBL",$JOB,"IDX",VALMCNT,VALMCNT)=""
+11 SET ^TMP("RCRCBLX",$JOB,VALMCNT)=VALMCNT_U_PRCATN
+12 DO FLDCTRL^VALM10(VALMCNT)
End DoDot:2
End DoDot:1
RESLQ QUIT
+1 ;RCRCBL1
