Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCECSA4

IBCECSA4.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. SMSG ;select message
  1. N IBCOM,IBX,IBDAX,IBA
  1. D SEL(.IBDAX,1)
  1. I $O(IBDAX(""))="" G SMSGQ
  1. S IBDAX=+$O(IBDAX(0)),IBA=$G(IBDAX(IBDAX))
  1. S IBX=$G(^TMP("IBCECSB",$J,$P(IBA,U,3),$P(IBA,U,4),$P(IBA,U,6),$P(IBA,U,2)))
  1. I IBX'="" D
  1. . Q:'$$LOCK^IBCEU0(361,$P(IBA,U,2))
  1. . D EN^VALM("IBCEM CSA MSG")
  1. . D UNLOCK^IBCEU0(361,$P(IBA,U,2))
  1. SMSGQ S VALMBCK="R"
  1. I $G(IBFASTXT) S VALMBCK="Q" K IBDAX
  1. D:$O(IBDAX(0)) BLD^IBCECSA1
  1. Q
  1. ;
  1. COB ; COB management link from CSA
  1. N IBA,IBX
  1. ;IBX,IBA are killed during cancel execution
  1. D FULL^VALM1
  1. D EN^IBCECOB
  1. I $D(IBFASTXT) K IBFASTXT
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EDI ;History detail display
  1. N IBIFN,IBX,IBA
  1. D FULL^VALM1
  1. S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
  1. D EDI2^IBCECOB2(IBIFN)
  1. S VALMBCK="R"
  1. Q
  1. EOB ;View an EOB
  1. N IBIFN,IBA,IBX
  1. D FULL^VALM1
  1. S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
  1. D EN^VALM("IBCEM VIEW EOB")
  1. Q
  1. ;
  1. TPJI ;Third Party joint Inquiry
  1. N IBIFN,IBX,IBA
  1. D FULL^VALM1
  1. S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
  1. D TPJI1^IBCECOB2(IBIFN)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. PBILL ;Print bill - not for resubmit
  1. ; IB*320 - allow action for MRA request claims
  1. ;N IBIFN,IBX,IBA,IBRESUB
  1. N IBIFN,IBX,IBA,IBRESUB,IB361,IBRESULT ;WCJ;US3380
  1. S IBRESULT=0
  1. D FULL^VALM1
  1. ;
  1. ;D APPERROR^%ZTER("PBILL^IBCECSA4")
  1. I '$$ERRWARN() G PB1 ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
  1. ;
  1. S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(+IBDAX))
  1. 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
  1. ;
  1. ; don't update review status for MRA's
  1. I $P($G(^DGCR(399,IBIFN,0)),U,13)=2 S IBRESUB=1
  1. E S IBRESUB=$$RESUB(IBIFN,1,"PX")
  1. I IBRESUB'>0 W !,*7,"This is not a transmittable bill or review not needed" D PAUSE^VALM1 G PB1
  1. I IBRESUB=2 D G PB1
  1. . N IB364
  1. . S IB364=+$P($G(IBDAX(IBDAX)),U,5)
  1. . D PRINT1^IBCEM03(IBIFN,.IBDAX,IB364,,.IBRESULT) ;WCJ;US3380
  1. D PBILL1^IBCECOB2(IBIFN,.IBRESULT) ;WCJ;US3380
  1. ;
  1. PB1 ;
  1. I $G(IBRESULT) D
  1. . 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
  1. . S IB361=+$P($G(IBDAX(IBDAX)),U,2) ;WCJ;IB641
  1. . 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.
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CANCEL ;Cancel bill
  1. N IBIFN,IB364,IBX,IBA,MRACHK
  1. ; IBX,IBA will be killed during execution - need to protect them
  1. D FULL^VALM1
  1. S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(+IBDAX))
  1. ; Check for security key
  1. I '$$KCHK^XUSRB("IB AUTHORIZE") D G CANCELQ
  1. . W !!?5,"You don't hold the proper security key to access this function."
  1. . W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
  1. . D PAUSE^VALM1
  1. . Q
  1. D MRACHK I MRACHK G CANCELQ
  1. S IB364=+$P($G(IBDAX(IBDAX)),U,5)
  1. D CANCEL^IBCEM3(.IBDAX,IBIFN,IB364)
  1. CANCELQ S VALMBCK="R"
  1. Q
  1. ;
  1. CRD ; enter here if correcting a bill
  1. ;IB*2.0*516/TAZ - Added variable IBCNCSA to show the source of the CRD function.
  1. ; This will allow the users to CRD a claim in CSA even though a claim has a status
  1. ; of REQUEST MRA.
  1. N IBCNCRD,IBCNCSA
  1. S (IBCNCRD,IBCNCSA)=1
  1. CLONE ;'Copy/cancel bill' protocol action
  1. N IBX,IBA,IB364,MRACHK,IBIFN,IBKEY
  1. ; IBX,IBA will be killed during execution - need to protect them
  1. D FULL^VALM1
  1. S IBDAX=$O(IBDAX("")),IBIFN=+$P($G(IBDAX(IBDAX)),U)
  1. I IBDAX="" G CLONEQ
  1. ; Check for security key
  1. ;IB*2.0*516/TAZ - Remove check for IB CLON
  1. ;S IBKEY=$S($G(IBCNCRD)=1:"IB AUTHORIZE",1:"IB CLON")
  1. S IBKEY="IB AUTHORIZE"
  1. ;I '$$KCHK^XUSRB("IB AUTHORIZE") D G CLONEQ
  1. I '$$KCHK^XUSRB(IBKEY) D G CLONEQ
  1. . ;W !!?5,"You don't hold the proper security key to access this function."
  1. . ;W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
  1. . W !!?5,"You must hold the "_IBKEY_" security key to access this function."
  1. . W !?5,"Please see your manager."
  1. . D PAUSE^VALM1
  1. . Q
  1. D MRACHK I MRACHK G CLONEQ
  1. S IB364=+$P($G(IBDAX(IBDAX)),U,5)
  1. D COPYCLON^IBCECOB2(+$G(IBDAX(IBDAX)),IB364,.IBDAX)
  1. CLONEQ S VALMBCK="R"
  1. Q
  1. ;
  1. PRO ; Copy for secondary/tertiary bill
  1. N IBIFNH,IBIFN,IB364,IBX,IBA,Z,IBCBASK,IBCBCOPY,IBCAN
  1. D FULL^VALM1
  1. ;IBDAX - array from selection of message
  1. S IBA=$G(IBDAX(+$G(IBDAX)))
  1. G:'IBA PROQ
  1. 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)
  1. S IB364=+$P(IBA,U,5)
  1. G:'IBIFN PROQ
  1. ;
  1. I $P($G(^DGCR(399,IBIFN,0)),U,13)=2 D G PROQ
  1. . W !!?4,"This bill is in a status of REQUEST MRA."
  1. . I $$CHK^IBCEMU1(IBIFN) W !?4,"MRA EOBs must be processed from the MRA management worklist."
  1. . E W !?4,"There are no MRA EOBs on file."
  1. . D PAUSE^VALM1
  1. . Q
  1. ;
  1. D COBCOPY^IBCECOB2(IBIFN,IB364,1,$P(IBA,U,2),"INIT^IBCECSA2")
  1. PROQ S VALMBCK="R"
  1. Q
  1. ;
  1. RES ;Resubmit bill by print
  1. ;N IBTMP,IB364,IBIFN,IBX,IBA
  1. N IBTMP,IB364,IBIFN,IBX,IBA,IB361 ;WCJ;IB641;US3380
  1. D FULL^VALM1
  1. S (IBTMP,IBDAX)=$O(IBDAX(0)),IBTMP(IBTMP)=IBDAX(IBDAX)
  1. S IBIFN=$P($G(IBDAX(+IBDAX)),U)
  1. S IB364=+$P($G(IBDAX(IBDAX)),U,5)
  1. S IB361=+$P($G(IBDAX(IBDAX)),U,2) ;WCJ;IB641
  1. ;D APPERROR^%ZTER("RES^IBCECSA4")
  1. I IBIFN,$$ERRWARN() D ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
  1. . N IBRESULT
  1. . D PRINT1^IBCEM03(IBIFN,.IBDAX,IB364,,.IBRESULT) ;WCJ;IB641;US3380
  1. . D PAUSE^VALM1,INIT^IBCECSA2 ;WCJ;US3380
  1. . 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.
  1. S IBDAX(IBTMP)=IBTMP(IBTMP)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EBI ;Edit bill
  1. N IBFLG,IBIFN,IB364,IBX,IBA
  1. K ^TMP($J,"IBBILL")
  1. D FULL^VALM1
  1. S IBDAX=$O(IBDAX(""))
  1. I IBDAX="" G EDITQ
  1. S IBIFN=$P(IBDAX(IBDAX),U)
  1. S IBFLG=1 D I IBFLG S IBDAX="" D PAUSE^VALM1 G EDITQ
  1. . I $P($G(^DGCR(399,IBIFN,0)),U,13)>2 W !,*7,"An authorized bill can not be edited." Q
  1. . I '$D(^XUSEC("IB EDIT",DUZ)) W !,*7,"You are not authorized to edit a bill" Q
  1. . S IBFLG=0
  1. S IBIFN=+$G(IBDAX(IBDAX))
  1. S IB364=+$P($G(IBDAX(IBDAX)),U,5)
  1. D EBILL^IBCEM3(.IBDAX,IBIFN,IB364)
  1. EDITQ S VALMBCK="R"
  1. Q
  1. ;
  1. SEL(IBDA,ONE) ; Select entry(s) from list
  1. ; IBDA = array returned if selections made
  1. ; IBDAX(n)=ien of bill selected (file 399)
  1. ; ONE = if set to 1, only one selection can be made at a time
  1. N IB
  1. K IBDA
  1. D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
  1. S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA D
  1. . S IBDA(IBDA)=$P($G(^TMP("IBCECSA",$J,IBDA)),U,2,7)
  1. Q
  1. ;
  1. RESUB(IBIFN,TXMT,IBFUNC,IBTBA) ; Function asks if resubmit as resolution to a
  1. ; message is the intention
  1. ; IBIFN = ien of bill in file 399
  1. ; TXMT = flag if = 1, assume it's transmittable, don't have to check
  1. ; IBFUNC = code to say where the code is called from
  1. ; 'E'=edit/authorize 'P'=print 'PX'= print/not to resubmit 'C'=cancel
  1. ; IBTBA = transmit bill array returned to calling routine. Optional
  1. ; parameter to be passed by reference.
  1. ; IBTBA(364ptr)=""
  1. ;
  1. ; Returns:
  1. ; -1 = ^ or timeout at prompt
  1. ; 0 = not a transmittable bill or review not needed
  1. ; 1 = don't update the review status (user choice)
  1. ; 2 = Yes, update the review status (user choice), or resubmit by print
  1. ;
  1. NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,STAT
  1. KILL IBTBA
  1. I '$G(TXMT),'$$TXMT^IBCEF4(IBIFN) S Y=0 G RESUB1 ; not transmittable
  1. ;
  1. ; Check for any messages or EOB's needing review
  1. S STAT=$$STATUS^IBCEF4(IBIFN)
  1. I '$TR(STAT,U) S Y=0 G RESUB1 ; no unreviewed items
  1. I $P(STAT,U,1) S IBTBA($P(STAT,U,1))="" ; 364 ien for 361 data
  1. I $P(STAT,U,2) S IBTBA($P(STAT,U,2))="" ; 364 ien for 361.1 data
  1. ;
  1. I IBFUNC'="P" D
  1. . 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"
  1. . S DIR("?",1)="You have just "_$S(IBFUNC="E":"requested re-transmission of",IBFUNC="C":"cancelled",1:"")_" the bill"
  1. . S DIR("?",2)="You can update the review status of the unreviewed message to ",DIR("?",3)=" 'REVIEW COMPLETE' if you say YES here"
  1. . S DIR("?")="Press ENTER to continue "
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT) S Y=-1 Q
  1. . S Y=Y+1
  1. E D
  1. . W !,"The review status of this message will be updated to 'REVIEW COMPLETE'",!," based on this action"
  1. . S Y=2
  1. ;
  1. RESUB1 Q +Y
  1. ;
  1. RETXMT ;
  1. ;N IB364,IBIFN
  1. N IB364,IBIFN,IB361,IBRES ; WCJ;IB641
  1. D FULL^VALM1
  1. ;S IBDAX=$O(IBDAX(0)),IB364=+$P($G(IBDAX(IBDAX)),U,5),IBIFN=+$P($G(IBDAX(IBDAX)),U)
  1. 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
  1. ;I 'IB364!('IBIFN) G RETXMTQ
  1. I 'IB364!('IBIFN)!('IB361) G RETXMTQ ; WCJ;IB641
  1. D MRACHK I MRACHK G RETXMTQ
  1. ;
  1. ;D APPERROR^%ZTER("RETXMT^IBCECSA4")
  1. I '$$ERRWARN() G RETXMTQ ;/IB*2*641 - US3380. (Display warning message for a claim that has an Error or has been rejected.
  1. ;
  1. ;D RESUB^IBCE(IB364)
  1. D RESUB^IBCE(IB364,.IBRES) ;WCJ;IB641 added paramter to see if retransmit was successful.
  1. ;
  1. ; if successful in retransmit - log an attempt to process a claim that has an error or was rejected.
  1. I $G(IBRES) D LOGATMP(IB361,DUZ,$$NOW^XLFDT(),"TX") ;/IB*2*641 (US3380)
  1. RETXMTQ S VALMBCK="R"
  1. Q
  1. ;
  1. MRACHK ; Restrict access to process REQUEST MRA claims
  1. S MRACHK=0
  1. ; At least one MRA EOB appears on the MRA management worklist
  1. I $P($G(^DGCR(399,IBIFN,0)),U,13)=2,$$MRAWL^IBCEMU2(IBIFN) S MRACHK=1 D D PAUSE^VALM1
  1. . W !,?4,"This bill is in a status of REQUEST MRA and it does appear on"
  1. . W !,?4,"the MRA Management Worklist. Please use the MRA Management Menu"
  1. . W !,?4,"options for all processing related to this bill."
  1. Q
  1. ;
  1. 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
  1. ; (US3380).
  1. W !,?4,"You are about to Resubmit by Print, Retransmit or Print a bill"
  1. W !,?4,"that has an error or was rejected without making any changes to"
  1. W !,?4,"the claim. Please check before continuing."
  1. D PAUSE^VALM1
  1. Q Y
  1. ;
  1. 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
  1. ; the warning message saying the claim has an error or was rejected.
  1. ;
  1. ; Input: IBDA is the internal claim number
  1. ; USER is User who made attempt
  1. ; CURDAT is date of attempt
  1. ; ACTION is the attempted action ["P"=Print,"PX"=Resubmit by Print or
  1. ; "TX"=Retransmit]).
  1. ;
  1. Q:'$D(^IBM(361,IBDA))
  1. Q:$$GET1^DIQ(361,IBDA,.03,"I")="I" ; don't log if info only
  1. N ADDARY,IENS,RETURN
  1. ;
  1. ; ADD CODE TO LOG AN ENTRY IN ^IBM(361,"ARPN",CURDAT,IBIFN,IBDA)
  1. S IENS="+1,"_IBDA_","
  1. S ADDARY(361.04,IENS,.01)=CURDAT
  1. S ADDARY(361.04,IENS,.02)=USER
  1. S ADDARY(361.04,IENS,.03)=ACTION
  1. D UPDATE^DIE("","ADDARY","","RETURN")
  1. Q
  1. ;