RCRCVCK ;ALB/CMS - TP POSSIBLE REFERRAL LIST CHECK ; 09/02/97
V ;;4.5;Accounts Receivable;**63,122,189**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
EN ;Entry point from protocol
N PRCABN,RCA,RCMSG,RCOK,RCY S RCY=0,RCA=""
D FULL^VALM1
I '$O(^TMP("RCRCVL",$J,"SEL",RCY)) W !!,"NOTHING TO VALIDATE!",!,"No selected items from list." G ENQ
W !!,"Checking all bill(s) on highlighted Selection List "
F S RCY=$O(^TMP("RCRCVL",$J,"SEL",RCY)) Q:'RCY D
.S PRCABN=$P($G(^TMP("RCRCVLX",$J,RCY)),U,2)
.I 'PRCABN Q
.S RCMSG=""
.D CHK(PRCABN,.RCMSG,0)
.I RCMSG]"" S RCA(PRCABN,RCY)=RCMSG
.W "."
;
I '$O(RCA(0)) W !,"Everything is Okay!" G ENQ
D CHKD
ENQ D PAUSE^VALM1 S VALMBCK="R"
Q
;
RCINFO(PRCABN) ; get new info for *189 to refer bills
N DIE,DA,DR
W !,"Bill No.: ",$P($G(^PRCA(430,PRCABN,0)),"^")
S DIE="^PRCA(430,",DA=PRCABN,DR="[PRCAC RC INFO]" D ^DIE
S PRCA("REF REASON")=$P($G(^PRCA(430,PRCABN,6)),"^",22,23)
I PRCA("REF REASON")'["^" S PRCA("REF REASON")=PRCA("REF REASON")_"^"
Q
;
CHK(PRCABN,COM,RCS) ;Validate Bill for Electronic Referral
;Return: COM Comments if didn't pass
;Return: RCCAT(,DFN,PRCA(,VA(,VADM(,VAPD( if transmitting
N I,RCY,X,Y
;if calling from RCRCXM1 do not new variables
I 'RCS N DFN,PRCA,RCCAT,VA,VADM,VAPA
D RCCAT^RCRCUTL(.RCCAT)
D BNVAR^RCRCUTL(PRCABN)
I '$G(PRCABN) S COM="Not a valid Bill Number." G CHKQ
I '$G(PRCA("CAT")) S COM="Bill Category not entered." G CHKQ
I +PRCA("STATUS")'=16 S COM="Bill Status is not Active." G CHKQ
D DEBT^RCRCUTL(PRCABN)
I $G(PRCA("DEBTNM"))="" S COM="No Debtor Name." G CHKQ
I "ZZzzZ-z-"[$E(PRCA("DEBTNM"),1,2) S COM="Debtor Name starts with "_$E(PRCA("DEBTNM"),1,2) G CHKQ
S DFN=+$P(^PRCA(430,PRCABN,0),U,7)
I 'DFN S COM="No Patient Information." G CHKQ
D DEM^VADPT,ADD^VADPT
I "ZZzzZ-z-"[$E(VADM(1),1,2) S COM="Patient name starts with "_$E(VADM(1),1,2) G CHKQ
I $E(VADM(2),1,5)="00000" S COM="Test Patient." G CHKQ
S RCY=$$BILL^RCJIBFN2(PRCABN)
I '$P(RCY,U,3) S COM="No Current Balance." G CHKQ
I $G(^DGCR(399,PRCABN,0))="" S COM="No Bill Claim Information." G CHKQ
I 'RCS,$G(RCCAT(+PRCA("CAT")))'=1 S COM=$P(PRCA("CAT"),U,2)_" bills can be referred, but not electronically."
D RCINFO(PRCABN) I 'PRCA("REF REASON") S COM="RC Referal Reason Code is REQUIRED" G CHKQ
I +PRCA("REF REASON")=5,'$L($P(PRCA("REF REASON"),"^",2)) S COM="Referral Comments is REQUIRED for RC Reason Code 5" G CHKQ
S COM=""
CHKQ I COM]"" S COM=$G(PRCA("BNAME"))_" - "_COM
Q
;
CHKD ;Display invalid bills and message from RCA array
;Ask user what they want to do with bad referral
N PRCABN,RCY
S PRCABN=0 F S PRCABN=$O(RCA(PRCABN)) Q:('PRCABN)!($G(RCOUT)) D
.S RCY=0 F S RCY=$O(RCA(PRCABN,RCY)) Q:('RCY)!($G(RCOUT)) D
..W !!!,"Item ",RCY,". ",RCA(PRCABN,RCY)
..D UNSEL^RCRCVLE(RCY)
CHKDQ Q
;RCRCVCK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCVCK 2912 printed Dec 13, 2024@01:47:53 Page 2
RCRCVCK ;ALB/CMS - TP POSSIBLE REFERRAL LIST CHECK ; 09/02/97
V ;;4.5;Accounts Receivable;**63,122,189**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 QUIT
EN ;Entry point from protocol
+1 NEW PRCABN,RCA,RCMSG,RCOK,RCY
SET RCY=0
SET RCA=""
+2 DO FULL^VALM1
+3 IF '$ORDER(^TMP("RCRCVL",$JOB,"SEL",RCY))
WRITE !!,"NOTHING TO VALIDATE!",!,"No selected items from list."
GOTO ENQ
+4 WRITE !!,"Checking all bill(s) on highlighted Selection List "
+5 FOR
SET RCY=$ORDER(^TMP("RCRCVL",$JOB,"SEL",RCY))
if 'RCY
QUIT
Begin DoDot:1
+6 SET PRCABN=$PIECE($GET(^TMP("RCRCVLX",$JOB,RCY)),U,2)
+7 IF 'PRCABN
QUIT
+8 SET RCMSG=""
+9 DO CHK(PRCABN,.RCMSG,0)
+10 IF RCMSG]""
SET RCA(PRCABN,RCY)=RCMSG
+11 WRITE "."
End DoDot:1
+12 ;
+13 IF '$ORDER(RCA(0))
WRITE !,"Everything is Okay!"
GOTO ENQ
+14 DO CHKD
ENQ DO PAUSE^VALM1
SET VALMBCK="R"
+1 QUIT
+2 ;
RCINFO(PRCABN) ; get new info for *189 to refer bills
+1 NEW DIE,DA,DR
+2 WRITE !,"Bill No.: ",$PIECE($GET(^PRCA(430,PRCABN,0)),"^")
+3 SET DIE="^PRCA(430,"
SET DA=PRCABN
SET DR="[PRCAC RC INFO]"
DO ^DIE
+4 SET PRCA("REF REASON")=$PIECE($GET(^PRCA(430,PRCABN,6)),"^",22,23)
+5 IF PRCA("REF REASON")'["^"
SET PRCA("REF REASON")=PRCA("REF REASON")_"^"
+6 QUIT
+7 ;
CHK(PRCABN,COM,RCS) ;Validate Bill for Electronic Referral
+1 ;Return: COM Comments if didn't pass
+2 ;Return: RCCAT(,DFN,PRCA(,VA(,VADM(,VAPD( if transmitting
+3 NEW I,RCY,X,Y
+4 ;if calling from RCRCXM1 do not new variables
+5 IF 'RCS
NEW DFN,PRCA,RCCAT,VA,VADM,VAPA
+6 DO RCCAT^RCRCUTL(.RCCAT)
+7 DO BNVAR^RCRCUTL(PRCABN)
+8 IF '$GET(PRCABN)
SET COM="Not a valid Bill Number."
GOTO CHKQ
+9 IF '$GET(PRCA("CAT"))
SET COM="Bill Category not entered."
GOTO CHKQ
+10 IF +PRCA("STATUS")'=16
SET COM="Bill Status is not Active."
GOTO CHKQ
+11 DO DEBT^RCRCUTL(PRCABN)
+12 IF $GET(PRCA("DEBTNM"))=""
SET COM="No Debtor Name."
GOTO CHKQ
+13 IF "ZZzzZ-z-"[$EXTRACT(PRCA("DEBTNM"),1,2)
SET COM="Debtor Name starts with "_$EXTRACT(PRCA("DEBTNM"),1,2)
GOTO CHKQ
+14 SET DFN=+$PIECE(^PRCA(430,PRCABN,0),U,7)
+15 IF 'DFN
SET COM="No Patient Information."
GOTO CHKQ
+16 DO DEM^VADPT
DO ADD^VADPT
+17 IF "ZZzzZ-z-"[$EXTRACT(VADM(1),1,2)
SET COM="Patient name starts with "_$EXTRACT(VADM(1),1,2)
GOTO CHKQ
+18 IF $EXTRACT(VADM(2),1,5)="00000"
SET COM="Test Patient."
GOTO CHKQ
+19 SET RCY=$$BILL^RCJIBFN2(PRCABN)
+20 IF '$PIECE(RCY,U,3)
SET COM="No Current Balance."
GOTO CHKQ
+21 IF $GET(^DGCR(399,PRCABN,0))=""
SET COM="No Bill Claim Information."
GOTO CHKQ
+22 IF 'RCS
IF $GET(RCCAT(+PRCA("CAT")))'=1
SET COM=$PIECE(PRCA("CAT"),U,2)_" bills can be referred, but not electronically."
+23 DO RCINFO(PRCABN)
IF 'PRCA("REF REASON")
SET COM="RC Referal Reason Code is REQUIRED"
GOTO CHKQ
+24 IF +PRCA("REF REASON")=5
IF '$LENGTH($PIECE(PRCA("REF REASON"),"^",2))
SET COM="Referral Comments is REQUIRED for RC Reason Code 5"
GOTO CHKQ
+25 SET COM=""
CHKQ IF COM]""
SET COM=$GET(PRCA("BNAME"))_" - "_COM
+1 QUIT
+2 ;
CHKD ;Display invalid bills and message from RCA array
+1 ;Ask user what they want to do with bad referral
+2 NEW PRCABN,RCY
+3 SET PRCABN=0
FOR
SET PRCABN=$ORDER(RCA(PRCABN))
if ('PRCABN)!($GET(RCOUT))
QUIT
Begin DoDot:1
+4 SET RCY=0
FOR
SET RCY=$ORDER(RCA(PRCABN,RCY))
if ('RCY)!($GET(RCOUT))
QUIT
Begin DoDot:2
+5 WRITE !!!,"Item ",RCY,". ",RCA(PRCABN,RCY)
+6 DO UNSEL^RCRCVLE(RCY)
End DoDot:2
End DoDot:1
CHKDQ QUIT
+1 ;RCRCVCK
