IBCEPTC3 ;ALB/ESG - EDI PREVIOUSLY TRANSMITTED CLAIMS ACTIONS ;12/19/05
;;2.0;INTEGRATED BILLING;**320,547,608,641,650,665**;21-MAR-94;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
; IB*2.0*547 Variable IBLOC is pre-defined (in IBCEPTC)
; IB*2.0*608 (vd) provided the ability to identify those claims that are resubmitted
; and those that are skipped. (US2486)
; IB*2.0*665 added SELALL and removed the protocol that calls SELBATCH rendering it toothless
Q
;
SELECT ; Select claims to resubmit
N IBIFN,IBZ,IBI,IBQ,DIR,VALMY,X,Y
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)))
S IBZ=0 F S IBZ=$O(VALMY(IBZ)) Q:'IBZ D
. S IBQ=$G(^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBZ)),IBI=+$P(IBQ,U,2),IBQ=+IBQ
. S IBIFN=$S(IBLOC:IBI,1:+$G(^IBA(364,IBI,0)))
. Q:'IBIFN
. D MARK(IBIFN,IBZ,IBQ,IBI,1,.VALMHDR)
S VALMBCK="R"
Q
;
;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
SELBATCH ; Select a batch to resubmit
; Assumes IBSORT is defined
N DIC,DIR,X,Y,Z,IBQ,IBZ,IBI,IBDX,IBASK,IBOK,IBY,DTOUT,DUOUT
D FULL^VALM1
; IB*2.0*547 Do not allow batch resubmit of locally printed claims
I IBLOC=1 D G SELBQ
. S DIR(0)="EA",DIR("A",1)="This action is not available for Locally Printed Claims",DIR("A")="Press return to continue: "
I IBSORT'=1 D G SELBQ
. 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: "
. W ! D ^DIR K DIR
S DIC="^IBA(364.1,",DIC(0)="AEMQ",DIC("S")="I $D(^TMP(""IB_PREV_CLAIM_BATCH"",$J,+Y))"
D ^DIC K DIC
I Y'>0 G SELBQ
S IBY=+Y,VALMBG=+$G(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY))
;
S (IBOK,IBASK)=1
I $G(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")) D G:'IBOK SELBQ
. 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"
. W ! D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S IBOK=0 Q
. I Y S IBASK=0 K ^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")
;
S IBQ=0 ; last screen row# for claim
F S IBQ=$O(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,IBQ)) Q:'IBQ D
. S IBZ=$G(^(IBQ)) ; IBIFN^selection#
. S Z=$P(IBZ,U,2) ; selection#
. S IBDX=$G(^TMP("IB_PREV_CLAIM_LIST_DX",$J,+Z)) ; 1st screen row# for claim^364 ien
. S IBI=$P(IBDX,U,2) ; 364 ien
. D MARK(+IBZ,Z,+IBDX,IBI,IBASK,.VALMHDR)
;
I IBASK S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")=1
;
SELBQ S VALMBCK="R"
Q
;
;WCJ;IB*2.0*665; new PROTOCOL and new tag to SELECT/DE SELECT ALL
SELALL ;
N IBIFN,IBZ,IBI,IBQ,DIR,VALMY,X,Y,IBCNT,IBSTOP,IBSUCCESS
;
; check if any were already selected. if so, allow to deselect all.
S IBSTOP=0
I $G(^TMP("IB_PREV_CLAIM_SELECT",$J)) D Q:IBSTOP
. S IBCNT=^TMP("IB_PREV_CLAIM_SELECT",$J)
. S DIR(0)="YA",DIR("B")="Yes"
. S DIR("A",1)=IBCNT_" claims were previously selected."
. S DIR("A")="Deselect those "_IBCNT_"? "
. I IBCNT=1 S DIR("A",1)=IBCNT_" claim was previously selected.",DIR("A")="Deselect the "_IBCNT_"? "
. W ! D ^DIR K DIR
. I Y'=1 Q ; stop since they don't want to deselect all
. S VALMBCK="R",IBSTOP=1
. S IBZ=0 F IBCNT=0:1 S IBZ=$O(^TMP("IB_PREV_CLAIM_SELECT",$J,IBZ)) Q:'IBZ D
.. S IBQ=$G(^TMP("IB_PREV_CLAIM_SELECT",$J,IBZ))
.. S IBI=$G(^TMP("IB_PREV_CLAIM_SELECT",$J,IBZ,0))
.. S IBIFN=$S(IBLOC:IBI,1:+$G(^IBA(364,IBI,0)))
.. I 'IBIFN S IBCNT=IBCNT-1 Q
.. D MARK(IBIFN,IBZ,IBQ,IBI,0,.VALMHDR,2)
.. Q
. S DIR(0)="EA"
. S DIR("A",1)=IBCNT_" claims were de-selected."
. I IBCNT=1 S DIR("A",1)=IBCNT_" claim was de-selected."
. S DIR("A")="Press return to continue "
. W ! D ^DIR K DIR
;
; select all
S IBZ=0 F IBCNT=0:1 S IBZ=$O(^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBZ)) Q:'IBZ D
. S IBQ=$G(^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBZ)),IBI=+$P(IBQ,U,2),IBQ=+IBQ
. S IBIFN=$S(IBLOC:IBI,1:+$G(^IBA(364,IBI,0)))
. I 'IBIFN S IBCNT=IBCNT-1 Q
. Q:'IBIFN
. D MARK(IBIFN,IBZ,IBQ,IBI,1,.VALMHDR,1,.IBSUCCESS)
. I '$G(IBSUCCESS) S IBCNT=IBCNT-1 Q
;
; display how may were just selected
S DIR(0)="EA"
S DIR("A",1)=IBCNT_" claims were selected."
I IBCNT=1 S DIR("A",1)=IBCNT_" claim was selected."
S DIR("A")="Press return to continue "
W ! D ^DIR K DIR
S VALMBCK="R"
Q
;
;WCJ;IB665;Added parameters IBSELALL and IBSUCCESS to be used by SELALL tag added above.
MARK(IBIFN,IBZ,IBQ,IBI,IBASK,VALMHDR,IBSELALL,IBSUCCESS) ; Mark claim as selected for resubmit
; IBSELALL 1=MARK 2=UNMARK - This parameter is set when calling from SELALL tag
; IBSUCCESS return 1 if successfully marked/unmarked an individual record. The calling tag needed to keep track of how many it marked or unmarked.
; Returns VALMHDR killed if any selections/de-selections made
S IBSUCCESS=0
N DIR,X,Y
I $G(IBSELALL)'=1,$D(^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)) D Q
. S Y=1
. I IBASK D
.. S DIR(0)="YA",DIR("B")="No"
.. 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?: "
.. W ! D ^DIR K DIR
. I Y=1 D
.. K ^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)
.. S $E(^TMP("IB_PREV_CLAIM_LIST",$J,IBQ,0),6)=" ",^TMP("IB_PREV_CLAIM_SELECT",$J)=^TMP("IB_PREV_CLAIM_SELECT",$J)-1
.. K VALMHDR S IBSUCCESS=1
;
Q:$D(^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN))
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
S $E(^TMP("IB_PREV_CLAIM_LIST",$J,IBQ,0),6)="*" K VALMHDR
S IBSUCCESS=1
Q
;
VIEW ; View claims selected
N IBCT,IBQUIT,DIR,X,Y,Z,Z0
D FULL^VALM1
I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D G VIEWQ
. S DIR(0)="EA",DIR("A")="No claims have been selected - Press return to continue " D ^DIR K DIR
W @IOF
S (IBQUIT,IBCT)=0
W !,+^TMP("IB_PREV_CLAIM_SELECT",$J)," claims selected:"
S Z="" F S Z=$O(^TMP("IB_PREV_CLAIM_SELECT",$J,Z)) Q:'Z S Z0=+$G(^(Z)) D Q:IBQUIT
. Q:'$D(^TMP("IB_PREV_CLAIM_LIST",$J,Z0,0))
. S IBCT=IBCT+1
. I '(IBCT#15) S IBQUIT=0 D Q:IBQUIT
.. S DIR(0)="E" D ^DIR K DIR
.. I 'Y S IBQUIT=1
. W !," ",$E(^TMP("IB_PREV_CLAIM_LIST",$J,Z0,0),7,47)
;
G:IBQUIT VIEWQ
S DIR(0)="E" D ^DIR K DIR
;
VIEWQ S VALMBCK="R"
Q
;
RESUB ; Resubmit selected claims
N DIR,DIRCTR,DIRLN,DIROUT,DIRUT,DTOUT,DUOUT
N IB364,IBABORT,IBCLMNO,IBIFN,IBSKCTR,IBFSKIP,IBRSBTST,IBTYPPTC
N X,Y,Z1,IBC364
;/IB*2*608 - vd (US2486) - instituted the following variable to identify a claim as being resubmitted.
S IBRSBTST=0
D FULL^VALM1
I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D G RESUBQ
. N DIR,X,Y
. S DIR(0)="EA",DIR("A")="No claims have been selected - Press return to continue " D ^DIR K DIR
;
; Ask user if resubmit as production or as test
S DIR(0)="SA^P:Production;T:Test Only"
S DIR("A")="Resubmit Claims: "
S DIR("B")="Production"
S DIR("?",1)=" Select Production to resubmit the claims to the payer for payment."
S DIR("?")=" Select Test to resubmit the claims as Test claims only."
; IB*2.0*547 Only allow locally printed claims to resubmit as Test
W ! I IBLOC'=1 D ^DIR K DIR
I $D(DIRUT) G RESUBQ
S IBTYPPTC="TEST"
I IBLOC'=1,Y="P" S IBTYPPTC="PRODUCTION"
;/IB*2*608 (vd) - The following line indicates the claim is being resubmitted as a "TEST" Claim and should be handled
; special concerning the COB, OFFSET, PRIOR PAYMENTS calculations by the Output Formatter. (US2486)
I IBTYPPTC="TEST" S IBRSBTST=1
;
S DIR(0)="YA",DIR("B")="No"
S DIR("A",1)="You are about to resubmit "_+^TMP("IB_PREV_CLAIM_SELECT",$J)_" claims as "_IBTYPPTC_" claims."
S DIR("A")="Are you sure you want to continue?: "
W ! D ^DIR K DIR
I Y'=1 G RESUBQ
;
; OK to proceed and resubmit
W !!,"Resubmission in process ... "
;
; loop thru selected claims and set into scratch globals
S IBFSKIP=0
K ^TMP("IBRCBOLD",$J)
K ^TMP("IBSKIPPED",$J) ;/IB*2*608 - vd
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
. ;
. I IBTYPPTC="TEST" D
.. ;JWS;IB*2.0*650v4;attempt to prevent duplicate - also for test claims
.. S IBC364=$$LAST364^IBCEF4(IBIFN)
.. I IB364'=IBC364,$P($G(^IBA(364,IBC364,0)),U,3)="X"!$D(^IBA(364,"AC",1,IBC364)) D Q
... S IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
... S IBFSKIP=IBFSKIP+1
... S ^TMP("IBSKIPPED",$J,IBCLMNO)=IBIFN
.. I $P($G(^IBA(364,IB364,0)),U,3)="X"!$D(^IBA(364,"AC",1,IB364)) D Q
... S IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
... S IBFSKIP=IBFSKIP+1
... S ^TMP("IBSKIPPED",$J,IBCLMNO)=IBIFN
.. S ^TMP("IBEDI_TEST_BATCH",$J,IB364)=""
.. S ^TMP("IBRESUBMIT",$J,IB364)=""
.. I Z1 D MARK(IBIFN,"",Z1,IB364,0,.VALMHDR)
.. Q
. ;
. I IBTYPPTC="PRODUCTION" D
.. ;/IB*2*680 (vd) - modified the following line for US2486 as shown below.
.. ; I '$$TXOK(IBIFN) S IBFSKIP=IBFSKIP+1 Q ; transmission not allowed
.. I '$$TXOK(IBIFN) D Q ;transmission not allowed
... S IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
... S IBFSKIP=IBFSKIP+1
... S ^TMP("IBSKIPPED",$J,IBCLMNO)=IBIFN ; /IB*2*608 (vd) - Added to identify those claims that are Skipped
.. ;JWS;IB*2.0*641v7;add resubmission parameter to $$ADDTBILL call, 3rd parameter
.. N Y S Y=$$ADDTBILL^IBCB1(IBIFN,"",1) ; new entry in file 364 - "X" status
.. I '$P(Y,U,3) Q ; quit if new entry didn't get added
.. S ^TMP("IBSELX",$J,+Y)=""
.. S ^TMP("IBRCBOLD",$J,IB364)="" ; save list of old transmit bills
.. I Z1 D MARK(IBIFN,"",Z1,IB364,0,.VALMHDR)
.. Q
. ;
. Q
;
; set top level of scratch globals based on test or production
I IBTYPPTC="TEST" S ^TMP("IBRESUBMIT",$J)="^^0^1",^TMP("IBEDI_TEST_BATCH",$J)=1
E KILL ^TMP("IBRESUBMIT",$J),^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBONE",$J) S ^TMP("IBSELX",$J)=0
;
; resubmit call
D EN1^IBCE837B("","","",.IBABORT,$G(IBRSBTST)) ;/IB*2*608 (vd) - added the IBRSBTST parameter for US2486.
;
; if user aborted at the last minute, then get rid of the new entries
; in file 364 that were added for production claim sending
I IBABORT D
. N IB,DIK,DA
. S IB=0 F S IB=$O(^TMP("IBSELX",$J,IB)) Q:'IB S DIK="^IBA(364,",DA=IB D ^DIK
. Q
;
; update EDI files for the old transmit bills
I 'IBABORT D
. N IB
. S IB=0 F S IB=$O(^TMP("IBRCBOLD",$J,IB)) Q:'IB D UPDEDI^IBCEM(IB,"R")
. Q
;
; cleanup
K ^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBRESUBMIT",$J),^TMP("IBSELX",$J),^TMP("IBRCBOLD",$J)
I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) K ^TMP("IB_PREV_CLAIM_SELECT",$J)
S DIR(0)="EA"
S DIR("A",1)="Selected claims have been resubmitted as "_IBTYPPTC_"."
I IBFSKIP D
. ;JWS;IB*2.0*650v4;changed message to be a little more generic
. S DIR("A",2)="Please note: Some claims were not eligible to be resubmitted." ;; as live claims."
. S DIR("A",3)="The following are the claims that were skipped:"
. ;;S DIR("A",2)="Please note: Some claims were not eligible to be resubmitted as live claims."
. ;;S DIR("A",3)=" These claims are still indicated as being selected."
. ;;S DIR("A",4)="The following are the claims that were skipped:"
. S (DIRLN,IBCLMNO)="",IBSKCTR=0,DIRCTR=4
. F S IBCLMNO=$O(^TMP("IBSKIPPED",$J,IBCLMNO)) Q:IBCLMNO="" D
. . S IBSKCTR=IBSKCTR+1 ; Increment # of claims on the display line.
. . I IBSKCTR>6 D ; Want no more than 6 claim numbers displayed per display line.
. . . S DIRCTR=DIRCTR+1,DIR("A",DIRCTR)=DIRLN ; increment the DIR("A",...) display line and set the line.
. . . S IBSKCTR=1,DIRLN="" ; reset the line segment ctr and clear the display line.
. . ;
. . S DIRLN=DIRLN_" "_IBCLMNO ; Append the claim # to the existing display line.
. I +IBSKCTR S DIRCTR=DIRCTR+1,DIR("A",DIRCTR)=DIRLN
. ;
. Q
K ^TMP("IBSKIPPED",$J) ;/IB*2*608 (vd) - delete the temporary list of skipped claims after reporting them.
I IBABORT K DIR("A") S DIR("A",1)="No claims were resubmitted."
S DIR("A")="Press return to continue "
W ! D ^DIR K DIR
K VALMHDR
;
RESUBQ ;
S VALMBCK="R"
Q
;
REPORT ; Print report
; Assumes IBSORT, IBDT1, IBDT2 defined
N IBACT,Z
D FULL^VALM1
F S IBACT=0 D DEVSEL^IBCEPTC(.IBACT) Q:IBACT
I IBACT'=99 D
. N IBREP
. S IBREP="R" D RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2)
;
D HOME^%ZIS
S VALMBCK="R"
Q
;
CKSENT(VALMBCK) ; Make sure selected entries are transmitted
;
N IBOK,DIR,X,Y
S IBOK=1
I $O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D
. D FULL^VALM1
. 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"
. W ! D ^DIR K DIR
. I Y'=1 S VALMBCK="R",IBOK=0
I IBOK S VALMBCK="Q"
Q
;
TXOK(IBIFN) ; Function determines if claim is OK for live resubmission
NEW OK,IB364,IBD,IBSTAT
S OK=0
;/IB*2*608 (vd) - added the following line for US2486.
I $D(^IBM(361.1,"ABS",+$G(IBIFN),$$COBN^IBCEF(IBIFN))) G TXOKX ; Not okay for claim w/EOB for this payer sequence
;
I '$P($G(^DGCR(399,+$G(IBIFN),"TX")),U,2) G TXOKX ; last electronic extract date
I '$F(".2.3.4.","."_$P($G(^DGCR(399,IBIFN,0)),U,13)_".") G TXOKX ; claim status
S IB364=+$$LAST364^IBCEF4(+$G(IBIFN)) I 'IB364 G TXOKX ; transmit bill exists
S IBD=$G(^IBA(364,IB364,0)) I IBD="" G TXOKX
S IBSTAT=$P(IBD,U,3) I IBSTAT="X" G TXOKX ; already awaiting extract
;JWS;IB*2.0*650v4;attempt to prevent duplicates; if there is already a FHIR submission in process (attempt to eliminate duplicates)
I $D(^IBA(364,"AC",1,IB364)) G TXOKX
S OK=1
TXOKX ;
Q OK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEPTC3 13711 printed Oct 16, 2024@18:12:45 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IB*2.0*547 Variable IBLOC is pre-defined (in IBCEPTC)
+5 ; IB*2.0*608 (vd) provided the ability to identify those claims that are resubmitted
+6 ; and those that are skipped. (US2486)
+7 ; IB*2.0*665 added SELALL and removed the protocol that calls SELBATCH rendering it toothless
+8 QUIT
+9 ;
SELECT ; Select claims to resubmit
+1 NEW IBIFN,IBZ,IBI,IBQ,DIR,VALMY,X,Y
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 SET IBZ=0
FOR
SET IBZ=$ORDER(VALMY(IBZ))
if 'IBZ
QUIT
Begin DoDot:1
+5 SET IBQ=$GET(^TMP("IB_PREV_CLAIM_LIST_DX",$JOB,IBZ))
SET IBI=+$PIECE(IBQ,U,2)
SET IBQ=+IBQ
+6 SET IBIFN=$SELECT(IBLOC:IBI,1:+$GET(^IBA(364,IBI,0)))
+7 if 'IBIFN
QUIT
+8 DO MARK(IBIFN,IBZ,IBQ,IBI,1,.VALMHDR)
End DoDot:1
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
+12 ;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
SELBATCH ; Select a batch to resubmit
+1 ; Assumes IBSORT is defined
+2 NEW DIC,DIR,X,Y,Z,IBQ,IBZ,IBI,IBDX,IBASK,IBOK,IBY,DTOUT,DUOUT
+3 DO FULL^VALM1
+4 ; IB*2.0*547 Do not allow batch resubmit of locally printed claims
+5 IF IBLOC=1
Begin DoDot:1
+6 SET DIR(0)="EA"
SET DIR("A",1)="This action is not available for Locally Printed Claims"
SET DIR("A")="Press return to continue: "
End DoDot:1
GOTO SELBQ
+7 IF IBSORT'=1
Begin DoDot:1
+8 SET DIR(0)="EA"
SET DIR("A",1)="This action is not available unless you chose to sort by batch"
SET DIR("A")="Press return to continue: "
+9 WRITE !
DO ^DIR
KILL DIR
End DoDot:1
GOTO SELBQ
+10 SET DIC="^IBA(364.1,"
SET DIC(0)="AEMQ"
Press return to continue:Press return to continue: SET DIC("S")="I $D(^TMP(""IB_PREV_CLAIM_BATCH"",$J,+Y))"
+11 DO ^DIC
KILL DIC
+12 IF Y'>0
GOTO SELBQ
+13 SET IBY=+Y
SET VALMBG=+$GET(^TMP("IB_PREV_CLAIM_BATCH",$JOB,IBY))
+14 ;
+15 SET (IBOK,IBASK)=1
+16 IF $GET(^TMP("IB_PREV_CLAIM_BATCH",$JOB,IBY,"SEL"))
Begin DoDot:1
+17 SET DIR(0)="YA"
SET DIR("A",1)="This batch was previously selected."
SET DIR("A")="Do you want to de-select all claims in this batch?: "
SET DIR("B")="No"
+18 WRITE !
DO ^DIR
KILL DIR
+19 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBOK=0
QUIT
+20 IF Y
SET IBASK=0
KILL ^TMP("IB_PREV_CLAIM_BATCH",$JOB,IBY,"SEL")
End DoDot:1
if 'IBOK
GOTO SELBQ
+21 ;
+22 ; last screen row# for claim
SET IBQ=0
+23 FOR
SET IBQ=$ORDER(^TMP("IB_PREV_CLAIM_BATCH",$JOB,IBY,IBQ))
if 'IBQ
QUIT
Begin DoDot:1
+24 ; IBIFN^selection#
SET IBZ=$GET(^(IBQ))
+25 ; selection#
SET Z=$PIECE(IBZ,U,2)
+26 ; 1st screen row# for claim^364 ien
SET IBDX=$GET(^TMP("IB_PREV_CLAIM_LIST_DX",$JOB,+Z))
+27 ; 364 ien
SET IBI=$PIECE(IBDX,U,2)
+28 DO MARK(+IBZ,Z,+IBDX,IBI,IBASK,.VALMHDR)
End DoDot:1
+29 ;
+30 IF IBASK
SET ^TMP("IB_PREV_CLAIM_BATCH",$JOB,IBY,"SEL")=1
+31 ;
SELBQ SET VALMBCK="R"
+1 QUIT
+2 ;
+3 ;WCJ;IB*2.0*665; new PROTOCOL and new tag to SELECT/DE SELECT ALL
SELALL ;
+1 NEW IBIFN,IBZ,IBI,IBQ,DIR,VALMY,X,Y,IBCNT,IBSTOP,IBSUCCESS
+2 ;
+3 ; check if any were already selected. if so, allow to deselect all.
+4 SET IBSTOP=0
+5 IF $GET(^TMP("IB_PREV_CLAIM_SELECT",$JOB))
Begin DoDot:1
+6 SET IBCNT=^TMP("IB_PREV_CLAIM_SELECT",$JOB)
+7 SET DIR(0)="YA"
SET DIR("B")="Yes"
+8 SET DIR("A",1)=IBCNT_" claims were previously selected."
+9 SET DIR("A")="Deselect those "_IBCNT_"? "
+10 IF IBCNT=1
SET DIR("A",1)=IBCNT_" claim was previously selected."
SET DIR("A")="Deselect the "_IBCNT_"? "
+11 WRITE !
DO ^DIR
KILL DIR
+12 ; stop since they don't want to deselect all
IF Y'=1
QUIT
+13 SET VALMBCK="R"
SET IBSTOP=1
+14 SET IBZ=0
FOR IBCNT=0:1
SET IBZ=$ORDER(^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBZ))
if 'IBZ
QUIT
Begin DoDot:2
+15 SET IBQ=$GET(^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBZ))
+16 SET IBI=$GET(^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBZ,0))
+17 SET IBIFN=$SELECT(IBLOC:IBI,1:+$GET(^IBA(364,IBI,0)))
+18 IF 'IBIFN
SET IBCNT=IBCNT-1
QUIT
+19 DO MARK(IBIFN,IBZ,IBQ,IBI,0,.VALMHDR,2)
+20 QUIT
End DoDot:2
+21 SET DIR(0)="EA"
+22 SET DIR("A",1)=IBCNT_" claims were de-selected."
+23 IF IBCNT=1
SET DIR("A",1)=IBCNT_" claim was de-selected."
+24 SET DIR("A")="Press return to continue "
+25 WRITE !
DO ^DIR
KILL DIR
End DoDot:1
if IBSTOP
QUIT
+26 ;
+27 ; select all
+28 SET IBZ=0
FOR IBCNT=0:1
SET IBZ=$ORDER(^TMP("IB_PREV_CLAIM_LIST_DX",$JOB,IBZ))
if 'IBZ
QUIT
Begin DoDot:1
+29 SET IBQ=$GET(^TMP("IB_PREV_CLAIM_LIST_DX",$JOB,IBZ))
SET IBI=+$PIECE(IBQ,U,2)
SET IBQ=+IBQ
+30 SET IBIFN=$SELECT(IBLOC:IBI,1:+$GET(^IBA(364,IBI,0)))
+31 IF 'IBIFN
SET IBCNT=IBCNT-1
QUIT
+32 if 'IBIFN
QUIT
+33 DO MARK(IBIFN,IBZ,IBQ,IBI,1,.VALMHDR,1,.IBSUCCESS)
+34 IF '$GET(IBSUCCESS)
SET IBCNT=IBCNT-1
QUIT
End DoDot:1
+35 ;
+36 ; display how may were just selected
+37 SET DIR(0)="EA"
+38 SET DIR("A",1)=IBCNT_" claims were selected."
+39 IF IBCNT=1
SET DIR("A",1)=IBCNT_" claim was selected."
+40 SET DIR("A")="Press return to continue "
+41 WRITE !
DO ^DIR
KILL DIR
+42 SET VALMBCK="R"
+43 QUIT
+44 ;
+45 ;WCJ;IB665;Added parameters IBSELALL and IBSUCCESS to be used by SELALL tag added above.
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
+2 ; IBSUCCESS return 1 if successfully marked/unmarked an individual record. The calling tag needed to keep track of how many it marked or unmarked.
+3 ; Returns VALMHDR killed if any selections/de-selections made
+4 SET IBSUCCESS=0
+5 NEW DIR,X,Y
+6 IF $GET(IBSELALL)'=1
IF $DATA(^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBIFN))
Begin DoDot:1
+7 SET Y=1
+8 IF IBASK
Begin DoDot:2
+9 SET DIR(0)="YA"
SET DIR("B")="No"
+10 SET DIR("A",1)="Claim "_$PIECE($GET(^DGCR(399,IBIFN,0)),U)_" for entry # "_IBZ_" has already been selected"
SET DIR("A")="Do you want to de-select it?: "
+11 WRITE !
DO ^DIR
KILL DIR
End DoDot:2
+12 IF Y=1
Begin DoDot:2
+13 KILL ^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBIFN)
+14 SET $EXTRACT(^TMP("IB_PREV_CLAIM_LIST",$JOB,IBQ,0),6)=" "
SET ^TMP("IB_PREV_CLAIM_SELECT",$JOB)=^TMP("IB_PREV_CLAIM_SELECT",$JOB)-1
+15 KILL VALMHDR
SET IBSUCCESS=1
End DoDot:2
End DoDot:1
QUIT
+16 ;
+17 if $DATA(^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBIFN))
QUIT
+18 SET ^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBIFN)=IBQ
SET ^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBIFN,0)=IBI
SET ^TMP("IB_PREV_CLAIM_SELECT",$JOB)=$GET(^TMP("IB_PREV_CLAIM_SELECT",$JOB))+1
+19 SET $EXTRACT(^TMP("IB_PREV_CLAIM_LIST",$JOB,IBQ,0),6)="*"
KILL VALMHDR
+20 SET IBSUCCESS=1
+21 QUIT
+22 ;
VIEW ; View claims selected
+1 NEW IBCT,IBQUIT,DIR,X,Y,Z,Z0
+2 DO FULL^VALM1
+3 IF '$ORDER(^TMP("IB_PREV_CLAIM_SELECT",$JOB,0))
Begin DoDot:1
+4 SET DIR(0)="EA"
SET DIR("A")="No claims have been selected - Press return to continue "
DO ^DIR
KILL DIR
End DoDot:1
GOTO VIEWQ
+5 WRITE @IOF
+6 SET (IBQUIT,IBCT)=0
+7 WRITE !,+^TMP("IB_PREV_CLAIM_SELECT",$JOB)," claims selected:"
+8 SET Z=""
FOR
SET Z=$ORDER(^TMP("IB_PREV_CLAIM_SELECT",$JOB,Z))
if 'Z
QUIT
SET Z0=+$GET(^(Z))
Begin DoDot:1
+9 if '$DATA(^TMP("IB_PREV_CLAIM_LIST",$JOB,Z0,0))
QUIT
+10 SET IBCT=IBCT+1
+11 IF '(IBCT#15)
SET IBQUIT=0
Begin DoDot:2
+12 SET DIR(0)="E"
DO ^DIR
KILL DIR
+13 IF 'Y
SET IBQUIT=1
End DoDot:2
if IBQUIT
QUIT
+14 WRITE !," ",$EXTRACT(^TMP("IB_PREV_CLAIM_LIST",$JOB,Z0,0),7,47)
End DoDot:1
if IBQUIT
QUIT
+15 ;
+16 if IBQUIT
GOTO VIEWQ
+17 SET DIR(0)="E"
DO ^DIR
KILL DIR
+18 ;
VIEWQ SET VALMBCK="R"
+1 QUIT
+2 ;
RESUB ; Resubmit selected claims
+1 NEW DIR,DIRCTR,DIRLN,DIROUT,DIRUT,DTOUT,DUOUT
+2 NEW IB364,IBABORT,IBCLMNO,IBIFN,IBSKCTR,IBFSKIP,IBRSBTST,IBTYPPTC
+3 NEW X,Y,Z1,IBC364
+4 ;/IB*2*608 - vd (US2486) - instituted the following variable to identify a claim as being resubmitted.
+5 SET IBRSBTST=0
+6 DO FULL^VALM1
+7 IF '$ORDER(^TMP("IB_PREV_CLAIM_SELECT",$JOB,0))
Begin DoDot:1
+8 NEW DIR,X,Y
+9 SET DIR(0)="EA"
SET DIR("A")="No claims have been selected - Press return to continue "
DO ^DIR
KILL DIR
End DoDot:1
GOTO RESUBQ
+10 ;
+11 ; Ask user if resubmit as production or as test
+12 SET DIR(0)="SA^P:Production;T:Test Only"
+13 SET DIR("A")="Resubmit Claims: "
+14 SET DIR("B")="Production"
+15 SET DIR("?",1)=" Select Production to resubmit the claims to the payer for payment."
+16 SET DIR("?")=" Select Test to resubmit the claims as Test claims only."
+17 ; IB*2.0*547 Only allow locally printed claims to resubmit as Test
+18 WRITE !
IF IBLOC'=1
DO ^DIR
KILL DIR
+19 IF $DATA(DIRUT)
GOTO RESUBQ
+20 SET IBTYPPTC="TEST"
+21 IF IBLOC'=1
IF Y="P"
SET IBTYPPTC="PRODUCTION"
+22 ;/IB*2*608 (vd) - The following line indicates the claim is being resubmitted as a "TEST" Claim and should be handled
+23 ; special concerning the COB, OFFSET, PRIOR PAYMENTS calculations by the Output Formatter. (US2486)
+24 IF IBTYPPTC="TEST"
SET IBRSBTST=1
+25 ;
+26 SET DIR(0)="YA"
SET DIR("B")="No"
+27 SET DIR("A",1)="You are about to resubmit "_+^TMP("IB_PREV_CLAIM_SELECT",$JOB)_" claims as "_IBTYPPTC_" claims."
+28 SET DIR("A")="Are you sure you want to continue?: "
+29 WRITE !
DO ^DIR
KILL DIR
+30 IF Y'=1
GOTO RESUBQ
+31 ;
+32 ; OK to proceed and resubmit
+33 WRITE !!,"Resubmission in process ... "
+34 ;
+35 ; loop thru selected claims and set into scratch globals
+36 SET IBFSKIP=0
+37 KILL ^TMP("IBRCBOLD",$JOB)
+38 ;/IB*2*608 - vd
KILL ^TMP("IBSKIPPED",$JOB)
+39 SET IBIFN=0
FOR
SET IBIFN=$ORDER(^TMP("IB_PREV_CLAIM_SELECT",$JOB,IBIFN))
if 'IBIFN
QUIT
SET Z1=+$GET(^(IBIFN))
SET IB364=+$GET(^(IBIFN,0))
IF IB364
Begin DoDot:1
+40 ;
+41 IF IBTYPPTC="TEST"
Begin DoDot:2
+42 ;JWS;IB*2.0*650v4;attempt to prevent duplicate - also for test claims
+43 SET IBC364=$$LAST364^IBCEF4(IBIFN)
+44 IF IB364'=IBC364
IF $PIECE($GET(^IBA(364,IBC364,0)),U,3)="X"!$DATA(^IBA(364,"AC",1,IBC364))
Begin DoDot:3
+45 SET IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
+46 SET IBFSKIP=IBFSKIP+1
+47 SET ^TMP("IBSKIPPED",$JOB,IBCLMNO)=IBIFN
End DoDot:3
QUIT
+48 IF $PIECE($GET(^IBA(364,IB364,0)),U,3)="X"!$DATA(^IBA(364,"AC",1,IB364))
Begin DoDot:3
+49 SET IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
+50 SET IBFSKIP=IBFSKIP+1
+51 SET ^TMP("IBSKIPPED",$JOB,IBCLMNO)=IBIFN
End DoDot:3
QUIT
+52 SET ^TMP("IBEDI_TEST_BATCH",$JOB,IB364)=""
+53 SET ^TMP("IBRESUBMIT",$JOB,IB364)=""
+54 IF Z1
DO MARK(IBIFN,"",Z1,IB364,0,.VALMHDR)
+55 QUIT
End DoDot:2
+56 ;
+57 IF IBTYPPTC="PRODUCTION"
Begin DoDot:2
+58 ;/IB*2*680 (vd) - modified the following line for US2486 as shown below.
+59 ; I '$$TXOK(IBIFN) S IBFSKIP=IBFSKIP+1 Q ; transmission not allowed
+60 ;transmission not allowed
IF '$$TXOK(IBIFN)
Begin DoDot:3
+61 SET IBCLMNO=$$GET1^DIQ(399,IBIFN,.01)
+62 SET IBFSKIP=IBFSKIP+1
+63 ; /IB*2*608 (vd) - Added to identify those claims that are Skipped
SET ^TMP("IBSKIPPED",$JOB,IBCLMNO)=IBIFN
End DoDot:3
QUIT
+64 ;JWS;IB*2.0*641v7;add resubmission parameter to $$ADDTBILL call, 3rd parameter
+65 ; new entry in file 364 - "X" status
NEW Y
SET Y=$$ADDTBILL^IBCB1(IBIFN,"",1)
+66 ; quit if new entry didn't get added
IF '$PIECE(Y,U,3)
QUIT
+67 SET ^TMP("IBSELX",$JOB,+Y)=""
+68 ; save list of old transmit bills
SET ^TMP("IBRCBOLD",$JOB,IB364)=""
+69 IF Z1
DO MARK(IBIFN,"",Z1,IB364,0,.VALMHDR)
+70 QUIT
End DoDot:2
+71 ;
+72 QUIT
End DoDot:1
+73 ;
+74 ; set top level of scratch globals based on test or production
+75 IF IBTYPPTC="TEST"
SET ^TMP("IBRESUBMIT",$JOB)="^^0^1"
SET ^TMP("IBEDI_TEST_BATCH",$JOB)=1
+76 IF '$TEST
KILL ^TMP("IBRESUBMIT",$JOB),^TMP("IBEDI_TEST_BATCH",$JOB),^TMP("IBONE",$JOB)
SET ^TMP("IBSELX",$JOB)=0
+77 ;
+78 ; resubmit call
+79 ;/IB*2*608 (vd) - added the IBRSBTST parameter for US2486.
DO EN1^IBCE837B("","","",.IBABORT,$GET(IBRSBTST))
+80 ;
+81 ; if user aborted at the last minute, then get rid of the new entries
+82 ; in file 364 that were added for production claim sending
+83 IF IBABORT
Begin DoDot:1
+84 NEW IB,DIK,DA
+85 SET IB=0
FOR
SET IB=$ORDER(^TMP("IBSELX",$JOB,IB))
if 'IB
QUIT
SET DIK="^IBA(364,"
SET DA=IB
DO ^DIK
+86 QUIT
End DoDot:1
+87 ;
+88 ; update EDI files for the old transmit bills
+89 IF 'IBABORT
Begin DoDot:1
+90 NEW IB
+91 SET IB=0
FOR
SET IB=$ORDER(^TMP("IBRCBOLD",$JOB,IB))
if 'IB
QUIT
DO UPDEDI^IBCEM(IB,"R")
+92 QUIT
End DoDot:1
+93 ;
+94 ; cleanup
+95 KILL ^TMP("IBEDI_TEST_BATCH",$JOB),^TMP("IBRESUBMIT",$JOB),^TMP("IBSELX",$JOB),^TMP("IBRCBOLD",$JOB)
+96 IF '$ORDER(^TMP("IB_PREV_CLAIM_SELECT",$JOB,0))
KILL ^TMP("IB_PREV_CLAIM_SELECT",$JOB)
+97 SET DIR(0)="EA"
+98 SET DIR("A",1)="Selected claims have been resubmitted as "_IBTYPPTC_"."
+99 IF IBFSKIP
Begin DoDot:1
+100 ;JWS;IB*2.0*650v4;changed message to be a little more generic
+101 ;; as live claims."
SET DIR("A",2)="Please note: Some claims were not eligible to be resubmitted."
+102 SET DIR("A",3)="The following are the claims that were skipped:"
+103 ;;S DIR("A",2)="Please note: Some claims were not eligible to be resubmitted as live claims."
+104 ;;S DIR("A",3)=" These claims are still indicated as being selected."
+105 ;;S DIR("A",4)="The following are the claims that were skipped:"
+106 SET (DIRLN,IBCLMNO)=""
SET IBSKCTR=0
SET DIRCTR=4
+107 FOR
SET IBCLMNO=$ORDER(^TMP("IBSKIPPED",$JOB,IBCLMNO))
if IBCLMNO=""
QUIT
Begin DoDot:2
+108 ; Increment # of claims on the display line.
SET IBSKCTR=IBSKCTR+1
+109 ; Want no more than 6 claim numbers displayed per display line.
IF IBSKCTR>6
Begin DoDot:3
+110 ; increment the DIR("A",...) display line and set the line.
SET DIRCTR=DIRCTR+1
SET DIR("A",DIRCTR)=DIRLN
+111 ; reset the line segment ctr and clear the display line.
SET IBSKCTR=1
SET DIRLN=""
End DoDot:3
+112 ;
+113 ; Append the claim # to the existing display line.
SET DIRLN=DIRLN_" "_IBCLMNO
End DoDot:2
+114 IF +IBSKCTR
SET DIRCTR=DIRCTR+1
SET DIR("A",DIRCTR)=DIRLN
+115 ;
+116 QUIT
End DoDot:1
+117 ;/IB*2*608 (vd) - delete the temporary list of skipped claims after reporting them.
KILL ^TMP("IBSKIPPED",$JOB)
+118 IF IBABORT
KILL DIR("A")
SET DIR("A",1)="No claims were resubmitted."
+119 SET DIR("A")="Press return to continue "
+120 WRITE !
DO ^DIR
KILL DIR
+121 KILL VALMHDR
+122 ;
RESUBQ ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
REPORT ; Print report
+1 ; Assumes IBSORT, IBDT1, IBDT2 defined
+2 NEW IBACT,Z
+3 DO FULL^VALM1
+4 FOR
SET IBACT=0
DO DEVSEL^IBCEPTC(.IBACT)
if IBACT
QUIT
+5 IF IBACT'=99
Begin DoDot:1
+6 NEW IBREP
+7 SET IBREP="R"
DO RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2)
End DoDot:1
+8 ;
+9 DO HOME^%ZIS
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
CKSENT(VALMBCK) ; Make sure selected entries are transmitted
+1 ;
+2 NEW IBOK,DIR,X,Y
+3 SET IBOK=1
+4 IF $ORDER(^TMP("IB_PREV_CLAIM_SELECT",$JOB,0))
Begin DoDot:1
+5 DO FULL^VALM1
+6 SET DIR(0)="YA"
SET DIR("A",1)="You have selected "_+$GET(^TMP("IB_PREV_CLAIM_SELECT",$JOB))_" claims, but have not resubmitted them"
SET DIR("A")="Are you sure you want to quit before you resubmit them?: "
SET DIR("B")="No"
+7 WRITE !
DO ^DIR
KILL DIR
+8 IF Y'=1
SET VALMBCK="R"
SET IBOK=0
End DoDot:1
+9 IF IBOK
SET VALMBCK="Q"
+10 QUIT
+11 ;
TXOK(IBIFN) ; Function determines if claim is OK for live resubmission
+1 NEW OK,IB364,IBD,IBSTAT
+2 SET OK=0
+3 ;/IB*2*608 (vd) - added the following line for US2486.
+4 ; Not okay for claim w/EOB for this payer sequence
IF $DATA(^IBM(361.1,"ABS",+$GET(IBIFN),$$COBN^IBCEF(IBIFN)))
GOTO TXOKX
+5 ;
+6 ; last electronic extract date
IF '$PIECE($GET(^DGCR(399,+$GET(IBIFN),"TX")),U,2)
GOTO TXOKX
+7 ; claim status
IF '$FIND(".2.3.4.","."_$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)_".")
GOTO TXOKX
+8 ; transmit bill exists
SET IB364=+$$LAST364^IBCEF4(+$GET(IBIFN))
IF 'IB364
GOTO TXOKX
+9 SET IBD=$GET(^IBA(364,IB364,0))
IF IBD=""
GOTO TXOKX
+10 ; already awaiting extract
SET IBSTAT=$PIECE(IBD,U,3)
IF IBSTAT="X"
GOTO TXOKX
+11 ;JWS;IB*2.0*650v4;attempt to prevent duplicates; if there is already a FHIR submission in process (attempt to eliminate duplicates)
+12 IF $DATA(^IBA(364,"AC",1,IB364))
GOTO TXOKX
+13 SET OK=1
TXOKX ;
+1 QUIT OK
+2 ;
