- 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 Feb 18, 2025@23:36:12 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 ;