- IBCEM02 ;ALB/TMP - 837 EDI RESUBMIT BATCH PROCESSING ;12-SEP-96
- ;;2.0;INTEGRATED BILLING;**137,191,296**;21-MAR-94
- Q
- ;
- BATCH2 ; Resubmit a batch of bills not necessarily in error
- N DIR,DIC,X,Y,IB
- K ^TMP("IBEDI_TEST_BATCH",$J)
- F S DIC="^IBA(364.1,",DIC(0)="AEMQ" D ^DIC Q:Y<0 S IB=+Y D I IB Q:'$$BATCH(+IB)
- . N Y,IB0
- . S IB0=$G(^IBA(364.1,IB,0)) I $P(IB0,U,14),'$O(^IBA(364,"C",IB,0)) D Q:'IB
- .. S DIR("A",1)="THIS IS A TEST BATCH AND CANNOT BE RESUBMITTED."
- .. I +$P(IB0,U,15) S DIR("A",2)="IT WAS CREATED AS A RESULT OF BATCH "_$P($G(^IBA(364.1,+$P(IB0,U,15),0)),U)_" BEING RESUBMITTED.",DIR("A",3)="RESUBMIT THIS ORIGINAL BATCH INSTEAD."
- .. S DIR("A")="PRESS RETURN TO CONTINUE: "
- .. S DIR(0)="EA"
- .. W ! D ^DIR K DIR W !
- .. S IB=0
- . ;
- . S DIR("A")="Are you resubmitting the claims in this batch for testing?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
- . I $D(DTOUT)!$D(DUOUT) S IB=0 Q
- . I +Y S ^TMP("IBEDI_TEST_BATCH",$J)=1 Q
- . K ^TMP("IBEDI_TEST_BATCH",$J)
- K ^TMP("IBEDI_TEST_BATCH",$J)
- Q
- ;
- BATCH(IBBDA) ;
- N DIR,IBOK,IB0,IB1,ZTSK,IBSTAT,IBCE,IBASK,IBSTOP,IBTEST
- S IB0=$G(^IBA(364.1,IBBDA,0)),IB1=$G(^(1)),IBSTAT=$P(IB0,U,2),IBASK=0
- S IBTEST=+$G(^TMP("IBEDI_TEST_BATCH",$J))
- ;
- I 'IBTEST,$P(IB0,U,9) D I 'IBOK S IBASK=1 G BATCHQ
- . S IBOK=1,ZTSK=$P(IB0,U,9) D STAT^%ZTLOAD
- . I ZTSK(0)=0 S DIE="^IBA(364.1,",DA=IBBDA,DR=".09///@" D ^DIE Q ;Task not scheduled - delete task #
- . I "125"[ZTSK(1) W *7,!,"Cannot resubmit this batch.",!,"This batch is currently ",$S("2"[ZTSK(1):"being resubmitted",1:"scheduled for resubmission")," - Task # is: ",$P(IB0,U,9),! S IBOK=0
- ;
- W !
- S DIR("A",1)=$P(IB0,U,8)
- S DIR("A",2)="Current Batch Status: "_$$EXPAND^IBTRE(364.1,.02,IBSTAT)
- S DIR("A",3)=" Recorded On: "_$$FMTE^XLFDT($P(IB1,U,6),2)
- S DIR("A",4)=" "
- S DIR("A",5)=" Date Last Sent: "_$$FMTE^XLFDT($P(IB1,U,3),2)
- S DIR("A",6)=" Last Sent By: "_$$EXPAND^IBTRE(364.1,1.04,$P(IB1,U,4))
- S DIR("A",7)=" "
- S DIR("A",8)=" Date First Sent: "_$$FMTE^XLFDT($P(IB1,U),2)
- S DIR("A",9)=" First Sent By: "_$$EXPAND^IBTRE(364.1,1.02,$P(IB1,U,2))
- S DIR("A",10)=" Number Of Bills: "_$P(IB0,U,3)
- S DIR("A",11)=" "
- ;
- I $P(IB0,U,13),'IBTEST D G:IBSTOP BATCHQ
- . S DIR("A",12)="BATCH WAS LAST RESUBMITTED ON "_$$FMTE^XLFDT($P(IB0,U,13),2),DIR("A",13)=" "
- . S DIR(0)="YA",DIR("A")="ARE YOU SURE YOU WANT TO RESUBMIT IT AGAIN?: ",DIR("B")="NO" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) S IBSTOP=1 Q
- . S IBSTOP=0
- ;
- I IBSTAT'="P",'IBTEST S DIR("A",11)="WARNING - BATCH TRANSMITTED PREVIOUSLY & CONFIRMED RECEIVED BY "_$P("AUSTIN^PAYER/INTERMEDIARY",U,$TR(IBSTAT,"A")+1)
- S DIR("A")="ARE YOU SURE YOU WANT TO RESUBMIT THIS BATCH"_$S(IBTEST:" FOR TEST",1:"")_"?: "
- S DIR(0)="YA",DIR("B")="NO"
- D ^DIR K DIR
- S IBSTOP=('Y)
- ;
- K ^TMP("IBNOT",$J)
- W !
- I IBSTOP S IBASK=1 G BATCHQ
- I IBSTAT'="P"!IBTEST D
- . S DIR("A")="Do you want to exclude any bills from being resubmitted?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
- . I Y D
- .. N IBDAB,Z,IBCEFUNC
- .. S IBCEFUNC=1,IBCE("VALMSG")="Select bills that should NOT be resubmitted"
- .. D EN^VALM("IBCEM BATCH BILL LIST")
- W !
- D RESUB(IBBDA,$S(IBTEST:0,IBSTAT="P":1,1:0))
- ;
- BATCHQ Q IBASK
- ;
- RESUB(IBBDA,IBOLD) ; Resubmit a batch entry # IBBDA in file 364.1
- ;IBOLD = 1 if old batch # should be used 0 if new batch # needed
- ;
- N IBIFN,IB0,IBS,IBS1,IBSCT,IBEXCT,IBE,IB,DIR,Y,IBT,IBPT,IBB,IBZTSK,IBTEST
- K ^TMP("IBRESUBMIT",$J),^TMP("IBRESUB",$J)
- S IBTEST=+$G(^TMP("IBEDI_TEST_BATCH",$J))
- S IBOLD=+$G(IBOLD),^TMP("IBRESUB",$J)=$P($G(^IBA(364.1,IBBDA,0)),U)_U_IBBDA_U_IBOLD_U_IBTEST
- ;
- S (IBE,IBE(0),IBSCT,IBEXCT,IBIFN)=0
- F S IBIFN=$O(^IBA(364,"ABABI",IBBDA,IBIFN)) Q:'IBIFN S IB=$O(^IBA(364,"ABABI",IBBDA,IBIFN,"")) Q:'IB S IB0=$G(^IBA(364,IB,0)),IBS=$P($G(^DGCR(399,IBIFN,0)),U,13) D
- . I $D(^TMP("IBNOT",$J,IB)) S IBEXCT=IBEXCT+1 Q
- . S IBSCT=IBSCT+1,IBS1=$P(IB0,U,3)
- . I IBTEST!(IBS>1&(IBS<6)&("CRDZ"'[IBS1)) S ^TMP("IBRESUB",$J,IB)=IBIFN Q
- . S IBE(0)=IBE(0)+1
- . I IBS1'="","CRDZ"[IBS1 S IBE(IBS1)=$G(IBE(IBS1))+1 Q
- . S IBE=IBE+1,^TMP("IBNOT",$J,IB)=IBIFN
- ;
- I 'IBTEST,'IBE(0),'IBSCT,'$D(^TMP("IBNOT",$J)) D CKRES^IBCESRV2(IBBDA) G RESUBQ
- I IBE(0)!'IBSCT S Y=1 D G:'Y RESUBQ
- . I IBE(0)=IBSCT W !,*7,"There are no bill(s) in this batch in a valid status to be resubmitted" W:IBEXCT !,IBEXCT," bill(s) in this batch have been specifically excluded" D PAUSE^VALM1 S Y="" Q
- . F Z="C","R","D" I $D(IBE(Z)) W !,*7,IBE(Z)," bill(s) in this batch have been ",$S(Z="C":"cancelled",Z="R":"resubmitted",1:"deleted from batch")," previously"
- . I IBE W !,*7,IBE," bill(s) in this batch are not in a valid status to be re-submitted"
- . I IBEXCT W !,IBEXCT," bill(s) in this batch have been specifically excluded" Q:'IBE
- . K DIR S DIR("A")="Do you want to resubmit the other "_(IBSCT-IBE(0))_" bill(s) in this batch?: ",DIR(0)="YA",DIR("B")="NO" D ^DIR K DIR
- . W !
- . I 'Y W !,*7,"Batch NOT resubmitted" D PAUSE^VALM1 S Y=0,IBSTOP=1 K ^TMP("IBRESUB",$J),^TMP("IBNOT",$J) Q
- ;
- S IBZTSK=""
- I $O(^TMP("IBRESUB",$J,0)) D
- . S ^TMP("IBRESUBMIT",$J)=$G(^TMP("IBRESUB",$J))
- . S IB="" F S IB=$O(^TMP("IBRESUB",$J,IB)) Q:'IB S IBIFN=$P($G(^IBA(364,IB,0)),U),Y=$S('IBOLD&'IBTEST:$$ADDTBILL^IBCB1(IBIFN),1:IB) D
- .. I IBTEST Q:$D(^TMP("IBNOT",$J,IB))
- .. I 'IBTEST,'IBOLD,'$P(Y,U,3) S ^TMP("IBNOT",$J,IB)=IBIFN K ^TMP("IBRESUB",$J,IB) Q
- .. S ^TMP("IBRESUBMIT",$J,+Y)=^TMP("IBRESUB",$J,IB),^TMP("IBRESUBMIT",$J,+Y,"OLD")=$S('IBTEST:IB,1:0)
- . D EN1^IBCE837B(.IBZTSK,0)
- . I 'IBTEST,$G(^TMP("IBRESUBMIT",$J))="ABORT" D ; No resubmit - delete entries
- .. S IB="" F S IB=$O(^TMP("IBRESUBMIT",$J,IB)) Q:'IB S DIK="^IBA(364,",DA=IB D ^DIK
- .. K ^TMP("IBRESUBMIT",$J)
- I IBZTSK S ^TMP("IBRESUBMIT",$J)=^TMP("IBRESUB",$J),DIE="^IBA(364.1,",DR=".09////"_IBZTSK,DA=$S('IBTEST:+$P($G(^TMP("IBRESUBMIT",$J)),U,2),1:0) D:DA ^DIE ;task was queued
- ;
- RESUBQ Q
- ;
- RESUBUP ; Update old entries in file 364 for resubmitted bills, send bulletin
- ; for bills not resubmitted in batch, if any, update new batch(s) with
- ; old batch reference
- N IBBA,IBE,IBT,IB,IBV,IBB,XMSUBJ,XMBODY,XMTO,XMDUZ
- ;
- S IBBA=+$P($G(^TMP("IBRESUBMIT",$J)),U,2) ;Original batch entry #
- ;
- I $O(^TMP("IBNOT",$J,0)) D
- . S IBE=5,IB=""
- . F S IB=$O(^TMP("IBNOT",$J,IB)) Q:IB="" S IBB=+$G(^(IB)),IBV=$$DISP^IBCEM3(IBB,"",1) D
- .. Q:"CRDZ"[$P($G(^IBA(364,IB,0)),U,3)
- .. S IBE=IBE+1,IBPT=$P(IBV,U,3)
- .. S IBT(IBE)=" "_$E($P(IBV,U,2)_$J("",10),1,10)_$E($E($P(IBPT,"("),1,20)_"("_$P(IBPT,"(",2)_$J("",32),1,32)_" "_$E($P(IBV,U,4)_$J("",10),1,10)_" "_$$EXPAND^IBTRE(399,.13,$P($G(^DGCR(399,IBB,0)),U,13))
- . I IBE>5 D ;Batch resubmit is still incomplete
- .. S IBT(1)="The resubmission of bills in batch "_$P($G(^TMP("IBRESUB",$J)),U)_" was incomplete."
- .. S IBT(2)="The following bills were NOT resubmitted:"
- .. S IBT(3)=" ",IBT(4)=" BILL # PATIENT"_$J("",27)_"TYPE BILL STATUS",IBT(5)="",$P(IBT(5),"-",76)="",IBT(5)=" "_IBT(5)
- .. S XMSUBJ="BILLS NOT RESUBMITTED WITH THEIR BATCH",XMBODY="IBT",XMDUZ="",XMTO("I:G.IB EDI")=""
- .. D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- .. I '$P($G(^IBE(364.1,IBBA,0)),U,10) S DIE="^IBA(364.1,",DR=".1////1",DA=IBBA D ^DIE
- ;
- I $G(^TMP("IBRESUBMIT",$J,0)),'$P($G(^TMP("IBRESUBMIT",$J)),U,3) D
- . N IB,IBCT,IBO,IBIFN
- . S (IB,IBCT)=0
- . F S IB=$O(^TMP("IBRESUBMIT",$J,IB)) Q:'IB S IBIFN=+$G(^(IB)),IBO=$G(^(IB,"OLD")) D:IBO
- .. S IBCT=IBCT+1
- .. D UPDEDI^IBCEM(IBO,"R",1)
- . D CTDOWN(IBBA,IBCT)
- S DA=IBBA,DIE="^IBA(364.1,",DR=".09///@;.13///NOW;1.03///NOW;1.04////.5" D ^DIE
- L -^IBA(364.1,DA)
- K ^TMP("IBNOT",$J),^TMP("IBRESUB",$J)
- Q
- ;
- CTDOWN(IBBA,IBCT) ; Upd the count, incomplete resubmit status on the batch
- ;IBBA = batch file ien
- ;IBCT = the # to decrease the count
- Q:'IBBA
- N IBCT1,IBSTAT,IB0
- S IB0=$G(^IBA(364.1,IBBA,0)),IBCT1=$P(IB0,U,3)-IBCT,IBSTAT=$P(IB0,U,10)
- S:IBCT1<0 IBCT1=0
- S IBINC=$S('IBSTAT:"",1:$$CKINC^IBCEM02(IBBA)),DIE="^IBA(364.1,",DR=".03////"_IBCT1_$S(IBINC'="":";.1////"_IBINC,1:""),DA=IBBA D ^DIE
- Q
- ;
- CKINC(IBBA) ;Check to see if batch resubmit is incomplete
- ; IBBA = internal file 364.1 entry # of batch to check
- N IBZ,IBINC,DR,DA,DIE
- S IBZ="",IBINC=0
- F S IBZ=$O(^IBA(364,"ABAST",IBBA,IBZ)) Q:IBZ="" I "CRD"'[IBZ S IBINC=1 Q
- Q IBINC
- ;
- LOCK(FILE,IBBDA) ; Lock file # FILE entry # IBBDA
- I IBBDA L +^IBA(FILE,IBBDA):5
- Q $T
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEM02 8457 printed Feb 18, 2025@23:37:07 Page 2
- IBCEM02 ;ALB/TMP - 837 EDI RESUBMIT BATCH PROCESSING ;12-SEP-96
- +1 ;;2.0;INTEGRATED BILLING;**137,191,296**;21-MAR-94
- +2 QUIT
- +3 ;
- BATCH2 ; Resubmit a batch of bills not necessarily in error
- +1 NEW DIR,DIC,X,Y,IB
- +2 KILL ^TMP("IBEDI_TEST_BATCH",$JOB)
- +3 FOR
- SET DIC="^IBA(364.1,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- if Y<0
- QUIT
- SET IB=+Y
- Begin DoDot:1
- +4 NEW Y,IB0
- +5 SET IB0=$GET(^IBA(364.1,IB,0))
- IF $PIECE(IB0,U,14)
- IF '$ORDER(^IBA(364,"C",IB,0))
- Begin DoDot:2
- +6 SET DIR("A",1)="THIS IS A TEST BATCH AND CANNOT BE RESUBMITTED."
- +7 IF +$PIECE(IB0,U,15)
- SET DIR("A",2)="IT WAS CREATED AS A RESULT OF BATCH "_$PIECE($GET(^IBA(364.1,+$PIECE(IB0,U,15),0)),U)_" BEING RESUBMITTED."
- SET DIR("A",3)="RESUBMIT THIS ORIGINAL BATCH INSTEAD."
- +8 SET DIR("A")="PRESS RETURN TO CONTINUE: "
- +9 SET DIR(0)="EA"
- +10 WRITE !
- DO ^DIR
- KILL DIR
- WRITE !
- +11 SET IB=0
- End DoDot:2
- if 'IB
- QUIT
- +12 ;
- +13 SET DIR("A")="Are you resubmitting the claims in this batch for testing?: "
- SET DIR("B")="NO"
- SET DIR(0)="YA"
- DO ^DIR
- KILL DIR
- +14 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IB=0
- QUIT
- +15 IF +Y
- SET ^TMP("IBEDI_TEST_BATCH",$JOB)=1
- QUIT
- +16 KILL ^TMP("IBEDI_TEST_BATCH",$JOB)
- End DoDot:1
- IF IB
- if '$$BATCH(+IB)
- QUIT
- +17 KILL ^TMP("IBEDI_TEST_BATCH",$JOB)
- +18 QUIT
- +19 ;
- BATCH(IBBDA) ;
- +1 NEW DIR,IBOK,IB0,IB1,ZTSK,IBSTAT,IBCE,IBASK,IBSTOP,IBTEST
- +2 SET IB0=$GET(^IBA(364.1,IBBDA,0))
- SET IB1=$GET(^(1))
- SET IBSTAT=$PIECE(IB0,U,2)
- SET IBASK=0
- +3 SET IBTEST=+$GET(^TMP("IBEDI_TEST_BATCH",$JOB))
- +4 ;
- +5 IF 'IBTEST
- IF $PIECE(IB0,U,9)
- Begin DoDot:1
- +6 SET IBOK=1
- SET ZTSK=$PIECE(IB0,U,9)
- DO STAT^%ZTLOAD
- +7 ;Task not scheduled - delete task #
- IF ZTSK(0)=0
- SET DIE="^IBA(364.1,"
- SET DA=IBBDA
- SET DR=".09///@"
- DO ^DIE
- QUIT
- +8 IF "125"[ZTSK(1)
- WRITE *7,!,"Cannot resubmit this batch.",!,"This batch is currently ",$SELECT("2"[ZTSK(1):"being resubmitted",1:"scheduled for resubmission")," - Task # is: ",$PIECE(IB0,U,9),!
- SET IBOK=0
- End DoDot:1
- IF 'IBOK
- SET IBASK=1
- GOTO BATCHQ
- +9 ;
- +10 WRITE !
- +11 SET DIR("A",1)=$PIECE(IB0,U,8)
- +12 SET DIR("A",2)="Current Batch Status: "_$$EXPAND^IBTRE(364.1,.02,IBSTAT)
- +13 SET DIR("A",3)=" Recorded On: "_$$FMTE^XLFDT($PIECE(IB1,U,6),2)
- +14 SET DIR("A",4)=" "
- +15 SET DIR("A",5)=" Date Last Sent: "_$$FMTE^XLFDT($PIECE(IB1,U,3),2)
- +16 SET DIR("A",6)=" Last Sent By: "_$$EXPAND^IBTRE(364.1,1.04,$PIECE(IB1,U,4))
- +17 SET DIR("A",7)=" "
- +18 SET DIR("A",8)=" Date First Sent: "_$$FMTE^XLFDT($PIECE(IB1,U),2)
- +19 SET DIR("A",9)=" First Sent By: "_$$EXPAND^IBTRE(364.1,1.02,$PIECE(IB1,U,2))
- +20 SET DIR("A",10)=" Number Of Bills: "_$PIECE(IB0,U,3)
- +21 SET DIR("A",11)=" "
- +22 ;
- +23 IF $PIECE(IB0,U,13)
- IF 'IBTEST
- Begin DoDot:1
- +24 SET DIR("A",12)="BATCH WAS LAST RESUBMITTED ON "_$$FMTE^XLFDT($PIECE(IB0,U,13),2)
- SET DIR("A",13)=" "
- +25 SET DIR(0)="YA"
- SET DIR("A")="ARE YOU SURE YOU WANT TO RESUBMIT IT AGAIN?: "
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- IF 'Y!$DATA(DTOUT)!$DATA(DUOUT)
- SET IBSTOP=1
- QUIT
- +26 SET IBSTOP=0
- End DoDot:1
- if IBSTOP
- GOTO BATCHQ
- +27 ;
- +28 IF IBSTAT'="P"
- IF 'IBTEST
- SET DIR("A",11)="WARNING - BATCH TRANSMITTED PREVIOUSLY & CONFIRMED RECEIVED BY "_$PIECE("AUSTIN^PAYER/INTERMEDIARY",U,$TRANSLATE(IBSTAT,"A")+1)
- +29 SET DIR("A")="ARE YOU SURE YOU WANT TO RESUBMIT THIS BATCH"_$SELECT(IBTEST:" FOR TEST",1:"")_"?: "
- +30 SET DIR(0)="YA"
- SET DIR("B")="NO"
- +31 DO ^DIR
- KILL DIR
- +32 SET IBSTOP=('Y)
- +33 ;
- +34 KILL ^TMP("IBNOT",$JOB)
- +35 WRITE !
- +36 IF IBSTOP
- SET IBASK=1
- GOTO BATCHQ
- +37 IF IBSTAT'="P"!IBTEST
- Begin DoDot:1
- +38 SET DIR("A")="Do you want to exclude any bills from being resubmitted?: "
- SET DIR("B")="NO"
- SET DIR(0)="YA"
- DO ^DIR
- KILL DIR
- +39 IF Y
- Begin DoDot:2
- +40 NEW IBDAB,Z,IBCEFUNC
- +41 SET IBCEFUNC=1
- SET IBCE("VALMSG")="Select bills that should NOT be resubmitted"
- +42 DO EN^VALM("IBCEM BATCH BILL LIST")
- End DoDot:2
- End DoDot:1
- +43 WRITE !
- +44 DO RESUB(IBBDA,$SELECT(IBTEST:0,IBSTAT="P":1,1:0))
- +45 ;
- BATCHQ QUIT IBASK
- +1 ;
- RESUB(IBBDA,IBOLD) ; Resubmit a batch entry # IBBDA in file 364.1
- +1 ;IBOLD = 1 if old batch # should be used 0 if new batch # needed
- +2 ;
- +3 NEW IBIFN,IB0,IBS,IBS1,IBSCT,IBEXCT,IBE,IB,DIR,Y,IBT,IBPT,IBB,IBZTSK,IBTEST
- +4 KILL ^TMP("IBRESUBMIT",$JOB),^TMP("IBRESUB",$JOB)
- +5 SET IBTEST=+$GET(^TMP("IBEDI_TEST_BATCH",$JOB))
- +6 SET IBOLD=+$GET(IBOLD)
- SET ^TMP("IBRESUB",$JOB)=$PIECE($GET(^IBA(364.1,IBBDA,0)),U)_U_IBBDA_U_IBOLD_U_IBTEST
- +7 ;
- +8 SET (IBE,IBE(0),IBSCT,IBEXCT,IBIFN)=0
- +9 FOR
- SET IBIFN=$ORDER(^IBA(364,"ABABI",IBBDA,IBIFN))
- if 'IBIFN
- QUIT
- SET IB=$ORDER(^IBA(364,"ABABI",IBBDA,IBIFN,""))
- if 'IB
- QUIT
- SET IB0=$GET(^IBA(364,IB,0))
- SET IBS=$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)
- Begin DoDot:1
- +10 IF $DATA(^TMP("IBNOT",$JOB,IB))
- SET IBEXCT=IBEXCT+1
- QUIT
- +11 SET IBSCT=IBSCT+1
- SET IBS1=$PIECE(IB0,U,3)
- +12 IF IBTEST!(IBS>1&(IBS<6)&("CRDZ"'[IBS1))
- SET ^TMP("IBRESUB",$JOB,IB)=IBIFN
- QUIT
- +13 SET IBE(0)=IBE(0)+1
- +14 IF IBS1'=""
- IF "CRDZ"[IBS1
- SET IBE(IBS1)=$GET(IBE(IBS1))+1
- QUIT
- +15 SET IBE=IBE+1
- SET ^TMP("IBNOT",$JOB,IB)=IBIFN
- End DoDot:1
- +16 ;
- +17 IF 'IBTEST
- IF 'IBE(0)
- IF 'IBSCT
- IF '$DATA(^TMP("IBNOT",$JOB))
- DO CKRES^IBCESRV2(IBBDA)
- GOTO RESUBQ
- +18 IF IBE(0)!'IBSCT
- SET Y=1
- Begin DoDot:1
- +19 IF IBE(0)=IBSCT
- WRITE !,*7,"There are no bill(s) in this batch in a valid status to be resubmitted"
- if IBEXCT
- WRITE !,IBEXCT," bill(s) in this batch have been specifically excluded"
- DO PAUSE^VALM1
- SET Y=""
- QUIT
- +20 FOR Z="C","R","D"
- IF $DATA(IBE(Z))
- WRITE !,*7,IBE(Z)," bill(s) in this batch have been ",$SELECT(Z="C":"cancelled",Z="R":"resubmitted",1:"deleted from batch")," previously"
- +21 IF IBE
- WRITE !,*7,IBE," bill(s) in this batch are not in a valid status to be re-submitted"
- +22 IF IBEXCT
- WRITE !,IBEXCT," bill(s) in this batch have been specifically excluded"
- if 'IBE
- QUIT
- +23 KILL DIR
- SET DIR("A")="Do you want to resubmit the other "_(IBSCT-IBE(0))_" bill(s) in this batch?: "
- SET DIR(0)="YA"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +24 WRITE !
- +25 IF 'Y
- WRITE !,*7,"Batch NOT resubmitted"
- DO PAUSE^VALM1
- SET Y=0
- SET IBSTOP=1
- KILL ^TMP("IBRESUB",$JOB),^TMP("IBNOT",$JOB)
- QUIT
- End DoDot:1
- if 'Y
- GOTO RESUBQ
- +26 ;
- +27 SET IBZTSK=""
- +28 IF $ORDER(^TMP("IBRESUB",$JOB,0))
- Begin DoDot:1
- +29 SET ^TMP("IBRESUBMIT",$JOB)=$GET(^TMP("IBRESUB",$JOB))
- +30 SET IB=""
- FOR
- SET IB=$ORDER(^TMP("IBRESUB",$JOB,IB))
- if 'IB
- QUIT
- SET IBIFN=$PIECE($GET(^IBA(364,IB,0)),U)
- SET Y=$SELECT('IBOLD&'IBTEST:$$ADDTBILL^IBCB1(IBIFN),1:IB)
- Begin DoDot:2
- +31 IF IBTEST
- if $DATA(^TMP("IBNOT",$JOB,IB))
- QUIT
- +32 IF 'IBTEST
- IF 'IBOLD
- IF '$PIECE(Y,U,3)
- SET ^TMP("IBNOT",$JOB,IB)=IBIFN
- KILL ^TMP("IBRESUB",$JOB,IB)
- QUIT
- +33 SET ^TMP("IBRESUBMIT",$JOB,+Y)=^TMP("IBRESUB",$JOB,IB)
- SET ^TMP("IBRESUBMIT",$JOB,+Y,"OLD")=$SELECT('IBTEST:IB,1:0)
- End DoDot:2
- +34 DO EN1^IBCE837B(.IBZTSK,0)
- +35 ; No resubmit - delete entries
- IF 'IBTEST
- IF $GET(^TMP("IBRESUBMIT",$JOB))="ABORT"
- Begin DoDot:2
- +36 SET IB=""
- FOR
- SET IB=$ORDER(^TMP("IBRESUBMIT",$JOB,IB))
- if 'IB
- QUIT
- SET DIK="^IBA(364,"
- SET DA=IB
- DO ^DIK
- +37 KILL ^TMP("IBRESUBMIT",$JOB)
- End DoDot:2
- End DoDot:1
- +38 ;task was queued
- IF IBZTSK
- SET ^TMP("IBRESUBMIT",$JOB)=^TMP("IBRESUB",$JOB)
- SET DIE="^IBA(364.1,"
- SET DR=".09////"_IBZTSK
- SET DA=$SELECT('IBTEST:+$PIECE($GET(^TMP("IBRESUBMIT",$JOB)),U,2),1:0)
- if DA
- DO ^DIE
- +39 ;
- RESUBQ QUIT
- +1 ;
- RESUBUP ; Update old entries in file 364 for resubmitted bills, send bulletin
- +1 ; for bills not resubmitted in batch, if any, update new batch(s) with
- +2 ; old batch reference
- +3 NEW IBBA,IBE,IBT,IB,IBV,IBB,XMSUBJ,XMBODY,XMTO,XMDUZ
- +4 ;
- +5 ;Original batch entry #
- SET IBBA=+$PIECE($GET(^TMP("IBRESUBMIT",$JOB)),U,2)
- +6 ;
- +7 IF $ORDER(^TMP("IBNOT",$JOB,0))
- Begin DoDot:1
- +8 SET IBE=5
- SET IB=""
- +9 FOR
- SET IB=$ORDER(^TMP("IBNOT",$JOB,IB))
- if IB=""
- QUIT
- SET IBB=+$GET(^(IB))
- SET IBV=$$DISP^IBCEM3(IBB,"",1)
- Begin DoDot:2
- +10 if "CRDZ"[$PIECE($GET(^IBA(364,IB,0)),U,3)
- QUIT
- +11 SET IBE=IBE+1
- SET IBPT=$PIECE(IBV,U,3)
- +12 SET IBT(IBE)=" "_$EXTRACT($PIECE(IBV,U,2)_$JUSTIFY("",10),1,10)_$EXTRACT($EXTRACT($PIECE(IBPT,"("),1,20)_"("_$PIECE(IBPT,"(",2)_$JUSTIFY("",32),1,32)_" "_$EXTRACT(...
- ... $PIECE(IBV,U,4)_$JUSTIFY("",10),1,10)_" "_$$EXPAND^IBTRE(399,.13,$PIECE($GET(^DGCR(399,IBB,0)),U,13))
- End DoDot:2
- +13 ;Batch resubmit is still incomplete
- IF IBE>5
- Begin DoDot:2
- +14 SET IBT(1)="The resubmission of bills in batch "_$PIECE($GET(^TMP("IBRESUB",$JOB)),U)_" was incomplete."
- +15 SET IBT(2)="The following bills were NOT resubmitted:"
- +16 SET IBT(3)=" "
- SET IBT(4)=" BILL # PATIENT"_$JUSTIFY("",27)_"TYPE BILL STATUS"
- SET IBT(5)=""
- SET $PIECE(IBT(5),"-",76)=""
- SET IBT(5)=" "_IBT(5)
- +17 SET XMSUBJ="BILLS NOT RESUBMITTED WITH THEIR BATCH"
- SET XMBODY="IBT"
- SET XMDUZ=""
- SET XMTO("I:G.IB EDI")=""
- +18 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- +19 IF '$PIECE($GET(^IBE(364.1,IBBA,0)),U,10)
- SET DIE="^IBA(364.1,"
- SET DR=".1////1"
- SET DA=IBBA
- DO ^DIE
- End DoDot:2
- End DoDot:1
- +20 ;
- +21 IF $GET(^TMP("IBRESUBMIT",$JOB,0))
- IF '$PIECE($GET(^TMP("IBRESUBMIT",$JOB)),U,3)
- Begin DoDot:1
- +22 NEW IB,IBCT,IBO,IBIFN
- +23 SET (IB,IBCT)=0
- +24 FOR
- SET IB=$ORDER(^TMP("IBRESUBMIT",$JOB,IB))
- if 'IB
- QUIT
- SET IBIFN=+$GET(^(IB))
- SET IBO=$GET(^(IB,"OLD"))
- if IBO
- Begin DoDot:2
- +25 SET IBCT=IBCT+1
- +26 DO UPDEDI^IBCEM(IBO,"R",1)
- End DoDot:2
- +27 DO CTDOWN(IBBA,IBCT)
- End DoDot:1
- +28 SET DA=IBBA
- SET DIE="^IBA(364.1,"
- SET DR=".09///@;.13///NOW;1.03///NOW;1.04////.5"
- DO ^DIE
- +29 LOCK -^IBA(364.1,DA)
- +30 KILL ^TMP("IBNOT",$JOB),^TMP("IBRESUB",$JOB)
- +31 QUIT
- +32 ;
- CTDOWN(IBBA,IBCT) ; Upd the count, incomplete resubmit status on the batch
- +1 ;IBBA = batch file ien
- +2 ;IBCT = the # to decrease the count
- +3 if 'IBBA
- QUIT
- +4 NEW IBCT1,IBSTAT,IB0
- +5 SET IB0=$GET(^IBA(364.1,IBBA,0))
- SET IBCT1=$PIECE(IB0,U,3)-IBCT
- SET IBSTAT=$PIECE(IB0,U,10)
- +6 if IBCT1<0
- SET IBCT1=0
- +7 SET IBINC=$SELECT('IBSTAT:"",1:$$CKINC^IBCEM02(IBBA))
- SET DIE="^IBA(364.1,"
- SET DR=".03////"_IBCT1_$SELECT(IBINC'="":";.1////"_IBINC,1:"")
- SET DA=IBBA
- DO ^DIE
- +8 QUIT
- +9 ;
- CKINC(IBBA) ;Check to see if batch resubmit is incomplete
- +1 ; IBBA = internal file 364.1 entry # of batch to check
- +2 NEW IBZ,IBINC,DR,DA,DIE
- +3 SET IBZ=""
- SET IBINC=0
- +4 FOR
- SET IBZ=$ORDER(^IBA(364,"ABAST",IBBA,IBZ))
- if IBZ=""
- QUIT
- IF "CRD"'[IBZ
- SET IBINC=1
- QUIT
- +5 QUIT IBINC
- +6 ;
- LOCK(FILE,IBBDA) ; Lock file # FILE entry # IBBDA
- +1 IF IBBDA
- LOCK +^IBA(FILE,IBBDA):5
- +2 QUIT $TEST
- +3 ;