IBCECSA4 ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;5-AUG-1999
;;2.0;INTEGRATED BILLING;**137,155,320,371,433,516,641**;21-MAR-1994;Build 61
;;Per VA Directive 6402, this routine should not be modified.
;
SMSG ;select message
N IBCOM,IBX,IBDAX,IBA
D SEL(.IBDAX,1)
I $O(IBDAX(""))="" G SMSGQ
S IBDAX=+$O(IBDAX(0)),IBA=$G(IBDAX(IBDAX))
S IBX=$G(^TMP("IBCECSB",$J,$P(IBA,U,3),$P(IBA,U,4),$P(IBA,U,6),$P(IBA,U,2)))
I IBX'="" D
. Q:'$$LOCK^IBCEU0(361,$P(IBA,U,2))
. D EN^VALM("IBCEM CSA MSG")
. D UNLOCK^IBCEU0(361,$P(IBA,U,2))
SMSGQ S VALMBCK="R"
I $G(IBFASTXT) S VALMBCK="Q" K IBDAX
D:$O(IBDAX(0)) BLD^IBCECSA1
Q
;
COB ; COB management link from CSA
N IBA,IBX
;IBX,IBA are killed during cancel execution
D FULL^VALM1
D EN^IBCECOB
I $D(IBFASTXT) K IBFASTXT
S VALMBCK="R"
Q
;
EDI ;History detail display
N IBIFN,IBX,IBA
D FULL^VALM1
S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
D EDI2^IBCECOB2(IBIFN)
S VALMBCK="R"
Q
EOB ;View an EOB
N IBIFN,IBA,IBX
D FULL^VALM1
S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
D EN^VALM("IBCEM VIEW EOB")
Q
;
TPJI ;Third Party joint Inquiry
N IBIFN,IBX,IBA
D FULL^VALM1
S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
D TPJI1^IBCECOB2(IBIFN)
S VALMBCK="R"
Q
;
PBILL ;Print bill - not for resubmit
; IB*320 - allow action for MRA request claims
;N IBIFN,IBX,IBA,IBRESUB
N IBIFN,IBX,IBA,IBRESUB,IB361,IBRESULT ;WCJ;US3380
S IBRESULT=0
D FULL^VALM1
;
;D APPERROR^%ZTER("PBILL^IBCECSA4")
I '$$ERRWARN() G PB1 ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
;
S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(+IBDAX))
I "234"'[$P($G(^DGCR(399,IBIFN,0)),U,13) W !!,"Bill status must be REQUEST MRA, AUTHORIZED or PRNT/TX to print the bill." D PAUSE^VALM1 G PB1
;
; don't update review status for MRA's
I $P($G(^DGCR(399,IBIFN,0)),U,13)=2 S IBRESUB=1
E S IBRESUB=$$RESUB(IBIFN,1,"PX")
I IBRESUB'>0 W !,*7,"This is not a transmittable bill or review not needed" D PAUSE^VALM1 G PB1
I IBRESUB=2 D G PB1
. N IB364
. S IB364=+$P($G(IBDAX(IBDAX)),U,5)
. D PRINT1^IBCEM03(IBIFN,.IBDAX,IB364,,.IBRESULT) ;WCJ;US3380
D PBILL1^IBCECOB2(IBIFN,.IBRESULT) ;WCJ;US3380
;
PB1 ;
I $G(IBRESULT) D
. Q:'+$G(IBDAX) ;WCJ;IB*2.0*641;V13;failsafe - since this was just for a report to track users actions. no use crachiung if it's not there
. S IB361=+$P($G(IBDAX(IBDAX)),U,2) ;WCJ;IB641
. D LOGATMP(IB361,DUZ,$$NOW^XLFDT(),"P") ;IB*2*641 (US3380) - Log an attempt to process a claim that has an error or was rejected.
;
S VALMBCK="R"
Q
;
CANCEL ;Cancel bill
N IBIFN,IB364,IBX,IBA,MRACHK
; IBX,IBA will be killed during execution - need to protect them
D FULL^VALM1
S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(+IBDAX))
; Check for security key
I '$$KCHK^XUSRB("IB AUTHORIZE") D G CANCELQ
. W !!?5,"You don't hold the proper security key to access this function."
. W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
. D PAUSE^VALM1
. Q
D MRACHK I MRACHK G CANCELQ
S IB364=+$P($G(IBDAX(IBDAX)),U,5)
D CANCEL^IBCEM3(.IBDAX,IBIFN,IB364)
CANCELQ S VALMBCK="R"
Q
;
CRD ; enter here if correcting a bill
;IB*2.0*516/TAZ - Added variable IBCNCSA to show the source of the CRD function.
; This will allow the users to CRD a claim in CSA even though a claim has a status
; of REQUEST MRA.
N IBCNCRD,IBCNCSA
S (IBCNCRD,IBCNCSA)=1
CLONE ;'Copy/cancel bill' protocol action
N IBX,IBA,IB364,MRACHK,IBIFN,IBKEY
; IBX,IBA will be killed during execution - need to protect them
D FULL^VALM1
S IBDAX=$O(IBDAX("")),IBIFN=+$P($G(IBDAX(IBDAX)),U)
I IBDAX="" G CLONEQ
; Check for security key
;IB*2.0*516/TAZ - Remove check for IB CLON
;S IBKEY=$S($G(IBCNCRD)=1:"IB AUTHORIZE",1:"IB CLON")
S IBKEY="IB AUTHORIZE"
;I '$$KCHK^XUSRB("IB AUTHORIZE") D G CLONEQ
I '$$KCHK^XUSRB(IBKEY) D G CLONEQ
. ;W !!?5,"You don't hold the proper security key to access this function."
. ;W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
. W !!?5,"You must hold the "_IBKEY_" security key to access this function."
. W !?5,"Please see your manager."
. D PAUSE^VALM1
. Q
D MRACHK I MRACHK G CLONEQ
S IB364=+$P($G(IBDAX(IBDAX)),U,5)
D COPYCLON^IBCECOB2(+$G(IBDAX(IBDAX)),IB364,.IBDAX)
CLONEQ S VALMBCK="R"
Q
;
PRO ; Copy for secondary/tertiary bill
N IBIFNH,IBIFN,IB364,IBX,IBA,Z,IBCBASK,IBCBCOPY,IBCAN
D FULL^VALM1
;IBDAX - array from selection of message
S IBA=$G(IBDAX(+$G(IBDAX)))
G:'IBA PROQ
S IBX=$G(^TMP("IBCECSB",$J,$P(IBA,U,3),$P(IBA,U,4),$P(IBA,U,6),$P(IBA,U,2))),IBIFN=$P(IBA,U)
S IB364=+$P(IBA,U,5)
G:'IBIFN PROQ
;
I $P($G(^DGCR(399,IBIFN,0)),U,13)=2 D G PROQ
. W !!?4,"This bill is in a status of REQUEST MRA."
. I $$CHK^IBCEMU1(IBIFN) W !?4,"MRA EOBs must be processed from the MRA management worklist."
. E W !?4,"There are no MRA EOBs on file."
. D PAUSE^VALM1
. Q
;
D COBCOPY^IBCECOB2(IBIFN,IB364,1,$P(IBA,U,2),"INIT^IBCECSA2")
PROQ S VALMBCK="R"
Q
;
RES ;Resubmit bill by print
;N IBTMP,IB364,IBIFN,IBX,IBA
N IBTMP,IB364,IBIFN,IBX,IBA,IB361 ;WCJ;IB641;US3380
D FULL^VALM1
S (IBTMP,IBDAX)=$O(IBDAX(0)),IBTMP(IBTMP)=IBDAX(IBDAX)
S IBIFN=$P($G(IBDAX(+IBDAX)),U)
S IB364=+$P($G(IBDAX(IBDAX)),U,5)
S IB361=+$P($G(IBDAX(IBDAX)),U,2) ;WCJ;IB641
;D APPERROR^%ZTER("RES^IBCECSA4")
I IBIFN,$$ERRWARN() D ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
. N IBRESULT
. D PRINT1^IBCEM03(IBIFN,.IBDAX,IB364,,.IBRESULT) ;WCJ;IB641;US3380
. D PAUSE^VALM1,INIT^IBCECSA2 ;WCJ;US3380
. I $G(IBRESULT) D LOGATMP(IB361,DUZ,$$NOW^XLFDT(),"PX") ;/IB*2*641 (US3380) - Log an attempt to process a claim that has an error or was rejected.
S IBDAX(IBTMP)=IBTMP(IBTMP)
S VALMBCK="R"
Q
;
EBI ;Edit bill
N IBFLG,IBIFN,IB364,IBX,IBA
K ^TMP($J,"IBBILL")
D FULL^VALM1
S IBDAX=$O(IBDAX(""))
I IBDAX="" G EDITQ
S IBIFN=$P(IBDAX(IBDAX),U)
S IBFLG=1 D I IBFLG S IBDAX="" D PAUSE^VALM1 G EDITQ
. I $P($G(^DGCR(399,IBIFN,0)),U,13)>2 W !,*7,"An authorized bill can not be edited." Q
. I '$D(^XUSEC("IB EDIT",DUZ)) W !,*7,"You are not authorized to edit a bill" Q
. S IBFLG=0
S IBIFN=+$G(IBDAX(IBDAX))
S IB364=+$P($G(IBDAX(IBDAX)),U,5)
D EBILL^IBCEM3(.IBDAX,IBIFN,IB364)
EDITQ S VALMBCK="R"
Q
;
SEL(IBDA,ONE) ; Select entry(s) from list
; IBDA = array returned if selections made
; IBDAX(n)=ien of bill selected (file 399)
; ONE = if set to 1, only one selection can be made at a time
N IB
K IBDA
D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA D
. S IBDA(IBDA)=$P($G(^TMP("IBCECSA",$J,IBDA)),U,2,7)
Q
;
RESUB(IBIFN,TXMT,IBFUNC,IBTBA) ; Function asks if resubmit as resolution to a
; message is the intention
; IBIFN = ien of bill in file 399
; TXMT = flag if = 1, assume it's transmittable, don't have to check
; IBFUNC = code to say where the code is called from
; 'E'=edit/authorize 'P'=print 'PX'= print/not to resubmit 'C'=cancel
; IBTBA = transmit bill array returned to calling routine. Optional
; parameter to be passed by reference.
; IBTBA(364ptr)=""
;
; Returns:
; -1 = ^ or timeout at prompt
; 0 = not a transmittable bill or review not needed
; 1 = don't update the review status (user choice)
; 2 = Yes, update the review status (user choice), or resubmit by print
;
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,STAT
KILL IBTBA
I '$G(TXMT),'$$TXMT^IBCEF4(IBIFN) S Y=0 G RESUB1 ; not transmittable
;
; Check for any messages or EOB's needing review
S STAT=$$STATUS^IBCEF4(IBIFN)
I '$TR(STAT,U) S Y=0 G RESUB1 ; no unreviewed items
I $P(STAT,U,1) S IBTBA($P(STAT,U,1))="" ; 364 ien for 361 data
I $P(STAT,U,2) S IBTBA($P(STAT,U,2))="" ; 364 ien for 361.1 data
;
I IBFUNC'="P" D
. S DIR(0)="YA",DIR("A",1)="",DIR("A",2)="This bill is in need of review due to receipt of a status msg or EOB",DIR("A")="OK to update the review status to 'REVIEW COMPLETE' based on this action?: ",DIR("B")="NO"
. S DIR("?",1)="You have just "_$S(IBFUNC="E":"requested re-transmission of",IBFUNC="C":"cancelled",1:"")_" the bill"
. S DIR("?",2)="You can update the review status of the unreviewed message to ",DIR("?",3)=" 'REVIEW COMPLETE' if you say YES here"
. S DIR("?")="Press ENTER to continue "
. D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S Y=-1 Q
. S Y=Y+1
E D
. W !,"The review status of this message will be updated to 'REVIEW COMPLETE'",!," based on this action"
. S Y=2
;
RESUB1 Q +Y
;
RETXMT ;
;N IB364,IBIFN
N IB364,IBIFN,IB361,IBRES ; WCJ;IB641
D FULL^VALM1
;S IBDAX=$O(IBDAX(0)),IB364=+$P($G(IBDAX(IBDAX)),U,5),IBIFN=+$P($G(IBDAX(IBDAX)),U)
S IBDAX=$O(IBDAX(0)),IB364=+$P($G(IBDAX(IBDAX)),U,5),IBIFN=+$P($G(IBDAX(IBDAX)),U),IB361=+$P($G(IBDAX(IBDAX)),U,2) ; WCJ;IB641
;I 'IB364!('IBIFN) G RETXMTQ
I 'IB364!('IBIFN)!('IB361) G RETXMTQ ; WCJ;IB641
D MRACHK I MRACHK G RETXMTQ
;
;D APPERROR^%ZTER("RETXMT^IBCECSA4")
I '$$ERRWARN() G RETXMTQ ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
;
;D RESUB^IBCE(IB364)
D RESUB^IBCE(IB364,.IBRES) ;WCJ;IB641 added paramter to see if retransmit was successful.
;
; if successful in retransmit - log an attempt to process a claim that has an error or was rejected.
I $G(IBRES) D LOGATMP(IB361,DUZ,$$NOW^XLFDT(),"TX") ;/IB*2*641 (US3380)
RETXMTQ S VALMBCK="R"
Q
;
MRACHK ; Restrict access to process REQUEST MRA claims
S MRACHK=0
; At least one MRA EOB appears on the MRA management worklist
I $P($G(^DGCR(399,IBIFN,0)),U,13)=2,$$MRAWL^IBCEMU2(IBIFN) S MRACHK=1 D D PAUSE^VALM1
. W !,?4,"This bill is in a status of REQUEST MRA and it does appear on"
. W !,?4,"the MRA Management Worklist. Please use the MRA Management Menu"
. W !,?4,"options for all processing related to this bill."
Q
;
ERRWARN() ; Display the warning message when someone is about to Resubmit by Print,
; Retransmit or Print a bill that has an error or was rejected. - IB*2*641
; (US3380).
W !,?4,"You are about to Resubmit by Print, Retransmit or Print a bill"
W !,?4,"that has an error or was rejected without making any changes to"
W !,?4,"the claim. Please check before continuing."
D PAUSE^VALM1
Q Y
;
LOGATMP(IBDA,USER,CURDAT,ACTION) ; Log a new entry in the "ARPN" cross-reference
; for an attempt to Resubmit by Print, Retransmit, or Print a claim after ignoring
; the warning message saying the claim has an error or was rejected.
;
; Input: IBDA is the internal claim number
; USER is User who made attempt
; CURDAT is date of attempt
; ACTION is the attempted action ["P"=Print,"PX"=Resubmit by Print or
; "TX"=Retransmit]).
;
Q:'$D(^IBM(361,IBDA))
Q:$$GET1^DIQ(361,IBDA,.03,"I")="I" ; don't log if info only
N ADDARY,IENS,RETURN
;
; ADD CODE TO LOG AN ENTRY IN ^IBM(361,"ARPN",CURDAT,IBIFN,IBDA)
S IENS="+1,"_IBDA_","
S ADDARY(361.04,IENS,.01)=CURDAT
S ADDARY(361.04,IENS,.02)=USER
S ADDARY(361.04,IENS,.03)=ACTION
D UPDATE^DIE("","ADDARY","","RETURN")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECSA4 11344 printed Apr 09, 2024@21:30:57 Page 2
IBCECSA4 ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;5-AUG-1999
+1 ;;2.0;INTEGRATED BILLING;**137,155,320,371,433,516,641**;21-MAR-1994;Build 61
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
SMSG ;select message
+1 NEW IBCOM,IBX,IBDAX,IBA
+2 DO SEL(.IBDAX,1)
+3 IF $ORDER(IBDAX(""))=""
GOTO SMSGQ
+4 SET IBDAX=+$ORDER(IBDAX(0))
SET IBA=$GET(IBDAX(IBDAX))
+5 SET IBX=$GET(^TMP("IBCECSB",$JOB,$PIECE(IBA,U,3),$PIECE(IBA,U,4),$PIECE(IBA,U,6),$PIECE(IBA,U,2)))
+6 IF IBX'=""
Begin DoDot:1
+7 if '$$LOCK^IBCEU0(361,$PIECE(IBA,U,2))
QUIT
+8 DO EN^VALM("IBCEM CSA MSG")
+9 DO UNLOCK^IBCEU0(361,$PIECE(IBA,U,2))
End DoDot:1
SMSGQ SET VALMBCK="R"
+1 IF $GET(IBFASTXT)
SET VALMBCK="Q"
KILL IBDAX
+2 if $ORDER(IBDAX(0))
DO BLD^IBCECSA1
+3 QUIT
+4 ;
COB ; COB management link from CSA
+1 NEW IBA,IBX
+2 ;IBX,IBA are killed during cancel execution
+3 DO FULL^VALM1
+4 DO EN^IBCECOB
+5 IF $DATA(IBFASTXT)
KILL IBFASTXT
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
EDI ;History detail display
+1 NEW IBIFN,IBX,IBA
+2 DO FULL^VALM1
+3 SET IBDAX=$ORDER(IBDAX(0))
SET IBIFN=+$GET(IBDAX(IBDAX))
+4 DO EDI2^IBCECOB2(IBIFN)
+5 SET VALMBCK="R"
+6 QUIT
EOB ;View an EOB
+1 NEW IBIFN,IBA,IBX
+2 DO FULL^VALM1
+3 SET IBDAX=$ORDER(IBDAX(0))
SET IBIFN=+$GET(IBDAX(IBDAX))
+4 DO EN^VALM("IBCEM VIEW EOB")
+5 QUIT
+6 ;
TPJI ;Third Party joint Inquiry
+1 NEW IBIFN,IBX,IBA
+2 DO FULL^VALM1
+3 SET IBDAX=$ORDER(IBDAX(0))
SET IBIFN=+$GET(IBDAX(IBDAX))
+4 DO TPJI1^IBCECOB2(IBIFN)
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
PBILL ;Print bill - not for resubmit
+1 ; IB*320 - allow action for MRA request claims
+2 ;N IBIFN,IBX,IBA,IBRESUB
+3 ;WCJ;US3380
NEW IBIFN,IBX,IBA,IBRESUB,IB361,IBRESULT
+4 SET IBRESULT=0
+5 DO FULL^VALM1
+6 ;
+7 ;D APPERROR^%ZTER("PBILL^IBCECSA4")
+8 ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
IF '$$ERRWARN()
GOTO PB1
+9 ;
+10 SET IBDAX=$ORDER(IBDAX(0))
SET IBIFN=+$GET(IBDAX(+IBDAX))
+11 IF "234"'[$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)
WRITE !!,"Bill status must be REQUEST MRA, AUTHORIZED or PRNT/TX to print the bill."
DO PAUSE^VALM1
GOTO PB1
+12 ;
+13 ; don't update review status for MRA's
+14 IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)=2
SET IBRESUB=1
+15 IF '$TEST
SET IBRESUB=$$RESUB(IBIFN,1,"PX")
+16 IF IBRESUB'>0
WRITE !,*7,"This is not a transmittable bill or review not needed"
DO PAUSE^VALM1
GOTO PB1
+17 IF IBRESUB=2
Begin DoDot:1
+18 NEW IB364
+19 SET IB364=+$PIECE($GET(IBDAX(IBDAX)),U,5)
+20 ;WCJ;US3380
DO PRINT1^IBCEM03(IBIFN,.IBDAX,IB364,,.IBRESULT)
End DoDot:1
GOTO PB1
+21 ;WCJ;US3380
DO PBILL1^IBCECOB2(IBIFN,.IBRESULT)
+22 ;
PB1 ;
+1 IF $GET(IBRESULT)
Begin DoDot:1
+2 ;WCJ;IB*2.0*641;V13;failsafe - since this was just for a report to track users actions. no use crachiung if it's not there
if '+$GET(IBDAX)
QUIT
+3 ;WCJ;IB641
SET IB361=+$PIECE($GET(IBDAX(IBDAX)),U,2)
+4 ;IB*2*641 (US3380) - Log an attempt to process a claim that has an error or was rejected.
DO LOGATMP(IB361,DUZ,$$NOW^XLFDT(),"P")
End DoDot:1
+5 ;
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
CANCEL ;Cancel bill
+1 NEW IBIFN,IB364,IBX,IBA,MRACHK
+2 ; IBX,IBA will be killed during execution - need to protect them
+3 DO FULL^VALM1
+4 SET IBDAX=$ORDER(IBDAX(0))
SET IBIFN=+$GET(IBDAX(+IBDAX))
+5 ; Check for security key
+6 IF '$$KCHK^XUSRB("IB AUTHORIZE")
Begin DoDot:1
+7 WRITE !!?5,"You don't hold the proper security key to access this function."
+8 WRITE !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
+9 DO PAUSE^VALM1
+10 QUIT
End DoDot:1
GOTO CANCELQ
+11 DO MRACHK
IF MRACHK
GOTO CANCELQ
+12 SET IB364=+$PIECE($GET(IBDAX(IBDAX)),U,5)
+13 DO CANCEL^IBCEM3(.IBDAX,IBIFN,IB364)
CANCELQ SET VALMBCK="R"
+1 QUIT
+2 ;
CRD ; enter here if correcting a bill
+1 ;IB*2.0*516/TAZ - Added variable IBCNCSA to show the source of the CRD function.
+2 ; This will allow the users to CRD a claim in CSA even though a claim has a status
+3 ; of REQUEST MRA.
+4 NEW IBCNCRD,IBCNCSA
+5 SET (IBCNCRD,IBCNCSA)=1
CLONE ;'Copy/cancel bill' protocol action
+1 NEW IBX,IBA,IB364,MRACHK,IBIFN,IBKEY
+2 ; IBX,IBA will be killed during execution - need to protect them
+3 DO FULL^VALM1
+4 SET IBDAX=$ORDER(IBDAX(""))
SET IBIFN=+$PIECE($GET(IBDAX(IBDAX)),U)
+5 IF IBDAX=""
GOTO CLONEQ
+6 ; Check for security key
+7 ;IB*2.0*516/TAZ - Remove check for IB CLON
+8 ;S IBKEY=$S($G(IBCNCRD)=1:"IB AUTHORIZE",1:"IB CLON")
+9 SET IBKEY="IB AUTHORIZE"
+10 ;I '$$KCHK^XUSRB("IB AUTHORIZE") D G CLONEQ
+11 IF '$$KCHK^XUSRB(IBKEY)
Begin DoDot:1
+12 ;W !!?5,"You don't hold the proper security key to access this function."
+13 ;W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
+14 WRITE !!?5,"You must hold the "_IBKEY_" security key to access this function."
+15 WRITE !?5,"Please see your manager."
+16 DO PAUSE^VALM1
+17 QUIT
End DoDot:1
GOTO CLONEQ
+18 DO MRACHK
IF MRACHK
GOTO CLONEQ
+19 SET IB364=+$PIECE($GET(IBDAX(IBDAX)),U,5)
+20 DO COPYCLON^IBCECOB2(+$GET(IBDAX(IBDAX)),IB364,.IBDAX)
CLONEQ SET VALMBCK="R"
+1 QUIT
+2 ;
PRO ; Copy for secondary/tertiary bill
+1 NEW IBIFNH,IBIFN,IB364,IBX,IBA,Z,IBCBASK,IBCBCOPY,IBCAN
+2 DO FULL^VALM1
+3 ;IBDAX - array from selection of message
+4 SET IBA=$GET(IBDAX(+$GET(IBDAX)))
+5 if 'IBA
GOTO PROQ
+6 SET IBX=$GET(^TMP("IBCECSB",$JOB,$PIECE(IBA,U,3),$PIECE(IBA,U,4),$PIECE(IBA,U,6),$PIECE(IBA,U,2)))
SET IBIFN=$PIECE(IBA,U)
+7 SET IB364=+$PIECE(IBA,U,5)
+8 if 'IBIFN
GOTO PROQ
+9 ;
+10 IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)=2
Begin DoDot:1
+11 WRITE !!?4,"This bill is in a status of REQUEST MRA."
+12 IF $$CHK^IBCEMU1(IBIFN)
WRITE !?4,"MRA EOBs must be processed from the MRA management worklist."
+13 IF '$TEST
WRITE !?4,"There are no MRA EOBs on file."
+14 DO PAUSE^VALM1
+15 QUIT
End DoDot:1
GOTO PROQ
+16 ;
+17 DO COBCOPY^IBCECOB2(IBIFN,IB364,1,$PIECE(IBA,U,2),"INIT^IBCECSA2")
PROQ SET VALMBCK="R"
+1 QUIT
+2 ;
RES ;Resubmit bill by print
+1 ;N IBTMP,IB364,IBIFN,IBX,IBA
+2 ;WCJ;IB641;US3380
NEW IBTMP,IB364,IBIFN,IBX,IBA,IB361
+3 DO FULL^VALM1
+4 SET (IBTMP,IBDAX)=$ORDER(IBDAX(0))
SET IBTMP(IBTMP)=IBDAX(IBDAX)
+5 SET IBIFN=$PIECE($GET(IBDAX(+IBDAX)),U)
+6 SET IB364=+$PIECE($GET(IBDAX(IBDAX)),U,5)
+7 ;WCJ;IB641
SET IB361=+$PIECE($GET(IBDAX(IBDAX)),U,2)
+8 ;D APPERROR^%ZTER("RES^IBCECSA4")
+9 ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
IF IBIFN
IF $$ERRWARN()
Begin DoDot:1
+10 NEW IBRESULT
+11 ;WCJ;IB641;US3380
DO PRINT1^IBCEM03(IBIFN,.IBDAX,IB364,,.IBRESULT)
+12 ;WCJ;US3380
DO PAUSE^VALM1
DO INIT^IBCECSA2
+13 ;/IB*2*641 (US3380) - Log an attempt to process a claim that has an error or was rejected.
IF $GET(IBRESULT)
DO LOGATMP(IB361,DUZ,$$NOW^XLFDT(),"PX")
End DoDot:1
+14 SET IBDAX(IBTMP)=IBTMP(IBTMP)
+15 SET VALMBCK="R"
+16 QUIT
+17 ;
EBI ;Edit bill
+1 NEW IBFLG,IBIFN,IB364,IBX,IBA
+2 KILL ^TMP($JOB,"IBBILL")
+3 DO FULL^VALM1
+4 SET IBDAX=$ORDER(IBDAX(""))
+5 IF IBDAX=""
GOTO EDITQ
+6 SET IBIFN=$PIECE(IBDAX(IBDAX),U)
+7 SET IBFLG=1
Begin DoDot:1
+8 IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)>2
WRITE !,*7,"An authorized bill can not be edited."
QUIT
+9 IF '$DATA(^XUSEC("IB EDIT",DUZ))
WRITE !,*7,"You are not authorized to edit a bill"
QUIT
+10 SET IBFLG=0
End DoDot:1
IF IBFLG
SET IBDAX=""
DO PAUSE^VALM1
GOTO EDITQ
+11 SET IBIFN=+$GET(IBDAX(IBDAX))
+12 SET IB364=+$PIECE($GET(IBDAX(IBDAX)),U,5)
+13 DO EBILL^IBCEM3(.IBDAX,IBIFN,IB364)
EDITQ SET VALMBCK="R"
+1 QUIT
+2 ;
SEL(IBDA,ONE) ; Select entry(s) from list
+1 ; IBDA = array returned if selections made
+2 ; IBDAX(n)=ien of bill selected (file 399)
+3 ; ONE = if set to 1, only one selection can be made at a time
+4 NEW IB
+5 KILL IBDA
+6 DO EN^VALM2($GET(XQORNOD(0)),$SELECT('$GET(ONE):"",1:"S"))
+7 SET IBDA=0
FOR
SET IBDA=$ORDER(VALMY(IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+8 SET IBDA(IBDA)=$PIECE($GET(^TMP("IBCECSA",$JOB,IBDA)),U,2,7)
End DoDot:1
+9 QUIT
+10 ;
RESUB(IBIFN,TXMT,IBFUNC,IBTBA) ; Function asks if resubmit as resolution to a
+1 ; message is the intention
+2 ; IBIFN = ien of bill in file 399
+3 ; TXMT = flag if = 1, assume it's transmittable, don't have to check
+4 ; IBFUNC = code to say where the code is called from
+5 ; 'E'=edit/authorize 'P'=print 'PX'= print/not to resubmit 'C'=cancel
+6 ; IBTBA = transmit bill array returned to calling routine. Optional
+7 ; parameter to be passed by reference.
+8 ; IBTBA(364ptr)=""
+9 ;
+10 ; Returns:
+11 ; -1 = ^ or timeout at prompt
+12 ; 0 = not a transmittable bill or review not needed
+13 ; 1 = don't update the review status (user choice)
+14 ; 2 = Yes, update the review status (user choice), or resubmit by print
+15 ;
+16 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,STAT
+17 KILL IBTBA
+18 ; not transmittable
IF '$GET(TXMT)
IF '$$TXMT^IBCEF4(IBIFN)
SET Y=0
GOTO RESUB1
+19 ;
+20 ; Check for any messages or EOB's needing review
+21 SET STAT=$$STATUS^IBCEF4(IBIFN)
+22 ; no unreviewed items
IF '$TRANSLATE(STAT,U)
SET Y=0
GOTO RESUB1
+23 ; 364 ien for 361 data
IF $PIECE(STAT,U,1)
SET IBTBA($PIECE(STAT,U,1))=""
+24 ; 364 ien for 361.1 data
IF $PIECE(STAT,U,2)
SET IBTBA($PIECE(STAT,U,2))=""
+25 ;
+26 IF IBFUNC'="P"
Begin DoDot:1
+27 SET DIR(0)="YA"
SET DIR("A",1)=""
SET DIR("A",2)="This bill is in need of review due to receipt of a status msg or EOB"
SET DIR("A")="OK to update the review status to 'REVIEW COMPLETE' based on this action?: "
SET DIR("B")="NO"
+28 SET DIR("?",1)="You have just "_$SELECT(IBFUNC="E":"requested re-transmission of",IBFUNC="C":"cancelled",1:"")_" the bill"
+29 SET DIR("?",2)="You can update the review status of the unreviewed message to "
SET DIR("?",3)=" 'REVIEW COMPLETE' if you say YES here"
+30 SET DIR("?")="Press ENTER to continue "
+31 DO ^DIR
KILL DIR
+32 IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y=-1
QUIT
+33 SET Y=Y+1
End DoDot:1
+34 IF '$TEST
Begin DoDot:1
+35 WRITE !,"The review status of this message will be updated to 'REVIEW COMPLETE'",!," based on this action"
+36 SET Y=2
End DoDot:1
+37 ;
RESUB1 QUIT +Y
+1 ;
RETXMT ;
+1 ;N IB364,IBIFN
+2 ; WCJ;IB641
NEW IB364,IBIFN,IB361,IBRES
+3 DO FULL^VALM1
+4 ;S IBDAX=$O(IBDAX(0)),IB364=+$P($G(IBDAX(IBDAX)),U,5),IBIFN=+$P($G(IBDAX(IBDAX)),U)
+5 ; WCJ;IB641
SET IBDAX=$ORDER(IBDAX(0))
SET IB364=+$PIECE($GET(IBDAX(IBDAX)),U,5)
SET IBIFN=+$PIECE($GET(IBDAX(IBDAX)),U)
SET IB361=+$PIECE($GET(IBDAX(IBDAX)),U,2)
+6 ;I 'IB364!('IBIFN) G RETXMTQ
+7 ; WCJ;IB641
IF 'IB364!('IBIFN)!('IB361)
GOTO RETXMTQ
+8 DO MRACHK
IF MRACHK
GOTO RETXMTQ
+9 ;
+10 ;D APPERROR^%ZTER("RETXMT^IBCECSA4")
+11 ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
IF '$$ERRWARN()
GOTO RETXMTQ
+12 ;
+13 ;D RESUB^IBCE(IB364)
+14 ;WCJ;IB641 added paramter to see if retransmit was successful.
DO RESUB^IBCE(IB364,.IBRES)
+15 ;
+16 ; if successful in retransmit - log an attempt to process a claim that has an error or was rejected.
+17 ;/IB*2*641 (US3380)
IF $GET(IBRES)
DO LOGATMP(IB361,DUZ,$$NOW^XLFDT(),"TX")
RETXMTQ SET VALMBCK="R"
+1 QUIT
+2 ;
MRACHK ; Restrict access to process REQUEST MRA claims
+1 SET MRACHK=0
+2 ; At least one MRA EOB appears on the MRA management worklist
+3 IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)=2
IF $$MRAWL^IBCEMU2(IBIFN)
SET MRACHK=1
Begin DoDot:1
+4 WRITE !,?4,"This bill is in a status of REQUEST MRA and it does appear on"
+5 WRITE !,?4,"the MRA Management Worklist. Please use the MRA Management Menu"
+6 WRITE !,?4,"options for all processing related to this bill."
End DoDot:1
DO PAUSE^VALM1
+7 QUIT
+8 ;
ERRWARN() ; Display the warning message when someone is about to Resubmit by Print,
+1 ; Retransmit or Print a bill that has an error or was rejected. - IB*2*641
+2 ; (US3380).
+3 WRITE !,?4,"You are about to Resubmit by Print, Retransmit or Print a bill"
+4 WRITE !,?4,"that has an error or was rejected without making any changes to"
+5 WRITE !,?4,"the claim. Please check before continuing."
+6 DO PAUSE^VALM1
+7 QUIT Y
+8 ;
LOGATMP(IBDA,USER,CURDAT,ACTION) ; Log a new entry in the "ARPN" cross-reference
+1 ; for an attempt to Resubmit by Print, Retransmit, or Print a claim after ignoring
+2 ; the warning message saying the claim has an error or was rejected.
+3 ;
+4 ; Input: IBDA is the internal claim number
+5 ; USER is User who made attempt
+6 ; CURDAT is date of attempt
+7 ; ACTION is the attempted action ["P"=Print,"PX"=Resubmit by Print or
+8 ; "TX"=Retransmit]).
+9 ;
+10 if '$DATA(^IBM(361,IBDA))
QUIT
+11 ; don't log if info only
if $$GET1^DIQ(361,IBDA,.03,"I")="I"
QUIT
+12 NEW ADDARY,IENS,RETURN
+13 ;
+14 ; ADD CODE TO LOG AN ENTRY IN ^IBM(361,"ARPN",CURDAT,IBIFN,IBDA)
+15 SET IENS="+1,"_IBDA_","
+16 SET ADDARY(361.04,IENS,.01)=CURDAT
+17 SET ADDARY(361.04,IENS,.02)=USER
+18 SET ADDARY(361.04,IENS,.03)=ACTION
+19 DO UPDATE^DIE("","ADDARY","","RETURN")
+20 QUIT
+21 ;
