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

IBCEPTC3.m

Go to the documentation of this file. 
  1. IBCEPTC3 ;ALB/ESG - EDI PREVIOUSLY TRANSMITTED CLAIMS ACTIONS ;12/19/05
  1.  ;;2.0;INTEGRATED BILLING;**320,547,608,641,650,665**;21-MAR-94;Build 28
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; IB*2.0*547 Variable IBLOC is pre-defined (in IBCEPTC)
  1.  ; IB*2.0*608 (vd) provided the ability to identify those claims that are resubmitted
  1.  ;                 and those that are skipped. (US2486)
  1.  ; IB*2.0*665 added SELALL and removed the protocol that calls SELBATCH rendering it toothless
  1.  Q
  1.  ;
  1. SELECT ; Select claims to resubmit
  1.  N IBIFN,IBZ,IBI,IBQ,DIR,VALMY,X,Y
  1.  D FULL^VALM1
  1.  D EN^VALM2($G(XQORNOD(0)))
  1.  S IBZ=0 F  S IBZ=$O(VALMY(IBZ)) Q:'IBZ  D
  1.  . S IBQ=$G(^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBZ)),IBI=+$P(IBQ,U,2),IBQ=+IBQ
  1.  . S IBIFN=$S(IBLOC:IBI,1:+$G(^IBA(364,IBI,0)))
  1.  . Q:'IBIFN
  1.  . D MARK(IBIFN,IBZ,IBQ,IBI,1,.VALMHDR)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;WCJ;IB665;no changes to the tag but no longer call it - removed the protocol from the worklist since each claim is in its only batch
  1. SELBATCH ; Select a batch to resubmit 
  1.  ; Assumes IBSORT is defined
  1.  N DIC,DIR,X,Y,Z,IBQ,IBZ,IBI,IBDX,IBASK,IBOK,IBY,DTOUT,DUOUT
  1.  D FULL^VALM1
  1.  ; IB*2.0*547 Do not allow batch resubmit of locally printed claims
  1.  I IBLOC=1 D  G SELBQ
  1.  . S DIR(0)="EA",DIR("A",1)="This action is not available for Locally Printed Claims",DIR("A")="Press return to continue: "
  1.  I IBSORT'=1 D  G SELBQ
  1.  . S DIR(0)="EA",DIR("A",1)="This action is not available unless you chose to sort by batch",DIR("A")="Press return to continue: "
  1.  . W ! D ^DIR K DIR
  1.  S DIC="^IBA(364.1,",DIC(0)="AEMQ",DIC("S")="I $D(^TMP(""IB_PREV_CLAIM_BATCH"",$J,+Y))"
  1.  D ^DIC K DIC
  1.  I Y'>0 G SELBQ
  1.  S IBY=+Y,VALMBG=+$G(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY))
  1.  ;
  1.  S (IBOK,IBASK)=1
  1.  I $G(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")) D  G:'IBOK SELBQ
  1.  . S DIR(0)="YA",DIR("A",1)="This batch was previously selected.",DIR("A")="Do you want to de-select all claims in this batch?: ",DIR("B")="No"
  1.  . W ! D ^DIR K DIR
  1.  . I $D(DTOUT)!$D(DUOUT) S IBOK=0 Q
  1.  . I Y S IBASK=0 K ^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")
  1.  ;
  1.  S IBQ=0      ; last screen row# for claim
  1.  F  S IBQ=$O(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,IBQ)) Q:'IBQ  D
  1.  . S IBZ=$G(^(IBQ))      ; IBIFN^selection#
  1.  . S Z=$P(IBZ,U,2)       ; selection#
  1.  . S IBDX=$G(^TMP("IB_PREV_CLAIM_LIST_DX",$J,+Z))   ; 1st screen row# for claim^364 ien
  1.  . S IBI=$P(IBDX,U,2)    ; 364 ien
  1.  . D MARK(+IBZ,Z,+IBDX,IBI,IBASK,.VALMHDR)
  1.  ;
  1.  I IBASK S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")=1
  1.  ;
  1. SELBQ S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;WCJ;IB*2.0*665; new PROTOCOL and new tag to SELECT/DE SELECT ALL
  1. SELALL ;
  1.  N IBIFN,IBZ,IBI,IBQ,DIR,VALMY,X,Y,IBCNT,IBSTOP,IBSUCCESS
  1.  ;
  1.  ; check if any were already selected.  if so, allow to deselect all.
  1.  S IBSTOP=0
  1.  I $G(^TMP("IB_PREV_CLAIM_SELECT",$J)) D  Q:IBSTOP
  1.  . S IBCNT=^TMP("IB_PREV_CLAIM_SELECT",$J)
  1.  . S DIR(0)="YA",DIR("B")="Yes"
  1.  . S DIR("A",1)=IBCNT_" claims were previously selected."
  1.  . S DIR("A")="Deselect those "_IBCNT_"? "
  1.  . I IBCNT=1 S DIR("A",1)=IBCNT_" claim was previously selected.",DIR("A")="Deselect the "_IBCNT_"? "
  1.  . W ! D ^DIR K DIR
  1.  . I Y'=1 Q  ; stop since they don't want to deselect all
  1.  . S VALMBCK="R",IBSTOP=1
  1.  . S IBZ=0 F IBCNT=0:1 S IBZ=$O(^TMP("IB_PREV_CLAIM_SELECT",$J,IBZ)) Q:'IBZ  D
  1.  .. S IBQ=$G(^TMP("IB_PREV_CLAIM_SELECT",$J,IBZ))
  1.  .. S IBI=$G(^TMP("IB_PREV_CLAIM_SELECT",$J,IBZ,0))
  1.  .. S IBIFN=$S(IBLOC:IBI,1:+$G(^IBA(364,IBI,0)))
  1.  .. I 'IBIFN S IBCNT=IBCNT-1 Q
  1.  .. D MARK(IBIFN,IBZ,IBQ,IBI,0,.VALMHDR,2)
  1.  .. Q
  1.  . S DIR(0)="EA"
  1.  . S DIR("A",1)=IBCNT_" claims were de-selected."
  1.  . I IBCNT=1 S DIR("A",1)=IBCNT_" claim was de-selected."
  1.  . S DIR("A")="Press return to continue "
  1.  . W ! D ^DIR K DIR
  1.  ;
  1.  ; select all
  1.  S IBZ=0 F IBCNT=0:1 S IBZ=$O(^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBZ)) Q:'IBZ  D
  1.  . S IBQ=$G(^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBZ)),IBI=+$P(IBQ,U,2),IBQ=+IBQ
  1.  . S IBIFN=$S(IBLOC:IBI,1:+$G(^IBA(364,IBI,0)))
  1.  . I 'IBIFN S IBCNT=IBCNT-1 Q
  1.  . Q:'IBIFN
  1.  . D MARK(IBIFN,IBZ,IBQ,IBI,1,.VALMHDR,1,.IBSUCCESS)
  1.  . I '$G(IBSUCCESS) S IBCNT=IBCNT-1 Q
  1.  ;
  1.  ; display how may were just selected
  1.  S DIR(0)="EA"
  1.  S DIR("A",1)=IBCNT_" claims were selected."
  1.  I IBCNT=1 S DIR("A",1)=IBCNT_" claim was selected."
  1.  S DIR("A")="Press return to continue "
  1.  W ! D ^DIR K DIR
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;WCJ;IB665;Added parameters IBSELALL and IBSUCCESS to be used by SELALL tag added above.
  1. MARK(IBIFN,IBZ,IBQ,IBI,IBASK,VALMHDR,IBSELALL,IBSUCCESS) ; Mark claim as selected for resubmit
  1.  ; IBSELALL 1=MARK 2=UNMARK - This parameter is set when calling from SELALL tag 
  1.  ; IBSUCCESS return 1 if successfully marked/unmarked an individual record.  The calling tag needed to keep track of how many it marked or unmarked.
  1.  ; Returns VALMHDR killed if any selections/de-selections made
  1.  S IBSUCCESS=0
  1.  N DIR,X,Y
  1.  I $G(IBSELALL)'=1,$D(^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)) D  Q
  1.  . S Y=1
  1.  . I IBASK D
  1.  .. S DIR(0)="YA",DIR("B")="No"
  1.  .. S DIR("A",1)="Claim "_$P($G(^DGCR(399,IBIFN,0)),U)_" for entry # "_IBZ_" has already been selected",DIR("A")="Do you want to de-select it?: "
  1.  .. W ! D ^DIR K DIR
  1.  . I Y=1 D
  1.  .. K ^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)
  1.  .. S $E(^TMP("IB_PREV_CLAIM_LIST",$J,IBQ,0),6)=" ",^TMP("IB_PREV_CLAIM_SELECT",$J)=^TMP("IB_PREV_CLAIM_SELECT",$J)-1
  1.  .. K VALMHDR S IBSUCCESS=1
  1.  ;
  1.  Q:$D(^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN))
  1.  S ^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)=IBQ,^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN,0)=IBI,^TMP("IB_PREV_CLAIM_SELECT",$J)=$G(^TMP("IB_PREV_CLAIM_SELECT",$J))+1
  1.  S $E(^TMP("IB_PREV_CLAIM_LIST",$J,IBQ,0),6)="*" K VALMHDR
  1.  S IBSUCCESS=1
  1.  Q
  1.  ;
  1. VIEW ; View claims selected
  1.  N IBCT,IBQUIT,DIR,X,Y,Z,Z0
  1.  D FULL^VALM1
  1.  I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D  G VIEWQ
  1.  . S DIR(0)="EA",DIR("A")="No claims have been selected - Press return to continue " D ^DIR K DIR
  1.  W @IOF
  1.  S (IBQUIT,IBCT)=0
  1.  W !,+^TMP("IB_PREV_CLAIM_SELECT",$J)," claims selected:"
  1.  S Z="" F  S Z=$O(^TMP("IB_PREV_CLAIM_SELECT",$J,Z)) Q:'Z  S Z0=+$G(^(Z)) D  Q:IBQUIT
  1.  . Q:'$D(^TMP("IB_PREV_CLAIM_LIST",$J,Z0,0))
  1.  . S IBCT=IBCT+1
  1.  . I '(IBCT#15) S IBQUIT=0 D  Q:IBQUIT
  1.  .. S DIR(0)="E" D ^DIR K DIR
  1.  .. I 'Y S IBQUIT=1
  1.  . W !,"  ",$E(^TMP("IB_PREV_CLAIM_LIST",$J,Z0,0),7,47)
  1.  ;
  1.  G:IBQUIT VIEWQ
  1.  S DIR(0)="E" D ^DIR K DIR
  1.  ;
  1. VIEWQ S VALMBCK="R"
  1.  Q
  1.  ;
  1. RESUB ; Resubmit selected claims
  1.  N DIR,DIRCTR,DIRLN,DIROUT,DIRUT,DTOUT,DUOUT
  1.  N IB364,IBABORT,IBCLMNO,IBIFN,IBSKCTR,IBFSKIP,IBRSBTST,IBTYPPTC
  1.  N X,Y,Z1,IBC364
  1.  ;/IB*2*608 - vd (US2486) - instituted the following variable to identify a claim as being resubmitted.
  1.  S IBRSBTST=0
  1.  D FULL^VALM1
  1.  I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D  G RESUBQ
  1.  . N DIR,X,Y
  1.  . S DIR(0)="EA",DIR("A")="No claims have been selected - Press return to continue " D ^DIR K DIR
  1.  ;
  1.  ; Ask user if resubmit as production or as test
  1.  S DIR(0)="SA^P:Production;T:Test Only"
  1.  S DIR("A")="Resubmit Claims: "
  1.  S DIR("B")="Production"
  1.  S DIR("?",1)="  Select Production to resubmit the claims to the payer for payment."
  1.  S DIR("?")="  Select Test to resubmit the claims as Test claims only."
  1.  ; IB*2.0*547  Only allow locally printed claims to resubmit as Test
  1.  W ! I IBLOC'=1 D ^DIR K DIR
  1.  I $D(DIRUT) G RESUBQ
  1.  S IBTYPPTC="TEST"
  1.  I IBLOC'=1,Y="P" S IBTYPPTC="PRODUCTION"
  1.  ;/IB*2*608 (vd) - The following line indicates the claim is being resubmitted as a "TEST" Claim and should be handled
  1.  ; special concerning the COB, OFFSET, PRIOR PAYMENTS calculations by the Output Formatter.  (US2486)
  1.  I IBTYPPTC="TEST" S IBRSBTST=1
  1.  ;
  1.  S DIR(0)="YA",DIR("B")="No"
  1.  S DIR("A",1)="You are about to resubmit "_+^TMP("IB_PREV_CLAIM_SELECT",$J)_" claims as "_IBTYPPTC_" claims."
  1.  S DIR("A")="Are you sure you want to continue?: "
  1.  W ! D ^DIR K DIR
  1.  I Y'=1 G RESUBQ
  1.  ;
  1.  ; OK to proceed and resubmit
  1.  W !!,"Resubmission in process ... "
  1.  ;
  1.  ; loop thru selected claims and set into scratch globals
  1.  S IBFSKIP=0
  1.  K ^TMP("IBRCBOLD",$J)
  1.  K ^TMP("IBSKIPPED",$J)   ;/IB*2*608 - vd
  1.  S IBIFN=0 F  S IBIFN=$O(^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)) Q:'IBIFN  S Z1=+$G(^(IBIFN)),IB364=+$G(^(IBIFN,0)) I IB364 D
  1.  . ;
  1.  . I IBTYPPTC="TEST" D
  1.  .. ;JWS;IB*2.0*650v4;attempt to prevent duplicate - also for test claims
  1.  .. S IBC364=$$LAST364^IBCEF4(IBIFN)
  1.  .. I IB364'=IBC364,$P($G(^IBA(364,IBC364,0)),U,3)="X"!$D(^IBA(364,"AC",1,IBC364)) D  Q
  1.  ... S IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
  1.  ... S IBFSKIP=IBFSKIP+1
  1.  ... S ^TMP("IBSKIPPED",$J,IBCLMNO)=IBIFN
  1.  .. I $P($G(^IBA(364,IB364,0)),U,3)="X"!$D(^IBA(364,"AC",1,IB364)) D  Q
  1.  ... S IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
  1.  ... S IBFSKIP=IBFSKIP+1
  1.  ... S ^TMP("IBSKIPPED",$J,IBCLMNO)=IBIFN
  1.  .. S ^TMP("IBEDI_TEST_BATCH",$J,IB364)=""
  1.  .. S ^TMP("IBRESUBMIT",$J,IB364)=""
  1.  .. I Z1 D MARK(IBIFN,"",Z1,IB364,0,.VALMHDR)
  1.  .. Q
  1.  . ;
  1.  . I IBTYPPTC="PRODUCTION" D
  1.  .. ;/IB*2*680 (vd) - modified the following line for US2486 as shown below.
  1.  .. ; I '$$TXOK(IBIFN) S IBFSKIP=IBFSKIP+1 Q    ; transmission not allowed
  1.  .. I '$$TXOK(IBIFN) D  Q   ;transmission not allowed
  1.  ... S IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
  1.  ... S IBFSKIP=IBFSKIP+1
  1.  ... S ^TMP("IBSKIPPED",$J,IBCLMNO)=IBIFN  ; /IB*2*608 (vd) - Added to identify those claims that are Skipped
  1.  .. ;JWS;IB*2.0*641v7;add resubmission parameter to $$ADDTBILL call, 3rd parameter
  1.  .. N Y S Y=$$ADDTBILL^IBCB1(IBIFN,"",1)  ; new entry in file 364 - "X" status
  1.  .. I '$P(Y,U,3) Q                   ; quit if new entry didn't get added
  1.  .. S ^TMP("IBSELX",$J,+Y)=""
  1.  .. S ^TMP("IBRCBOLD",$J,IB364)=""   ; save list of old transmit bills
  1.  .. I Z1 D MARK(IBIFN,"",Z1,IB364,0,.VALMHDR)
  1.  .. Q
  1.  . ;
  1.  . Q
  1.  ;
  1.  ; set top level of scratch globals based on test or production
  1.  I IBTYPPTC="TEST" S ^TMP("IBRESUBMIT",$J)="^^0^1",^TMP("IBEDI_TEST_BATCH",$J)=1
  1.  E  KILL ^TMP("IBRESUBMIT",$J),^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBONE",$J) S ^TMP("IBSELX",$J)=0
  1.  ;
  1.  ; resubmit call
  1.  D EN1^IBCE837B("","","",.IBABORT,$G(IBRSBTST)) ;/IB*2*608 (vd) - added the IBRSBTST parameter for US2486.
  1.  ;
  1.  ; if user aborted at the last minute, then get rid of the new entries
  1.  ; in file 364 that were added for production claim sending
  1.  I IBABORT D
  1.  . N IB,DIK,DA
  1.  . S IB=0 F  S IB=$O(^TMP("IBSELX",$J,IB)) Q:'IB  S DIK="^IBA(364,",DA=IB D ^DIK
  1.  . Q
  1.  ;
  1.  ; update EDI files for the old transmit bills
  1.  I 'IBABORT D
  1.  . N IB
  1.  . S IB=0 F  S IB=$O(^TMP("IBRCBOLD",$J,IB)) Q:'IB  D UPDEDI^IBCEM(IB,"R")
  1.  . Q
  1.  ;
  1.  ; cleanup
  1.  K ^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBRESUBMIT",$J),^TMP("IBSELX",$J),^TMP("IBRCBOLD",$J)
  1.  I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) K ^TMP("IB_PREV_CLAIM_SELECT",$J)
  1.  S DIR(0)="EA"
  1.  S DIR("A",1)="Selected claims have been resubmitted as "_IBTYPPTC_"."
  1.  I IBFSKIP D
  1.  . ;JWS;IB*2.0*650v4;changed message to be a little more generic
  1.  . S DIR("A",2)="Please note: Some claims were not eligible to be resubmitted."  ;; as live claims."
  1.  . S DIR("A",3)="The following are the claims that were skipped:"
  1.  . ;;S DIR("A",2)="Please note: Some claims were not eligible to be resubmitted as live claims."
  1.  . ;;S DIR("A",3)=" These claims are still indicated as being selected."
  1.  . ;;S DIR("A",4)="The following are the claims that were skipped:"
  1.  . S (DIRLN,IBCLMNO)="",IBSKCTR=0,DIRCTR=4
  1.  . F  S IBCLMNO=$O(^TMP("IBSKIPPED",$J,IBCLMNO)) Q:IBCLMNO=""  D
  1.  . . S IBSKCTR=IBSKCTR+1 ; Increment # of claims on the display line.
  1.  . . I IBSKCTR>6 D     ; Want no more than 6 claim numbers displayed per display line.
  1.  . . . S DIRCTR=DIRCTR+1,DIR("A",DIRCTR)=DIRLN   ; increment the DIR("A",...) display line and set the line.
  1.  . . . S IBSKCTR=1,DIRLN=""   ; reset the line segment ctr and clear the display line.
  1.  . . ;
  1.  . . S DIRLN=DIRLN_" "_IBCLMNO   ; Append the claim # to the existing display line.
  1.  . I +IBSKCTR S DIRCTR=DIRCTR+1,DIR("A",DIRCTR)=DIRLN
  1.  . ;
  1.  . Q
  1.  K ^TMP("IBSKIPPED",$J) ;/IB*2*608 (vd) - delete the temporary list of skipped claims after reporting them.
  1.  I IBABORT K DIR("A") S DIR("A",1)="No claims were resubmitted."
  1.  S DIR("A")="Press return to continue "
  1.  W ! D ^DIR K DIR
  1.  K VALMHDR
  1.  ;
  1. RESUBQ ;
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. REPORT ; Print report
  1.  ; Assumes IBSORT, IBDT1, IBDT2 defined
  1.  N IBACT,Z
  1.  D FULL^VALM1
  1.  F  S IBACT=0 D DEVSEL^IBCEPTC(.IBACT) Q:IBACT 
  1.  I IBACT'=99 D
  1.  . N IBREP
  1.  . S IBREP="R" D RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2)
  1.  ;
  1.  D HOME^%ZIS
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. CKSENT(VALMBCK) ; Make sure selected entries are transmitted
  1.  ;
  1.  N IBOK,DIR,X,Y
  1.  S IBOK=1
  1.  I $O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D
  1.  . D FULL^VALM1
  1.  . S DIR(0)="YA",DIR("A",1)="You have selected "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" claims, but have not resubmitted them",DIR("A")="Are you sure you want to quit before you resubmit them?: ",DIR("B")="No"
  1.  . W ! D ^DIR K DIR
  1.  . I Y'=1 S VALMBCK="R",IBOK=0
  1.  I IBOK S VALMBCK="Q"
  1.  Q
  1.  ;
  1. TXOK(IBIFN) ; Function determines if claim is OK for live resubmission
  1.  NEW OK,IB364,IBD,IBSTAT
  1.  S OK=0
  1.  ;/IB*2*608 (vd) - added the following line for US2486.
  1.  I $D(^IBM(361.1,"ABS",+$G(IBIFN),$$COBN^IBCEF(IBIFN))) G TXOKX  ; Not okay for claim w/EOB for this payer sequence
  1.  ;
  1.  I '$P($G(^DGCR(399,+$G(IBIFN),"TX")),U,2) G TXOKX                  ; last electronic extract date
  1.  I '$F(".2.3.4.","."_$P($G(^DGCR(399,IBIFN,0)),U,13)_".") G TXOKX   ; claim status
  1.  S IB364=+$$LAST364^IBCEF4(+$G(IBIFN)) I 'IB364 G TXOKX             ; transmit bill exists
  1.  S IBD=$G(^IBA(364,IB364,0)) I IBD="" G TXOKX
  1.  S IBSTAT=$P(IBD,U,3) I IBSTAT="X" G TXOKX                          ; already awaiting extract
  1.  ;JWS;IB*2.0*650v4;attempt to prevent duplicates; if there is already a FHIR submission in process (attempt to eliminate duplicates)
  1.  I $D(^IBA(364,"AC",1,IB364)) G TXOKX
  1.  S OK=1
  1. TXOKX ;
  1.  Q OK
  1.  ;