IBCEM03 ;ALB/TMP - 837 EDI RESUBMIT INDIVIDUAL BILL PROCESSING ;17-SEP-96
;;2.0;INTEGRATED BILLING;**137,199,296,348,349,592,623,641**;21-MAR-94;Build 61
;;Per VA Directive 6402, this routine should not be modified.
Q
;
BILL2 ; Resubmit a transmitted bill with a new batch #
N DIC,DIR,DIE,DA,DR,IB,IB0,IBDA,IBDA1,IBE,IBSTAT,IBBDA,IBOK,IBNEW,Y,ZTSK,IBTEST
K ^TMP("IBEDI_TEST_BATCH",$J)
;
S DIR("A")="ARE YOU RESUBMITTING CLAIMS FOR TESTING?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) Q
I +Y S ^TMP("IBEDI_TEST_BATCH",$J)=1
ASK N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
S IBTEST=+$G(^TMP("IBEDI_TEST_BATCH",$J))
; Only auth or printed transmittable bill valid for non-test
; All previously transmitted valid for test
S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")=$S('IBTEST:"I $P($G(^(""TX"")),U,2),$P($G(^(0)),U,13)'="""",""234""[$P($G(^(0)),U,13)",1:"I $O(^IBA(364,""B"",+Y,0))")
I IBTEST S DIC("A")="Select BILL/CLAIMS BILL NUMBER (FOR RESUBMIT AS TEST): "
D ^DIC K DIC
I Y<0 D Q
. Q:'IBTEST
. I $O(^TMP("IBEDI_TEST_BATCH",$J,0)) D
.. M ^TMP("IBRESUBMIT",$J)=^TMP("IBEDI_TEST_BATCH",$J)
.. D ONE^IBCE837
. ;
. K ^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBRESUBMIT",$J)
;
S IBIFN=+Y,IBDA=+$$LAST364^IBCEF4(IBIFN),IB0=$G(^IBA(364,IBDA,0)),IBSTAT=$P(IB0,U,3)
;
I IB0="" W !,"Bill does not exist in BILL TRANSMISSION file" G ASK
I IBTEST,$D(^TMP("IBEDI_TEST_BATCH",$J,IBDA)) W !,"Bill already selected for test transmission" G ASK
I $$COBN^IBCEF(IBIFN)=1,IBTEST S IBOK=1 D G:'IBOK ASK
. S DIR("A")="BILL IS A PRIMARY BILL, ARE YOU SURE YOU WANT TO SEND IT AS A TEST CLAIM?: "
. S DIR("B")="NO",DIR(0)="YA" W ! D ^DIR K DIR
. I Y'=1 S IBOK=0
;
I 'IBTEST,IBSTAT="X" W !,"Bill is currently awaiting extract - will be submitted with next batch run" G ASK
S IBBDA=+$P(IB0,U,2),IB=$P($G(^IBA(364.1,IBBDA,0)),U,9)
;
I IB,'IBTEST D G:'IBOK ASK
. S IBOK=1,ZTSK=IB 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 bill.",!,"This bill's current batch is already ",$S("2"[ZTSK(1):"being resubmitted",1:"scheduled for resubmission")," - Task # is: ",IB,! S IBOK=0
;
W !
S DIR("A",1)=" Previously In Batch #: "_$$EXPAND^IBTRE(364,.02,$P(IB0,U,2))
S DIR("A",2)="Bill Transmission Status: "_$$EXPAND^IBTRE(364,.03,IBSTAT)
S DIR("A",3)=" Status Date: "_$$FMTE^XLFDT($P(IB0,U,4),2)
S DIR("A",5)=" "
S DIR("A",4)=" Current Bill Status: "_$$EXPAND^IBTRE(399,.13,$P($G(^DGCR(399,+IBIFN,0)),U,13))
I 'IBTEST,IBSTAT'="P" S DIR("A",11)="WARNING - BILL TRANSMITTED PREVIOUSLY" S:IBSTAT?1"A".E DIR("A",11)=DIR("A",11)_" & CONFIRMED AS RECEIVED BY "_$P("AUSTIN^GENTRAN^INTERMEDIARY^CARRIER",U,$TR(IBSTAT,"A")+1)
S DIR("A")="ARE YOU SURE YOU WANT TO RESUBMIT THIS BILL"_$S('IBTEST:"",1:" AS A TEST CLAIM")_"?: "
S DIR(0)="YA",DIR("B")="NO"
D ^DIR K DIR
;
W ! G:'Y ASK
;
I IBTEST S ^TMP("IBEDI_TEST_BATCH",$J,IBDA)="" G ASK
;
S IBDA1=+$$ADDTBILL^IBCB1(IBIFN) ;Add a new transmit bill record
;
S Y=$$TX1^IBCB1(IBDA1,1)
;
I 'Y D G ASK
. W !,*7,"An error has occurred ... bill NOT re-submitted!!"
. S DIK="^IBA(364,",DA=IBDA1 D:DA ^DIK
. L -^IBA(364,IBDA)
;
S IBNEW=$P($G(^IBA(364,+IBDA1,0)),U,2)
;
;Update the old transmit bill record
D UPDEDI^IBCEM(IBDA,"R")
;
W !,"Bill # ",$P($G(^DGCR(399,+IB0,0)),U)," was re-submitted in batch # ",$P($G(^IBA(364.1,+IBNEW,0)),U)
;
L -^IBA(364,IBDA)
G ASK
;
PRINT1(IBIFN,IBDA,IB364,IBRESUB,IBRESULT) ; Print bill, submit manually as resolution ;WCJ;IB641;US3380; added IBRESULT
; for a returned message
; IBIFN = ien of bill in file 399
; IBDA = array returned from selection of message
; IB364 = ien of transmit bill entry in file 364
; IBRESUB = flag to indicate if bill is being resubmitted via print
; IBRESULT = flag to see if print was successful
;
N IBAC,IBV,IB399,DFN,ZTSK,PRCASV,IBHOLD,IBTXPRT
S IBRESULT=0 ;WCJ;IB641;US3380; default to unsuccessful completion
W !
I IBIFN="" S IBDA="" G PRINT1Q
S IB399=$G(^DGCR(399,IBIFN,0))
I "34"'[$P(IB399,U,13) W !,*7,"Bill status must be AUTHORIZED or PRNT/TX to print the bill" S IBDA="" G PRINT1Q
;
I $P($G(^DGCR(399,IBIFN,"S")),U,14)=DT W !,*7,"This bill was last printed today. You must wait at least 1 day from the last",!,"print date to print this bill using this function." S IBDA="" D PAUSE^VALM1 G PRINT1Q
;
S IBV=1,IBAC=4,DFN=$P(IB399,U,2),IBTXPRT=0
M IBHOLD("IBDA")=IBDA
;D 4^IBCB1,ENS^%ZISS ;WCJ;IB641;US3380
D ALT4^IBCB1(.IBRESULT),ENS^%ZISS ;WCJ;IB641;US3380;adding parameter
M IBDA=IBHOLD("IBDA")
;
I 'IBTXPRT W !,"Bill was not printed" S IBDA="" G PRINT1Q
;
S IBRESULT=1 ;WCJ;IB641;US3380; got past the not printed message so we must have printed, am I right?
;
D UPDEDI^IBCEM(IB364,"P")
;
PRINT1Q Q
;
SUB1 ; Select bills in ready for extract status to transmit individually
N IB0,IB399,IBDA,IBIFN,IBSEL,IBU,X,Y,DA,DIC,Z,DIR
K ^TMP("IBSELX",$J)
;
S IBSEL=""
F D Q:'IBSEL
. S DIR("S")="I $P(^(0),U,3)=""X"""
. S DIR(0)="PAO^364:AEMQ",DIR("A")="SELECT "_$S($D(^TMP("IBSELX",$J)):"NEXT ",1:"")_"BILL TO TRANSMIT: "
. S DIR("?")="ONLY BILLS IN 'READY FOR EXTRACT' STATUS CAN BE TRANSMITTED WITH THIS OPTION"
. D ^DIR K DIR
. I Y'>0 K:Y=U ^TMP("IBSELX",$J) S IBSEL="" Q
. S IBSEL=+Y
. S IBDA=+Y,IB0=$G(^IBA(364,IBDA,0)),IBIFN=+IB0,IBU=$G(^DGCR(399,IBIFN,"U")),IB399=$G(^(0))
. S Z=+$$NEEDMRA^IBEFUNC(IBIFN)
. I '$$TXMT^IBCEF4(IBIFN,.IBNOTX),IBNOTX=2 D Q
.. W !,$S(Z:"MRA",1:"EDI")_" TRANSMISSION PARAMETER HAS BEEN TURNED OFF",!!,"BILL CANNOT BE SELECTED"
. ;
. W !
. ;JWS;IB*2.0*592; added form #7 J430D to display
. S DIR("A",1)=" YOU HAVE SELECTED BILL #: "_$P(IB399,U)_" ("_$S($$INPAT^IBCEF(IBIFN):"INPATIENT",1:"OUTPATIENT")_"/"_$S($$FT^IBCEF(IBIFN)=3:"UB-04",$$FT^IBCEF(IBIFN)=7:"J430D",1:"CMS-1500")_" FORMAT)"
. S DIR("A",2)=" PATIENT NAME: "_$E($P($G(^DPT(+$P(IB399,U,2),0)),U)_$J("",28),1,28)_" SSN: "_$P($G(^DPT(+$P(IB399,U,2),0)),U,9)
. S DIR("A",3)=" CARE DATE(S): "_$$EXPAND^IBTRE(399,151,$P(IBU,U))_" - "_$$EXPAND^IBTRE(399,152,$P(IBU,U,2))
. S DIR("A",4)="'READY TO EXTRACT' STATUS DATE: "_$$EXPAND^IBTRE(364,.04,$P(IB0,U,4))
. S DIR("?",1)=" "
. S DIR("A",5)=" ",DIR("?")="IF THIS IS THE BILL YOU WANT TO TRANSMIT, RESPOND YES, OTHERWISE, RESPOND NO"
. S DIR("A")="ARE YOU SURE THIS IS THE CORRECT BILL TO TRANSMIT?: "
. S DIR(0)="YAO",DIR("B")="NO" D ^DIR K DIR W !
. I Y'=1 W !,"BILL NOT SELECTED" Q
. ;
. S ^TMP("IBSELX",$J,IBDA)=""
;
I '$O(^TMP("IBSELX",$J,0)) G SUB1Q
;
W !,"Bills to be transmitted: "
S Z=0 F S Z=$O(^TMP("IBSELX",$J,Z)) Q:'Z W !,?8,$P($G(^DGCR(399,+$G(^IBA(364,Z,0)),0)),U)
W !
S DIR("A")="OK TO TRANSMIT NOW?: ",DIR(0)="YA0",DIR("B")="NO" D ^DIR K DIR
G:Y'=1 SUB1Q
W !
S ^TMP("IBSELX",$J)=0
D ONE^IBCE837
;JWS;IB*2.0*623;if 837 FHIR enabled, display appropriate message
I $$GET1^DIQ(350.9,"1,",8.21,"I") D G SUB1Q
. W !,"BILL(s) placed onto 837 FHIR Transaction list. They will be submitted shortly..."
W !,"BILL(s) TRANSMITTED ... BATCH #(s): "
S Z=0 F S Z=$O(^TMP("IBCE-BATCH",$J,Z)) Q:'Z W Z,$S($O(^(Z)):", ",1:"")
I '$O(^TMP("IBCE-BATCH",$J,0)) W !,"NO BILL(S) TRANSMITTED - CHECK ALERTS/MAIL FOR DETAILS"
;
SUB1Q D PAUSE^VALM1
K ^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEM03 7518 printed Nov 22, 2024@17:20:49 Page 2
IBCEM03 ;ALB/TMP - 837 EDI RESUBMIT INDIVIDUAL BILL PROCESSING ;17-SEP-96
+1 ;;2.0;INTEGRATED BILLING;**137,199,296,348,349,592,623,641**;21-MAR-94;Build 61
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
BILL2 ; Resubmit a transmitted bill with a new batch #
+1 NEW DIC,DIR,DIE,DA,DR,IB,IB0,IBDA,IBDA1,IBE,IBSTAT,IBBDA,IBOK,IBNEW,Y,ZTSK,IBTEST
+2 KILL ^TMP("IBEDI_TEST_BATCH",$JOB)
+3 ;
+4 SET DIR("A")="ARE YOU RESUBMITTING CLAIMS FOR TESTING?: "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 IF +Y
SET ^TMP("IBEDI_TEST_BATCH",$JOB)=1
ASK ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+1 SET IBTEST=+$GET(^TMP("IBEDI_TEST_BATCH",$JOB))
+2 ; Only auth or printed transmittable bill valid for non-test
+3 ; All previously transmitted valid for test
+4 SET DIC="^DGCR(399,"
SET DIC(0)="AEMQ"
SET DIC("S")=$SELECT('IBTEST:"I $P($G(^(""TX"")),U,2),$P($G(^(0)),U,13)'="""",""234""[$P($G(^(0)),U,13)",1:"I $O(^IBA(364,""B"",+Y,0))")
+5 IF IBTEST
SET DIC("A")="Select BILL/CLAIMS BILL NUMBER (FOR RESUBMIT AS TEST): "
+6 DO ^DIC
KILL DIC
+7 IF Y<0
Begin DoDot:1
+8 if 'IBTEST
QUIT
+9 IF $ORDER(^TMP("IBEDI_TEST_BATCH",$JOB,0))
Begin DoDot:2
+10 MERGE ^TMP("IBRESUBMIT",$JOB)=^TMP("IBEDI_TEST_BATCH",$JOB)
+11 DO ONE^IBCE837
End DoDot:2
+12 ;
+13 KILL ^TMP("IBEDI_TEST_BATCH",$JOB),^TMP("IBRESUBMIT",$JOB)
End DoDot:1
QUIT
+14 ;
+15 SET IBIFN=+Y
SET IBDA=+$$LAST364^IBCEF4(IBIFN)
SET IB0=$GET(^IBA(364,IBDA,0))
SET IBSTAT=$PIECE(IB0,U,3)
+16 ;
+17 IF IB0=""
WRITE !,"Bill does not exist in BILL TRANSMISSION file"
GOTO ASK
+18 IF IBTEST
IF $DATA(^TMP("IBEDI_TEST_BATCH",$JOB,IBDA))
WRITE !,"Bill already selected for test transmission"
GOTO ASK
+19 IF $$COBN^IBCEF(IBIFN)=1
IF IBTEST
SET IBOK=1
Begin DoDot:1
+20 SET DIR("A")="BILL IS A PRIMARY BILL, ARE YOU SURE YOU WANT TO SEND IT AS A TEST CLAIM?: "
+21 SET DIR("B")="NO"
SET DIR(0)="YA"
WRITE !
DO ^DIR
KILL DIR
+22 IF Y'=1
SET IBOK=0
End DoDot:1
if 'IBOK
GOTO ASK
+23 ;
+24 IF 'IBTEST
IF IBSTAT="X"
WRITE !,"Bill is currently awaiting extract - will be submitted with next batch run"
GOTO ASK
+25 SET IBBDA=+$PIECE(IB0,U,2)
SET IB=$PIECE($GET(^IBA(364.1,IBBDA,0)),U,9)
+26 ;
+27 IF IB
IF 'IBTEST
Begin DoDot:1
+28 SET IBOK=1
SET ZTSK=IB
DO STAT^%ZTLOAD
+29 ;Task not scheduled - delete task #
IF ZTSK(0)=0
SET DIE="^IBA(364.1,"
SET DA=IBBDA
SET DR=".09///@"
DO ^DIE
QUIT
+30 IF "125"[ZTSK(1)
WRITE *7,!,"Cannot resubmit this bill.",!,"This bill's current batch is already ",$SELECT("2"[ZTSK(1):"being resubmitted",1:"scheduled for resubmission")," - Task # is: ",IB,!
SET IBOK=0
End DoDot:1
if 'IBOK
GOTO ASK
+31 ;
+32 WRITE !
+33 SET DIR("A",1)=" Previously In Batch #: "_$$EXPAND^IBTRE(364,.02,$PIECE(IB0,U,2))
+34 SET DIR("A",2)="Bill Transmission Status: "_$$EXPAND^IBTRE(364,.03,IBSTAT)
+35 SET DIR("A",3)=" Status Date: "_$$FMTE^XLFDT($PIECE(IB0,U,4),2)
+36 SET DIR("A",5)=" "
+37 SET DIR("A",4)=" Current Bill Status: "_$$EXPAND^IBTRE(399,.13,$PIECE($GET(^DGCR(399,+IBIFN,0)),U,13))
+38 IF 'IBTEST
IF IBSTAT'="P"
SET DIR("A",11)="WARNING - BILL TRANSMITTED PREVIOUSLY"
if IBSTAT?1"A".E
SET DIR("A",11)=DIR("A",11)_" & CONFIRMED AS RECEIVED BY "_$PIECE("AUSTIN^GENTRAN^INTERMEDIARY^CARRIER",U,$TRANSLATE(IBSTAT,"A")+1)
+39 SET DIR("A")="ARE YOU SURE YOU WANT TO RESUBMIT THIS BILL"_$SELECT('IBTEST:"",1:" AS A TEST CLAIM")_"?: "
+40 SET DIR(0)="YA"
SET DIR("B")="NO"
+41 DO ^DIR
KILL DIR
+42 ;
+43 WRITE !
if 'Y
GOTO ASK
+44 ;
+45 IF IBTEST
SET ^TMP("IBEDI_TEST_BATCH",$JOB,IBDA)=""
GOTO ASK
+46 ;
+47 ;Add a new transmit bill record
SET IBDA1=+$$ADDTBILL^IBCB1(IBIFN)
+48 ;
+49 SET Y=$$TX1^IBCB1(IBDA1,1)
+50 ;
+51 IF 'Y
Begin DoDot:1
+52 WRITE !,*7,"An error has occurred ... bill NOT re-submitted!!"
+53 SET DIK="^IBA(364,"
SET DA=IBDA1
if DA
DO ^DIK
+54 LOCK -^IBA(364,IBDA)
End DoDot:1
GOTO ASK
+55 ;
+56 SET IBNEW=$PIECE($GET(^IBA(364,+IBDA1,0)),U,2)
+57 ;
+58 ;Update the old transmit bill record
+59 DO UPDEDI^IBCEM(IBDA,"R")
+60 ;
+61 WRITE !,"Bill # ",$PIECE($GET(^DGCR(399,+IB0,0)),U)," was re-submitted in batch # ",$PIECE($GET(^IBA(364.1,+IBNEW,0)),U)
+62 ;
+63 LOCK -^IBA(364,IBDA)
+64 GOTO ASK
+65 ;
PRINT1(IBIFN,IBDA,IB364,IBRESUB,IBRESULT) ; Print bill, submit manually as resolution ;WCJ;IB641;US3380; added IBRESULT
+1 ; for a returned message
+2 ; IBIFN = ien of bill in file 399
+3 ; IBDA = array returned from selection of message
+4 ; IB364 = ien of transmit bill entry in file 364
+5 ; IBRESUB = flag to indicate if bill is being resubmitted via print
+6 ; IBRESULT = flag to see if print was successful
+7 ;
+8 NEW IBAC,IBV,IB399,DFN,ZTSK,PRCASV,IBHOLD,IBTXPRT
+9 ;WCJ;IB641;US3380; default to unsuccessful completion
SET IBRESULT=0
+10 WRITE !
+11 IF IBIFN=""
SET IBDA=""
GOTO PRINT1Q
+12 SET IB399=$GET(^DGCR(399,IBIFN,0))
+13 IF "34"'[$PIECE(IB399,U,13)
WRITE !,*7,"Bill status must be AUTHORIZED or PRNT/TX to print the bill"
SET IBDA=""
GOTO PRINT1Q
+14 ;
+15 IF $PIECE($GET(^DGCR(399,IBIFN,"S")),U,14)=DT
WRITE !,*7,"This bill was last printed today. You must wait at least 1 day from the last",!,"print date to print this bill using this function."
SET IBDA=""
DO PAUSE^VALM1
GOTO PRINT1Q
+16 ;
+17 SET IBV=1
SET IBAC=4
SET DFN=$PIECE(IB399,U,2)
SET IBTXPRT=0
+18 MERGE IBHOLD("IBDA")=IBDA
+19 ;D 4^IBCB1,ENS^%ZISS ;WCJ;IB641;US3380
+20 ;WCJ;IB641;US3380;adding parameter
DO ALT4^IBCB1(.IBRESULT)
DO ENS^%ZISS
+21 MERGE IBDA=IBHOLD("IBDA")
+22 ;
+23 IF 'IBTXPRT
WRITE !,"Bill was not printed"
SET IBDA=""
GOTO PRINT1Q
+24 ;
+25 ;WCJ;IB641;US3380; got past the not printed message so we must have printed, am I right?
SET IBRESULT=1
+26 ;
+27 DO UPDEDI^IBCEM(IB364,"P")
+28 ;
PRINT1Q QUIT
+1 ;
SUB1 ; Select bills in ready for extract status to transmit individually
+1 NEW IB0,IB399,IBDA,IBIFN,IBSEL,IBU,X,Y,DA,DIC,Z,DIR
+2 KILL ^TMP("IBSELX",$JOB)
+3 ;
+4 SET IBSEL=""
+5 FOR
Begin DoDot:1
+6 SET DIR("S")="I $P(^(0),U,3)=""X"""
+7 SET DIR(0)="PAO^364:AEMQ"
SET DIR("A")="SELECT "_$SELECT($DATA(^TMP("IBSELX",$JOB)):"NEXT ",1:"")_"BILL TO TRANSMIT: "
+8 SET DIR("?")="ONLY BILLS IN 'READY FOR EXTRACT' STATUS CAN BE TRANSMITTED WITH THIS OPTION"
+9 DO ^DIR
KILL DIR
+10 IF Y'>0
if Y=U
KILL ^TMP("IBSELX",$JOB)
SET IBSEL=""
QUIT
+11 SET IBSEL=+Y
+12 SET IBDA=+Y
SET IB0=$GET(^IBA(364,IBDA,0))
SET IBIFN=+IB0
SET IBU=$GET(^DGCR(399,IBIFN,"U"))
SET IB399=$GET(^(0))
+13 SET Z=+$$NEEDMRA^IBEFUNC(IBIFN)
+14 IF '$$TXMT^IBCEF4(IBIFN,.IBNOTX)
IF IBNOTX=2
Begin DoDot:2
+15 WRITE !,$SELECT(Z:"MRA",1:"EDI")_" TRANSMISSION PARAMETER HAS BEEN TURNED OFF",!!,"BILL CANNOT BE SELECTED"
End DoDot:2
QUIT
+16 ;
+17 WRITE !
+18 ;JWS;IB*2.0*592; added form #7 J430D to display
+19 SET DIR("A",1)=" YOU HAVE SELECTED BILL #: "_$PIECE(IB399,U)_" ("_$SELECT($$INPAT^IBCEF(IBIFN):"INPATIENT",1:"OUTPATIENT")_"/"_$SELECT($$FT^IBCEF(IBIFN)=3:"UB-04",$$FT^IBCEF(IBIFN)=7:"J430D",1:"CMS-1500")_" FORMAT)"
+20 SET DIR("A",2)=" PATIENT NAME: "_$EXTRACT($PIECE($GET(^DPT(+$PIECE(IB399,U,2),0)),U)_$JUSTIFY("",28),1,28)_" SSN: "_$PIECE($GET(^DPT(+$PIECE(IB399,U,2),0)),U,9)
+21 SET DIR("A",3)=" CARE DATE(S): "_$$EXPAND^IBTRE(399,151,$PIECE(IBU,U))_" - "_$$EXPAND^IBTRE(399,152,$PIECE(IBU,U,2))
+22 SET DIR("A",4)="'READY TO EXTRACT' STATUS DATE: "_$$EXPAND^IBTRE(364,.04,$PIECE(IB0,U,4))
+23 SET DIR("?",1)=" "
+24 SET DIR("A",5)=" "
SET DIR("?")="IF THIS IS THE BILL YOU WANT TO TRANSMIT, RESPOND YES, OTHERWISE, RESPOND NO"
+25 SET DIR("A")="ARE YOU SURE THIS IS THE CORRECT BILL TO TRANSMIT?: "
+26 SET DIR(0)="YAO"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
WRITE !
+27 IF Y'=1
WRITE !,"BILL NOT SELECTED"
QUIT
+28 ;
+29 SET ^TMP("IBSELX",$JOB,IBDA)=""
End DoDot:1
if 'IBSEL
QUIT
+30 ;
+31 IF '$ORDER(^TMP("IBSELX",$JOB,0))
GOTO SUB1Q
+32 ;
+33 WRITE !,"Bills to be transmitted: "
+34 SET Z=0
FOR
SET Z=$ORDER(^TMP("IBSELX",$JOB,Z))
if 'Z
QUIT
WRITE !,?8,$PIECE($GET(^DGCR(399,+$GET(^IBA(364,Z,0)),0)),U)
+35 WRITE !
+36 SET DIR("A")="OK TO TRANSMIT NOW?: "
SET DIR(0)="YA0"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+37 if Y'=1
GOTO SUB1Q
+38 WRITE !
+39 SET ^TMP("IBSELX",$JOB)=0
+40 DO ONE^IBCE837
+41 ;JWS;IB*2.0*623;if 837 FHIR enabled, display appropriate message
+42 IF $$GET1^DIQ(350.9,"1,",8.21,"I")
Begin DoDot:1
+43 WRITE !,"BILL(s) placed onto 837 FHIR Transaction list. They will be submitted shortly..."
End DoDot:1
GOTO SUB1Q
+44 WRITE !,"BILL(s) TRANSMITTED ... BATCH #(s): "
+45 SET Z=0
FOR
SET Z=$ORDER(^TMP("IBCE-BATCH",$JOB,Z))
if 'Z
QUIT
WRITE Z,$SELECT($ORDER(^(Z)):", ",1:"")
+46 IF '$ORDER(^TMP("IBCE-BATCH",$JOB,0))
WRITE !,"NO BILL(S) TRANSMITTED - CHECK ALERTS/MAIL FOR DETAILS"
+47 ;
SUB1Q DO PAUSE^VALM1
+1 KILL ^TMP("IBSELX",$JOB),^TMP("IBCE-BATCH",$JOB)
+2 QUIT
+3 ;
