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

IBCEM.m

Go to the documentation of this file.
  1. IBCEM ;ALB/TMP - 837 EDI RETURN MESSAGE PROCESSING ;17-APR-96
  1. ;;2.0;INTEGRATED BILLING;**137,191,155,371,547**;21-MAR-94;Build 119
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. UPD ; Update messages manually from messages list
  1. N IBDA,IBOK,IBTDA,ZTSK,IBTSK,IBTYP,IBU,IBU1,IB0
  1. D FULL^VALM1
  1. D SEL(.IBDA,1)
  1. S IBDA=$O(IBDA(""))
  1. I IBDA="" G UPDQ
  1. S IBTDA=+IBDA(IBDA)
  1. I '$$LOCK(IBTDA) G UPDQ
  1. S IB0=$G(^IBA(364.2,IBTDA,0))
  1. ;
  1. I IB0="" D G UPDQ
  1. . W !,*7,"Message ",IBDA," is no longer in return message file" S IBOK=""
  1. . D PAUSE^VALM1
  1. I $P(IB0,U,11) S IBOK=1 D G:'IBOK UPDQ
  1. . N ZTSK
  1. . S ZTSK=$P(IB0,U,11) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled
  1. . I "12"[ZTSK(1) W *7,!,"This message has already been scheduled for update. Task # is: ",$P(IB0,U,11) S IBOK="" D PAUSE^VALM1
  1. ;
  1. I $P(IB0,U,6)=""!("UP"'[$P(IB0,U,6)) D G UPDQ
  1. . W !,*7,"Message status ("_$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6))_") is not appropriate for this action"
  1. . D PAUSE^VALM1
  1. ;
  1. S IBTYP=$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U)
  1. S IBU=$S(IBTYP="REPORT":"MAILIT^IBCESRV2",IBTYP["837REC":"CON837^IBCESRV2",IBTYP["837REJ":"REJ837^IBCESRV2",IBTYP["835EOB":"EOB835^IBCESRV3",1:""),IBU1=$S(IBTYP["837":$E(IBTYP,$L(IBTYP)),1:2)
  1. I IBU="" W !,*7,"This message has an invalid message type - can't update" D PAUSE^VALM1 G UPDQ
  1. S IBTSK=$$TASK(IBU,$P(IB0,U,4),IBTDA,IBU1)
  1. I IBTSK W !,"Update has been tasked (#",IBTSK,")"
  1. I 'IBTSK W !,*7,"Update could not be tasked. Please try again later!!!"
  1. D PAUSE^VALM1
  1. ;
  1. D BLD^IBCEM1
  1. UPDQ I $G(IBTDA) L -^IBA(364.2,IBTDA,0)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. VP ; View/Print Return Messages
  1. N DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,IBDA,IBTDA,IBBILLS
  1. D FULL^VALM1,SEL(.IBDA,1)
  1. S IBDA=$O(IBDA(""))
  1. G:'IBDA VPQ
  1. S IBTDA=$G(IBDA(IBDA)),IBBILLS=""
  1. I $P($G(^IBA(364.2,IBTDA,0)),U,4),'$P(^(0),U,5) D
  1. .S DIR(0)="YA",DIR("B")="NO",DIR("A")="Do you want to list all bills for this batch?: " D ^DIR K DIR
  1. .I Y S IBBILLS=1
  1. S DHD=$S(IBBILLS:"[IBCEM MESSAGE LIST HDR]",1:""),DIC="^IBA(364.2,",FLDS=$S(IBBILLS:"[IBCEM MESSAGE LIST]",1:"[CAPTIONED]"),BY="@NUMBER",(FR,TO)=$G(IBDA(IBDA)),L=0 D EN1^DIP
  1. D PAUSE^VALM1
  1. VPQ S VALMBCK="R"
  1. Q
  1. ;
  1. SEL(IBDA,ONE) ; Select entry(s) from list
  1. ; IBDA = array returned if selections made
  1. ; IBDA(n)=ien of bill selected in 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 S IB=$G(^TMP("IBCEM-837DX",$J,IBDA)),IBDA(IBDA)=+$P(IB,U,2)
  1. Q
  1. ;
  1. UPDEDI(IBDA,FUNC,NOCT,MSCN) ; Update EDI files - cancel/resubmit/print as
  1. ; resolution to message
  1. ; IBDA = transmit bill ien # for bill
  1. ; FUNC = "E" for edit/resubmit, "C" for cancel, "R" for resubmit not
  1. ; from edit, "P" for print, "Z" for COB processed , "N" for no
  1. ; further action needed-close record
  1. ; NOCT = 1 if not necessary to update batch count, 0 if update needed
  1. ; MSCN = 2 if this call came from CLONE and the cloned claim is a secondary and its primary was an MRA
  1. ; (secondaries created from MRA primaries share the same claim#. Do not want to cancel MRA
  1. ; associated with the primary, only any EOBs associated with the cloned secondary claim).
  1. ;
  1. N IB0,IBBA,IBBDA,IBCT,IBM,IBTDA,IBNEW,DA,DIE,DR,Z,IBTEXT,IBZ,IBIFN,IBSTAT
  1. S IB0=$G(^IBA(364,+IBDA,0)),IBBA=$P(IB0,U,2)
  1. Q:IB0="" S IBIFN=+IB0
  1. ;
  1. S IBNEW=$S(FUNC="E"!(FUNC="R"):+$P($G(^IBA(364,+$$LAST364^IBCEF4(+IB0),0)),U,2),1:"") S:IBNEW=IBBA IBNEW=""
  1. ;
  1. S IBSTAT=$P(IB0,U,3) ; current status in file 364
  1. I '$F(".C.R.E.Z.","."_IBSTAT_".") D ; don't update if in final status
  1. . S DR=".03////"_$S(FUNC="E":"R","NP"'[FUNC:FUNC,1:"Z")_";.04///NOW" S:FUNC="E"!(FUNC="R") DR=DR_$S(IBNEW:";.06////"_IBNEW,1:"")
  1. . S DA=+IBDA,DIE="^IBA(364," D ^DIE ;Update the transmit bill record
  1. . Q
  1. ;
  1. I IBBA D CKRES^IBCESRV2(IBBA) ;Update completely resubmitted flags
  1. ;
  1. I IBBA,(FUNC="P"!(IBNEW&'$G(NOCT))) D CTDOWN^IBCEM02(IBBA,1) ;If resubmitted in a new batch or printed, update old batch
  1. ;
  1. S IBTEXT(1)=" UPDATED BY: "_$$EXTERNAL^DILFD(361.02,.02,,+$G(DUZ))
  1. S IBTEXT(2)="ACTION USED: "_$S(FUNC="E":"BILL EDITED/RESUBMITTED",FUNC="C":"BILL CANCELED",FUNC="R":"BILL RESUBMITTED WITHOUT EDIT",FUNC="P":"PRINT BILL",FUNC="Z":"PROCESS COB",1:"")
  1. S IBTEXT(2)=$S(IBTEXT(2)="":"UNSPECIFIED",1:IBTEXT(2)_" - REVIEW MARKED AS COMPLETE")
  1. S IBTEXT=2
  1. ;
  1. ; Update file 361
  1. S IBZ=0 F S IBZ=$O(^IBM(361,"AERR",+IBDA,IBZ)) Q:'IBZ I $D(^IBM(361,IBZ,0)),$P(^(0),U,10)="",$P(^(0),U,9)<2 D
  1. . S DIE="^IBM(361,",DR=".09////2;.1////"_$TR(FUNC,"RCEIBZPN","RCROOFOO"),DA=IBZ D ^DIE
  1. . I FUNC'="","ECRPIBZ"[FUNC D ; Update review status, notes for message
  1. .. D NOTECHG^IBCECSA2(IBZ,1,.IBTEXT)
  1. ;
  1. ; Update file 361.1 with the Cancel Status, to cancel All EOB's on file
  1. ; patch 547***, Pass #2 if don't want to cancel MRA, otherwise pass 0
  1. ; I FUNC="C" D STAT^IBCEMU2(IBIFN,9,0)
  1. I FUNC="C" D STAT^IBCEMU2(IBIFN,9,+$G(MSCN))
  1. ;
  1. Q
  1. ;
  1. DEL ; Delete messages from messages list - locked with IB SUPERVISOR key
  1. N IBDA,IBOK,IBTDA,IBTYP,IBU,IBU1,IB0,DIR,IBT,IBE,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ
  1. D FULL^VALM1
  1. S IBTDA=0
  1. I '$D(^XUSEC("IB SUPERVISOR",DUZ)) D G DELQ
  1. . W !,"You don't have authority to use this action. See your supervisr for assistance"
  1. . D PAUSE^VALM1
  1. D SEL(.IBDA,1)
  1. S IBDA=$O(IBDA(""))
  1. I IBDA="" G DELQ
  1. W !
  1. S DIR(0)="YA",DIR("A",1)="This action will PERMANENTLY delete a return message from your system",DIR("A",2)="A bulletin will be sent to report the deletion",DIR("A",3)=" "
  1. S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
  1. D ^DIR K DIR
  1. G:Y'=1 DELQ
  1. S IBTDA=+IBDA(IBDA)
  1. I '$$LOCK(IBTDA) G DELQ
  1. S IB0=$G(^IBA(364.2,IBTDA,0))
  1. ;
  1. I $P(IB0,U,11) S IBOK=1 D G:'IBOK DELQ
  1. . N ZTSK
  1. . S ZTSK=$P(IB0,U,11) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled
  1. . I "12"[ZTSK(1) W *7,!,"This message is currently scheduled for update. Task # is: ",$P(IB0,U,11) S IBOK="" D PAUSE^VALM1
  1. ;
  1. I $P(IB0,U,6)=""!("UP"'[$P(IB0,U,6)) D G DELQ
  1. . W !,*7,"Message status ("_$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6))_") is not appropriate for this action"
  1. . D PAUSE^VALM1
  1. ;
  1. S DIR(0)="YA",DIR("A",1)=" ",DIR("A",2)="",$P(DIR("A",2),"*",54)="",DIR("A",3)="* This message is about to be PERMANENTLY deleted!! *",DIR("A",4)=DIR("A",2),DIR("A",5)=" "
  1. S DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
  1. W ! D ^DIR W ! K DIR
  1. I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ
  1. ;
  1. K ^TMP("IBMSG",$J)
  1. M ^TMP("IBMSG",$J)=^IBA(364.2,IBTDA)
  1. D DELMSG^IBCESRV2(IBTDA)
  1. I $D(^IBA(364.2,IBTDA)) D G DELQ
  1. . W !,"Message not deleted - problem with delete" D PAUSE^VALM1
  1. ;
  1. S IBT(1)="EDI return message #"_$P(IB0,U)_" has been deleted"
  1. S IBT(2)=" "
  1. S IBT(3)="DELETED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
  1. S Z=$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6)) S:Z="" Z="??"
  1. S IBT(4)=" STATUS: "_$E(Z_$J("",11),1,11)_" MESSAGE TYPE: "_$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U,5)
  1. S IBT(5)=" MESSAGE #: "_$E($P(IB0,U)_$J("",11),1,11)_" STATUS DATE: "_$$FMTE^XLFDT($P($G(^TMP("IBMSG",$J,1)),U,3))
  1. S IBT(6)=" BATCH #: "_$E($P($G(^IBA(364.1,+$P(IB0,U,4),0)),U)_$J("",11),1,11)_" BILL #: "_$$EXPAND^IBTRE(364.2,.05,$P(IB0,U,5))
  1. S IBT(7)=" "
  1. S IBT(8)="MESSAGE TEXT:",IBE=8
  1. S Z=0 F S Z=$O(^TMP("IBMSG",$J,2,Z)) Q:'Z S IBE=IBE+1,IBT(IBE)=$G(^(Z,0))
  1. S XMSUBJ="EDI MESSAGE DELETED",XMBODY="IBT",XMDUZ="",XMTO("I:G.IB EDI")=""
  1. D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1. ;
  1. K ^TMP("IBMSG",$J)
  1. ;
  1. W !,"A bulletin has been sent to report this deletion",!
  1. D PAUSE^VALM1
  1. ;
  1. D BLD^IBCEM1
  1. DELQ L -^IBA(364.2,IBTDA,0)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. TASK(IBRTN,IBBDA,IBTDA,IBTYP) ; Schedule the task to update data base from message
  1. ; IBRTN = routine to task
  1. ; IBBDA = batch # associated with the message (OPTIONAL)
  1. ; IBTDA = internal entry of message
  1. ; IBTYP = the number that is the last digit in the message type
  1. ;
  1. N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE
  1. S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EDI RETURN MESSAGE",ZTSAVE("IB*")="",ZTRTN=IBRTN
  1. D ^%ZTLOAD
  1. I $G(ZTSK),$G(^IBA(364.2,IBTDA,0)) S DIE="^IBA(364.2,",DR=".11////"_ZTSK_";.06////U",DA=IBTDA D ^DIE
  1. Q $G(ZTSK)
  1. ;
  1. LOCK(IBTDA) ; Attempt to lock message file entry IBTDA
  1. ; Return 1 if successful, 0 if not able to lock
  1. ;
  1. N OK
  1. S OK=1
  1. L +^IBA(364.2,IBTDA,0):5
  1. I '$T D
  1. . I '$D(DIQUIET) W !,*7,"Another user is editing this entry ... try again later" D PAUSE^VALM1
  1. . S IBDA="",OK=0
  1. Q OK
  1. ;