- IBCB1 ;ALB/AAS - Process bill after enter/edited ;2-NOV-89
- ;;2.0;INTEGRATED BILLING;**70,106,51,137,161,182,155,327,432,592,623,641,718**;21-MAR-94;Build 73
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;MAP TO DGCRB1
- ;
- ;IBQUIT = Flag to stop processing
- ;IBVIEW = Flag for Bill has been viewed
- ;IBDISP = Flag for Bill entering display been viewed.
- ;
- K ^UTILITY($J) I $D(IBAC),IBAC>1 G @IBAC
- 1 ;complete bill
- D END,EDITS^IBCB2 G:IBQUIT END
- ;
- I '$$IICM^IBCB2(IBIFN) G END ; Ingenix ClaimsManager
- I '$$IIQMED^IBCB2(IBIFN) G END ; DSS QuadraMed Claims Scrubber
- ;
- 3 ;authorize bill/request MRA
- I '$D(^XUSEC("IB AUTHORIZE",DUZ))!('$D(IBIFN)) W !!,"You do not hold the Authorize Key.",! G END
- I '$P($G(^IBE(350.9,1,1)),"^",23),DUZ=$P(^DGCR(399,IBIFN,"S"),"^",2) W !!,"Entering user can not authorize.",! G END
- I $P(^DGCR(399,IBIFN,"S"),"^",9) W !,"Already Approved, Can't change" G END
- D:'$G(IBAC)!($G(IBAC)>1) EDITS^IBCB2 G:IBQUIT END
- ;
- I $G(IBAC)'=1,'$$IICM^IBCB2(IBIFN) G END ; Ingenix ClaimsManager
- I $G(IBAC)'=1,'$$IIQMED^IBCB2(IBIFN) G END ; DSS QuadraMed Claims Scrubber
- ;
- AUTH S IBMRA=$$REQMRA^IBEFUNC(IBIFN)
- S IBEND=0
- I IBMRA["R" D AUTH^IBCB11 G:IBEND END ;MRA normally required, but MEDIGAP ins co
- ; doesn't want/need it or MRA parameter off
- ;
- W !!,"THIS BILL WILL "_$P("NOT ^",U,$$TXMT^IBCEF4(IBIFN)+1)_"BE TRANSMITTED ELECTRONICALLY"
- W !!,"WANT TO ",$S('IBMRA:"AUTHORIZE BILL",1:"REQUEST AN MRA")," AT THIS TIME" S %=2 D YN^DICN G:%=-1!(%=2) END
- I '% W !?4,"YES - If finished entering bill information and to allow bill to be printed or transmitted",!?4,"No - To take no action" G AUTH
- S (DIC,DIE)=399,IBYY=$S('IBMRA:"@90",1:"@901"),DA=IBIFN,DR="[IB STATUS]" D ^DIE K DIC,DIE,IBYY D:$D(IBX3) DISAP^IBCBULL
- I $S('IBMRA:'$P(^DGCR(399,IBIFN,"S"),"^",9),1:'$P($G(^DGCR(399,IBIFN,"TX")),U,6)) G END
- ;
- ; Update the review status for all EOB's on file
- D STAT^IBCEMU2(IBIFN,3) ; Accepted - Complete EOB
- ;
- D AUTOCK^IBCEU2(IBIFN) ; Checks for need to add any codes to bill based on information already on bill, specifically for EDI purposes
- S IBTXSTAT=$$TXMT^IBCEF4(IBIFN,,1) ;Determine transmit, whether live/test
- I IBTXSTAT D I IBMRA D CTCOPY^IBCCCB(IBIFN,1) G END
- .W !," Adding "
- .W:+IBTXSTAT=2 "test " W "bill to BILL TRANSMISSION File"_$S('IBMRA:"",1:" for MRA submission")_".",!
- .W:+IBTXSTAT=1&IBMRA " Bill is no longer editable unless returned in error from Medicare."
- .S Y=$$ADDTBILL(IBIFN,+IBTXSTAT)
- .W ! W:'$P(Y,U,3) *7 W $S($P(Y,U,3):" Bill will be submitted electronically",1:" Error loading into transmit file - bill can not be transmitted.")
- .;JWS;IB*2.0*623v24;begin
- .N IB364
- .S IB364=$P(Y,U)
- .I $$GET1^DIQ(399,IBIFN_",",23,"I") D
- .. D SETSUB^IBCE837I(IB364,1)
- .. N DA,DR,DIE,X,Y
- .. S DA=IBIFN,DIE="^DGCR(399,",DR="23////0" D ^DIE
- .. Q
- .;JWS;IB*2.0*623v24;end
- ;
- W !,"Passing completed Bill to Accounts Receivable. Bill is no longer editable."
- D ARPASS(IBIFN,1)
- G:'$G(PRCASV("OKAY")) END
- W !,"Completed Bill Successfully sent to Accounts Receivable." D FIND^IBOHCK(DFN,IBIFN)
- ;
- ; Check to see if any unreviewed status messages or EOBs on file and
- ; what to do about them
- N IBTXBARR
- S IBRESUB=$$RESUB^IBCECSA4($S($G(IBCNCOPY):$P($G(^DGCR(399,IBIFN,0)),U,15),1:IBIFN),+IBTXSTAT,"E",.IBTXBARR)
- I IBRESUB=2 D ; update review statuses to be 'review complete'
- . N IBDA S IBDA=0
- . F S IBDA=$O(IBTXBARR(IBDA)) Q:'IBDA D UPDEDI^IBCEM(IBDA,$S($G(IBCNCOPY):"R",1:"E"))
- . Q
- ;
- K IBTXPRT
- ;
- 4 ;generate/print bill
- G:'$D(IBIFN) END
- S:'$D(IBMRA) IBMRA=+$$NEEDMRA^IBEFUNC(IBIFN)
- I 'IBMRA,'$P(^DGCR(399,IBIFN,"S"),"^",9) W !!,*7,"Not Authorized, Can Not Print!" G END
- I IBMRA,'$P(^DGCR(399,IBIFN,"TX"),"^",6) W !!,*7,"Not Ready For MRA Submission, Can Not Print!" G END
- S IBTXSTAT=$$TXMT^IBCEF4(IBIFN)
- I IBMRA,$$NEEDMRA^IBEFUNC(IBIFN)'["R" W !!,*7,"MRA Submission not yet confirmed by Austin, Can Not Print!" Q:$S('IBTXSTAT:1,1:"XP"'[$P($G(^IBA(364,+$$LAST364^IBCEF4(IBIFN),0)),U,3))
- I +IBTXSTAT,$D(^IBA(364,"ABDT",IBIFN)) S IBTXOK="" D I 'IBTXOK S %=2 G GENTX
- . N IBX,IBTST
- . S IBX=+$$LAST364^IBCEF4(IBIFN),IBTST=""
- . I $$TEST^IBCEF4(IBIFN) S (IBTXOK,IBTST)=1
- . I "XP"[$P($G(^IBA(364,IBX,0)),U,3) D:'IBTST Q
- .. ;JWS;IB*2.0*592
- .. I $$FT^IBCEF(IBIFN)=7 W !!,*7,"This Bill Can Not Be Printed"
- .. E W !!,*7,"This Bill Can Not Be Printed Until Transmit Confirmed"
- .. W:IBMRA " (to request an MRA)" D:'$D(IBVIEW) VIEW^IBCB2
- . W !!,"This Bill Has Already Been Transmitted" W:IBMRA " (to request an MRA)"
- . S DIR("B")="Y",DIR("A")="WANT TO PRINT IT ANYWAY",DIR(0)="Y" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)!'Y S IBTXOK=1
- D DISP^IBCB2
- S:'$D(IBQUIT) IBQUIT=0
- D:'$D(IBVIEW) VIEW^IBCB2 G:IBQUIT END
- S IBPNT=$P(^DGCR(399,IBIFN,"S"),"^",12)
- GEN I $$TEST^IBCEF4(IBIFN) W !!,"THIS BILL IS BEING USED AS A TRANSMISSION TEST BILL"
- ;IB*2.0*718v5;EBILL-156;JWS;remove PRINT prompt for Dental Claims
- I $$FT^IBCEF(IBIFN)=7 D:+$G(IBAC)=1 END,CTCOPY^IBCCCB(IBIFN) G END
- W !!,"WANT TO ",$S(IBPNT]"":"RE-",1:""),"PRINT BILL AT THIS TIME" S %=2 D YN^DICN I %=-1 D:+$G(IBAC)=1 END,CTCOPY^IBCCCB(IBIFN) G END
- I '% W !?4,"YES - to print the bill now",!?4,"NO - To take no action" G GEN
- ;JWS;IB*2.0*592
- ;IB*2.0*718v5;EBILL-156;JWS;remove PRINT prompt for Dental claims
- ;;I %=1,$$FT^IBCEF(IBIFN)=7 W !!,*7,"Dental Claims can not be printed." G END
- GENTX I %'=1 D:+$G(IBAC)=1 END,CTCOPY^IBCCCB(IBIFN) G END
- ;
- N IBABORT ;WCJ;US3380
- ; Bill has never been printed. First time print.
- I 'IBPNT D G END
- . I $D(IBTXPRT) D TXPRTS
- . D EN1^IBCF(.IBABORT) ;WCJ;US3380
- . Q:$G(IBABORT) ;WCJ;IB641;V13;US3380;they aborted so stop already
- . I $D(IBRESULT) S IBRESULT=1 ;WCJ;IB641;US3380; if it is looking for a result (IBRESULT will be defined)
- . I $D(IBTXPRT) D TXPRT
- . ;D MRA^IBCEMU1(IBIFN) ; Printing the MRA ;WCJ;IB*2.0*432;MRA may have a different claim number if this is tertiary
- . D MRA^IBCEMU1($$GETMRACL^IBCAPR(IBIFN)) ;WCJ;IB*2.0*432;see above
- . I $G(IBMRANOT) D EOBALL^IBCAPR2(IBIFN) ;WCJ;IB*2.0*432 print all the EOBs (ask device once)
- . I +$G(IBAC)=1 D END,CTCOPY^IBCCCB(IBIFN)
- . Q
- ;
- ; Below section is for re-prints
- RPNT G:$$NEEDMRA^IBEFUNC(IBIFN) END
- R !!,"(2)nd Notice, (3)rd Notice, (C)opy or (O)riginal: C// ",IBPNT:DTIME S:IBPNT="" IBPNT="C" G:IBPNT["^" END
- S IBPNT=$E(IBPNT,1) I "23oOcC"'[IBPNT W !?5,"Enter 'O' to reprint the original bill or",!?5,"Enter 'C' to reprint the bill as a duplicate copy or",!?5,"Enter '2' or '3' to print 2nd or 3rd follow-up notices." S IBPNT=1 G RPNT
- W " (",$S("cC"[IBPNT:"COPY","oO"[IBPNT:"ORIGINAL",IBPNT=2:"2nd NOTICE",IBPNT=3:"3rd NOTICE",1:""),")"
- I $D(IBTXPRT) D
- . D TXPRTS
- . I "oOcC"[IBPNT S IBRESUB=$$RESUB^IBCECSA4(IBIFN,1,"P")
- S IBPNT=$S("oO"[IBPNT:1,"cC"[IBPNT:0,1:IBPNT)
- D EN1X^IBCF(.IBABORT)
- I $G(IBABORT) G END ; WCJ;IB641;V13;only do this stuff if it actually printed (was not ABORTED)
- I $D(IBRESULT) S IBRESULT=1 ;WCJ;IB641;US3380; if it is looking for a result (IBRESULT will be defined)
- D:$D(IBTXPRT) TXPRT
- D MRA^IBCEMU1(IBIFN) ; Printing the MRA
- ;
- ;
- END K IBER,IBEND D END^IBCBB1 K IBQUIT,IBVIEW,IBDISP,IBST,IB,PRCAERCD,PRCAERR,PRCASVC,PRCAT,DGRA2,IBBT,IBCH,IBNDS,IBOA,IBREV,IBX,DGXRF1,PRCAORA,IBX3,DGBILLBS,DGII,DGVISCNT,DGFIL,DGTE,IBTXOK,IBTXSTAT,IBMRA,IBNOFIX
- K %DT,DIC,DIE,I,J,X,Y,Y1,Y2,IBER,IBDFN,IBDSDT,IBJ,IBNDI1,IBZZ,VA,IBMA,IBXDT,DI,PRCAPAYR,DGBS,DGCNT,DGDA,DGPAG,DGREVC,DGRV,DGTEXT,DGTOTPAG,IBOPV,DGLCNT,DGTEXT1,DGRSPAC,DGSM,IBPNT,DGINPT,DGLL,IBCPTN,IBFL
- K IBRESUB,IBOPV1,IBOPV2,IBCHG,DGBIL1,DGU,DDH,IBA1,IBINS,IBPROC,PRCARI K:'$D(PRCASV("NOTICE")) PRCASV
- K ^TMP("IBXDATA",$J),^TMP("IBXEDIT",$J)
- K IBCISNT,IBCISTAT,IBCIERR ; remove ClaimsManager variables
- Q
- ;
- TX1(IBX,RESUB) ; Transmit a single bill from file 364 entry # IBX
- ; RESUB = flag (1 = resubmitting a bill, 0 = submitting bill 1st time)
- ; Returns 1 if successfully extracted to mailman queue for transmission,
- ; 0 if extract not successful
- N IBTXOK,IBVVSAVE
- K ^TMP("IBRESUBMIT",$J),^TMP("IBONE",$J)
- S IBVVSAVE("IBX")=IBX,^TMP("IBONE",$J)=+$G(RESUB),^($J,IBX)=""
- D ONE^IBCE837
- S IBX=IBVVSAVE("IBX")
- I $P($G(^IBA(364,IBX,0)),U,3)="P" S IBTXOK=1
- K ^TMP("IBONE",$J)
- Q $G(IBTXOK)
- ;
- ARONLY(IBIFN) ; Pass bill to A/R, but that's all
- D ARPASS(IBIFN,0)
- Q
- ;
- ARPASS(IBIFN,UPDOK) ;Pass bill to A/R as NEW BILL
- ;IBIFN = bill entry #
- ;UPDOK = flag 1: if error going to A/R, allow interactive edit
- ; 0: send bulletin to IB EDI for error going to A/R
- Q:+$$STA^PRCAFN(+IBIFN)'=201 ;Must not have been sent previously
- D GVAR^IBCBB
- ;Can't be an ins co that won't reimburse
- Q:$S($P($G(^DGCR(399,IBIFN,0)),U,11)="i":'IBNDMP,1:0)
- D ARRAY^IBCBB1,^PRCASVC6
- D REL^PRCASVC:$G(PRCASV("OKAY"))
- I '$G(PRCASV("OKAY")) D
- . N IBQUIT,IBQUIT1
- . S IBQUIT=0
- . I $G(UPDOK) D Q
- .. F D Q:IBQUIT
- ... D DSPARERR^IBCB2("")
- ... Q:IBQUIT
- ... I $$ASKEDIT^IBCB2($G(IBAC)) D VIEW1^IBCB2 Q
- ... S IBQUIT=1
- . N XMSUB,XMY,XMTEXT,XMDUZ,IBT
- . S XMSUB="ERROR PASSING BILL TO A/R ON CONFIRMATION",XMTEXT="IBT(",XMY="G.IB EDI",XMDUZ=.5
- . S IBT(1)="A problem has been detected while trying to pass bill "_$P($G(^DGCR(399,IBIFN,0)),U)_" to"
- . S IBT(2)="Accounts Receivable when updating the bill's electronic confirmation."
- . S IBT(3)="Please use the option PASS BILL TO A/R to complete this process."
- . D ^XMD
- Q
- ;
- ADDTBILL(IBIFN,TXST,RSUB,IBFHIR) ;Add new transmit bill rec to file 364 for bill IBIFN
- ;JWS;IB*2.0*623;add field .09 setting.
- ; TXST = test flag 1=live, 2=test
- N COB,DD,DO,DIC,DLAYGO,X
- S TXST=($G(TXST)/2\1),COB=$$COB^IBCEF(IBIFN)
- ;JWS;IB*2.0*623v24;force test claim status if not Production system
- I '$$PROD^XUPROD(1) S TXST=1
- ;JWS;IB*2.0*641v9;change setting of FHIR transmit flag to 0 (wait for scheduled time) from 1 (instant)
- ; variable IBFHIR will be passed if needing to send immediate = 1 (rtn IBCE); not implemented but leaving for future knowledge
- ;;S IBFHIR=1 ; forcing to immediate transmit
- ;JWS;IB*2.0*641v7;need to add resbumission flag from IBCEPTC3
- S DIC(0)="L",DIC="^IBA(364,",DLAYGO=364,X=IBIFN,DIC("DR")=".03///X;.04///NOW;.07////"_TXST_";.08////"_COB_$S($$GET1^DIQ(350.9,"1,",8.21,"I")=1:";.09////1",1:"")_$S($G(RSUB)=1:";.1////1",1:"") D FILE^DICN
- Q Y
- ;
- TXPRTS ; Save off last print date to see if bill was reprinted without queueing
- I '$$NEEDMRA^IBEFUNC(IBIFN) S IBTXPRT("PRT")=$P($G(^DGCR(399,IBIFN,"S")),U,14)
- Q
- ;
- TXPRT ; Set variable if print was tasked or bill was printed (last print date changed)
- I '$$NEEDMRA^IBEFUNC(IBIFN),$S($G(ZTSK):1,1:IBTXPRT("PRT")'=$P($G(^DGCR(399,IBIFN,"S")),U,14)) S IBTXPRT=1
- Q
- ;
- ALT4(IBRESULT) ; WCJ;IB641;US3380;added an alternate tag 4 to pass in a parameter (by reference)
- ; to show if the request claim print actually came to a successful conclusion
- S IBRESULT=0
- G 4
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCB1 10993 printed Feb 18, 2025@23:35:06 Page 2
- IBCB1 ;ALB/AAS - Process bill after enter/edited ;2-NOV-89
- +1 ;;2.0;INTEGRATED BILLING;**70,106,51,137,161,182,155,327,432,592,623,641,718**;21-MAR-94;Build 73
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRB1
- +5 ;
- +6 ;IBQUIT = Flag to stop processing
- +7 ;IBVIEW = Flag for Bill has been viewed
- +8 ;IBDISP = Flag for Bill entering display been viewed.
- +9 ;
- +10 KILL ^UTILITY($JOB)
- IF $DATA(IBAC)
- IF IBAC>1
- GOTO @IBAC
- 1 ;complete bill
- +1 DO END
- DO EDITS^IBCB2
- if IBQUIT
- GOTO END
- +2 ;
- +3 ; Ingenix ClaimsManager
- IF '$$IICM^IBCB2(IBIFN)
- GOTO END
- +4 ; DSS QuadraMed Claims Scrubber
- IF '$$IIQMED^IBCB2(IBIFN)
- GOTO END
- +5 ;
- 3 ;authorize bill/request MRA
- +1 IF '$DATA(^XUSEC("IB AUTHORIZE",DUZ))!('$DATA(IBIFN))
- WRITE !!,"You do not hold the Authorize Key.",!
- GOTO END
- +2 IF '$PIECE($GET(^IBE(350.9,1,1)),"^",23)
- IF DUZ=$PIECE(^DGCR(399,IBIFN,"S"),"^",2)
- WRITE !!,"Entering user can not authorize.",!
- GOTO END
- +3 IF $PIECE(^DGCR(399,IBIFN,"S"),"^",9)
- WRITE !,"Already Approved, Can't change"
- GOTO END
- +4 if '$GET(IBAC)!($GET(IBAC)>1)
- DO EDITS^IBCB2
- if IBQUIT
- GOTO END
- +5 ;
- +6 ; Ingenix ClaimsManager
- IF $GET(IBAC)'=1
- IF '$$IICM^IBCB2(IBIFN)
- GOTO END
- +7 ; DSS QuadraMed Claims Scrubber
- IF $GET(IBAC)'=1
- IF '$$IIQMED^IBCB2(IBIFN)
- GOTO END
- +8 ;
- AUTH SET IBMRA=$$REQMRA^IBEFUNC(IBIFN)
- +1 SET IBEND=0
- +2 ;MRA normally required, but MEDIGAP ins co
- IF IBMRA["R"
- DO AUTH^IBCB11
- if IBEND
- GOTO END
- +3 ; doesn't want/need it or MRA parameter off
- +4 ;
- +5 WRITE !!,"THIS BILL WILL "_$PIECE("NOT ^",U,$$TXMT^IBCEF4(IBIFN)+1)_"BE TRANSMITTED ELECTRONICALLY"
- +6 WRITE !!,"WANT TO ",$SELECT('IBMRA:"AUTHORIZE BILL",1:"REQUEST AN MRA")," AT THIS TIME"
- SET %=2
- DO YN^DICN
- if %=-1!(%=2)
- GOTO END
- +7 IF '%
- WRITE !?4,"YES - If finished entering bill information and to allow bill to be printed or transmitted",!?4,"No - To take no action"
- GOTO AUTH
- +8 SET (DIC,DIE)=399
- SET IBYY=$SELECT('IBMRA:"@90",1:"@901")
- SET DA=IBIFN
- SET DR="[IB STATUS]"
- DO ^DIE
- KILL DIC,DIE,IBYY
- if $DATA(IBX3)
- DO DISAP^IBCBULL
- +9 IF $SELECT('IBMRA:'$PIECE(^DGCR(399,IBIFN,"S"),"^",9),1:'$PIECE($GET(^DGCR(399,IBIFN,"TX")),U,6))
- GOTO END
- +10 ;
- +11 ; Update the review status for all EOB's on file
- +12 ; Accepted - Complete EOB
- DO STAT^IBCEMU2(IBIFN,3)
- +13 ;
- +14 ; Checks for need to add any codes to bill based on information already on bill, specifically for EDI purposes
- DO AUTOCK^IBCEU2(IBIFN)
- +15 ;Determine transmit, whether live/test
- SET IBTXSTAT=$$TXMT^IBCEF4(IBIFN,,1)
- +16 IF IBTXSTAT
- Begin DoDot:1
- +17 WRITE !," Adding "
- +18 if +IBTXSTAT=2
- WRITE "test "
- WRITE "bill to BILL TRANSMISSION File"_$SELECT('IBMRA:"",1:" for MRA submission")_".",!
- +19 if +IBTXSTAT=1&IBMRA
- WRITE " Bill is no longer editable unless returned in error from Medicare."
- +20 SET Y=$$ADDTBILL(IBIFN,+IBTXSTAT)
- +21 WRITE !
- if '$PIECE(Y,U,3)
- WRITE *7
- WRITE $SELECT($PIECE(Y,U,3):" Bill will be submitted electronically",1:" Error loading into transmit file - bill can not be transmitted.")
- +22 ;JWS;IB*2.0*623v24;begin
- +23 NEW IB364
- +24 SET IB364=$PIECE(Y,U)
- +25 IF $$GET1^DIQ(399,IBIFN_",",23,"I")
- Begin DoDot:2
- +26 DO SETSUB^IBCE837I(IB364,1)
- +27 NEW DA,DR,DIE,X,Y
- +28 SET DA=IBIFN
- SET DIE="^DGCR(399,"
- SET DR="23////0"
- DO ^DIE
- +29 QUIT
- End DoDot:2
- +30 ;JWS;IB*2.0*623v24;end
- End DoDot:1
- IF IBMRA
- DO CTCOPY^IBCCCB(IBIFN,1)
- GOTO END
- +31 ;
- +32 WRITE !,"Passing completed Bill to Accounts Receivable. Bill is no longer editable."
- +33 DO ARPASS(IBIFN,1)
- +34 if '$GET(PRCASV("OKAY"))
- GOTO END
- +35 WRITE !,"Completed Bill Successfully sent to Accounts Receivable."
- DO FIND^IBOHCK(DFN,IBIFN)
- +36 ;
- +37 ; Check to see if any unreviewed status messages or EOBs on file and
- +38 ; what to do about them
- +39 NEW IBTXBARR
- +40 SET IBRESUB=$$RESUB^IBCECSA4($SELECT($GET(IBCNCOPY):$PIECE($GET(^DGCR(399,IBIFN,0)),U,15),1:IBIFN),+IBTXSTAT,"E",.IBTXBARR)
- +41 ; update review statuses to be 'review complete'
- IF IBRESUB=2
- Begin DoDot:1
- +42 NEW IBDA
- SET IBDA=0
- +43 FOR
- SET IBDA=$ORDER(IBTXBARR(IBDA))
- if 'IBDA
- QUIT
- DO UPDEDI^IBCEM(IBDA,$SELECT($GET(IBCNCOPY):"R",1:"E"))
- +44 QUIT
- End DoDot:1
- +45 ;
- +46 KILL IBTXPRT
- +47 ;
- 4 ;generate/print bill
- +1 if '$DATA(IBIFN)
- GOTO END
- +2 if '$DATA(IBMRA)
- SET IBMRA=+$$NEEDMRA^IBEFUNC(IBIFN)
- +3 IF 'IBMRA
- IF '$PIECE(^DGCR(399,IBIFN,"S"),"^",9)
- WRITE !!,*7,"Not Authorized, Can Not Print!"
- GOTO END
- +4 IF IBMRA
- IF '$PIECE(^DGCR(399,IBIFN,"TX"),"^",6)
- WRITE !!,*7,"Not Ready For MRA Submission, Can Not Print!"
- GOTO END
- +5 SET IBTXSTAT=$$TXMT^IBCEF4(IBIFN)
- +6 IF IBMRA
- IF $$NEEDMRA^IBEFUNC(IBIFN)'["R"
- WRITE !!,*7,"MRA Submission not yet confirmed by Austin, Can Not Print!"
- if $SELECT('IBTXSTAT
- QUIT
- +7 IF +IBTXSTAT
- IF $DATA(^IBA(364,"ABDT",IBIFN))
- SET IBTXOK=""
- Begin DoDot:1
- +8 NEW IBX,IBTST
- +9 SET IBX=+$$LAST364^IBCEF4(IBIFN)
- SET IBTST=""
- +10 IF $$TEST^IBCEF4(IBIFN)
- SET (IBTXOK,IBTST)=1
- +11 IF "XP"[$PIECE($GET(^IBA(364,IBX,0)),U,3)
- if 'IBTST
- Begin DoDot:2
- +12 ;JWS;IB*2.0*592
- +13 IF $$FT^IBCEF(IBIFN)=7
- WRITE !!,*7,"This Bill Can Not Be Printed"
- +14 IF '$TEST
- WRITE !!,*7,"This Bill Can Not Be Printed Until Transmit Confirmed"
- +15 if IBMRA
- WRITE " (to request an MRA)"
- if '$DATA(IBVIEW)
- DO VIEW^IBCB2
- End DoDot:2
- QUIT
- +16 WRITE !!,"This Bill Has Already Been Transmitted"
- if IBMRA
- WRITE " (to request an MRA)"
- +17 SET DIR("B")="Y"
- SET DIR("A")="WANT TO PRINT IT ANYWAY"
- SET DIR(0)="Y"
- DO ^DIR
- KILL DIR
- if $DATA(DTOUT)!$DATA(DUOUT)!'Y
- QUIT
- SET IBTXOK=1
- End DoDot:1
- IF 'IBTXOK
- SET %=2
- GOTO GENTX
- +18 DO DISP^IBCB2
- +19 if '$DATA(IBQUIT)
- SET IBQUIT=0
- +20 if '$DATA(IBVIEW)
- DO VIEW^IBCB2
- if IBQUIT
- GOTO END
- +21 SET IBPNT=$PIECE(^DGCR(399,IBIFN,"S"),"^",12)
- GEN IF $$TEST^IBCEF4(IBIFN)
- WRITE !!,"THIS BILL IS BEING USED AS A TRANSMISSION TEST BILL"
- +1 ;IB*2.0*718v5;EBILL-156;JWS;remove PRINT prompt for Dental Claims
- +2 IF $$FT^IBCEF(IBIFN)=7
- if +$GET(IBAC)=1
- DO END
- DO CTCOPY^IBCCCB(IBIFN)
- GOTO END
- +3 WRITE !!,"WANT TO ",$SELECT(IBPNT]"":"RE-",1:""),"PRINT BILL AT THIS TIME"
- SET %=2
- DO YN^DICN
- IF %=-1
- if +$GET(IBAC)=1
- DO END
- DO CTCOPY^IBCCCB(IBIFN)
- GOTO END
- +4 IF '%
- WRITE !?4,"YES - to print the bill now",!?4,"NO - To take no action"
- GOTO GEN
- +5 ;JWS;IB*2.0*592
- +6 ;IB*2.0*718v5;EBILL-156;JWS;remove PRINT prompt for Dental claims
- +7 ;;I %=1,$$FT^IBCEF(IBIFN)=7 W !!,*7,"Dental Claims can not be printed." G END
- GENTX IF %'=1
- if +$GET(IBAC)=1
- DO END
- DO CTCOPY^IBCCCB(IBIFN)
- GOTO END
- +1 ;
- +2 ;WCJ;US3380
- NEW IBABORT
- +3 ; Bill has never been printed. First time print.
- +4 IF 'IBPNT
- Begin DoDot:1
- +5 IF $DATA(IBTXPRT)
- DO TXPRTS
- +6 ;WCJ;US3380
- DO EN1^IBCF(.IBABORT)
- +7 ;WCJ;IB641;V13;US3380;they aborted so stop already
- if $GET(IBABORT)
- QUIT
- +8 ;WCJ;IB641;US3380; if it is looking for a result (IBRESULT will be defined)
- IF $DATA(IBRESULT)
- SET IBRESULT=1
- +9 IF $DATA(IBTXPRT)
- DO TXPRT
- +10 ;D MRA^IBCEMU1(IBIFN) ; Printing the MRA ;WCJ;IB*2.0*432;MRA may have a different claim number if this is tertiary
- +11 ;WCJ;IB*2.0*432;see above
- DO MRA^IBCEMU1($$GETMRACL^IBCAPR(IBIFN))
- +12 ;WCJ;IB*2.0*432 print all the EOBs (ask device once)
- IF $GET(IBMRANOT)
- DO EOBALL^IBCAPR2(IBIFN)
- +13 IF +$GET(IBAC)=1
- DO END
- DO CTCOPY^IBCCCB(IBIFN)
- +14 QUIT
- End DoDot:1
- GOTO END
- +15 ;
- +16 ; Below section is for re-prints
- RPNT if $$NEEDMRA^IBEFUNC(IBIFN)
- GOTO END
- +1 READ !!,"(2)nd Notice, (3)rd Notice, (C)opy or (O)riginal: C// ",IBPNT:DTIME
- if IBPNT=""
- SET IBPNT="C"
- if IBPNT["^"
- GOTO END
- +2 SET IBPNT=$EXTRACT(IBPNT,1)
- IF "23oOcC"'[IBPNT
- WRITE !?5,"Enter 'O' to reprint the original bill or",!?5,"Enter 'C' to reprint the bill as a duplicate copy or",!?5,"Enter '2' or '3' to print 2nd or 3rd follow-up notices."
- SET IBPNT=1
- GOTO RPNT
- +3 WRITE " (",$SELECT("cC"[IBPNT:"COPY","oO"[IBPNT:"ORIGINAL",IBPNT=2:"2nd NOTICE",IBPNT=3:"3rd NOTICE",1:""),")"
- +4 IF $DATA(IBTXPRT)
- Begin DoDot:1
- +5 DO TXPRTS
- +6 IF "oOcC"[IBPNT
- SET IBRESUB=$$RESUB^IBCECSA4(IBIFN,1,"P")
- End DoDot:1
- +7 SET IBPNT=$SELECT("oO"[IBPNT:1,"cC"[IBPNT:0,1:IBPNT)
- +8 DO EN1X^IBCF(.IBABORT)
- +9 ; WCJ;IB641;V13;only do this stuff if it actually printed (was not ABORTED)
- IF $GET(IBABORT)
- GOTO END
- +10 ;WCJ;IB641;US3380; if it is looking for a result (IBRESULT will be defined)
- IF $DATA(IBRESULT)
- SET IBRESULT=1
- +11 if $DATA(IBTXPRT)
- DO TXPRT
- +12 ; Printing the MRA
- DO MRA^IBCEMU1(IBIFN)
- +13 ;
- +14 ;
- END KILL IBER,IBEND
- DO END^IBCBB1
- KILL IBQUIT,IBVIEW,IBDISP,IBST,IB,PRCAERCD,PRCAERR,PRCASVC,PRCAT,DGRA2,IBBT,IBCH,IBNDS,IBOA,IBREV,IBX,DGXRF1,PRCAORA,IBX3,DGBILLBS,DGII,DGVISCNT,DGFIL,DGTE,IBTXOK,IBTXSTAT,IBMRA,IBNOFIX
- +1 KILL %DT,DIC,DIE,I,J,X,Y,Y1,Y2,IBER,IBDFN,IBDSDT,IBJ,IBNDI1,IBZZ,VA,IBMA,IBXDT,DI,PRCAPAYR,DGBS,DGCNT,DGDA,DGPAG,DGREVC,DGRV,DGTEXT,DGTOTPAG,IBOPV,DGLCNT,DGTEXT1,DGRSPAC,DGSM,IBPNT,DGINPT,DGLL,IBCPTN,IBFL
- +2 KILL IBRESUB,IBOPV1,IBOPV2,IBCHG,DGBIL1,DGU,DDH,IBA1,IBINS,IBPROC,PRCARI
- if '$DATA(PRCASV("NOTICE"))
- KILL PRCASV
- +3 KILL ^TMP("IBXDATA",$JOB),^TMP("IBXEDIT",$JOB)
- +4 ; remove ClaimsManager variables
- KILL IBCISNT,IBCISTAT,IBCIERR
- +5 QUIT
- +6 ;
- TX1(IBX,RESUB) ; Transmit a single bill from file 364 entry # IBX
- +1 ; RESUB = flag (1 = resubmitting a bill, 0 = submitting bill 1st time)
- +2 ; Returns 1 if successfully extracted to mailman queue for transmission,
- +3 ; 0 if extract not successful
- +4 NEW IBTXOK,IBVVSAVE
- +5 KILL ^TMP("IBRESUBMIT",$JOB),^TMP("IBONE",$JOB)
- +6 SET IBVVSAVE("IBX")=IBX
- SET ^TMP("IBONE",$JOB)=+$GET(RESUB)
- SET ^($JOB,IBX)=""
- +7 DO ONE^IBCE837
- +8 SET IBX=IBVVSAVE("IBX")
- +9 IF $PIECE($GET(^IBA(364,IBX,0)),U,3)="P"
- SET IBTXOK=1
- +10 KILL ^TMP("IBONE",$JOB)
- +11 QUIT $GET(IBTXOK)
- +12 ;
- ARONLY(IBIFN) ; Pass bill to A/R, but that's all
- +1 DO ARPASS(IBIFN,0)
- +2 QUIT
- +3 ;
- ARPASS(IBIFN,UPDOK) ;Pass bill to A/R as NEW BILL
- +1 ;IBIFN = bill entry #
- +2 ;UPDOK = flag 1: if error going to A/R, allow interactive edit
- +3 ; 0: send bulletin to IB EDI for error going to A/R
- +4 ;Must not have been sent previously
- if +$$STA^PRCAFN(+IBIFN)'=201
- QUIT
- +5 DO GVAR^IBCBB
- +6 ;Can't be an ins co that won't reimburse
- +7 if $SELECT($PIECE($GET(^DGCR(399,IBIFN,0)),U,11)="i"
- QUIT
- +8 DO ARRAY^IBCBB1
- DO ^PRCASVC6
- +9 if $GET(PRCASV("OKAY"))
- DO REL^PRCASVC
- +10 IF '$GET(PRCASV("OKAY"))
- Begin DoDot:1
- +11 NEW IBQUIT,IBQUIT1
- +12 SET IBQUIT=0
- +13 IF $GET(UPDOK)
- Begin DoDot:2
- +14 FOR
- Begin DoDot:3
- +15 DO DSPARERR^IBCB2("")
- +16 if IBQUIT
- QUIT
- +17 IF $$ASKEDIT^IBCB2($GET(IBAC))
- DO VIEW1^IBCB2
- QUIT
- +18 SET IBQUIT=1
- End DoDot:3
- if IBQUIT
- QUIT
- End DoDot:2
- QUIT
- +19 NEW XMSUB,XMY,XMTEXT,XMDUZ,IBT
- +20 SET XMSUB="ERROR PASSING BILL TO A/R ON CONFIRMATION"
- SET XMTEXT="IBT("
- SET XMY="G.IB EDI"
- SET XMDUZ=.5
- +21 SET IBT(1)="A problem has been detected while trying to pass bill "_$PIECE($GET(^DGCR(399,IBIFN,0)),U)_" to"
- +22 SET IBT(2)="Accounts Receivable when updating the bill's electronic confirmation."
- +23 SET IBT(3)="Please use the option PASS BILL TO A/R to complete this process."
- +24 DO ^XMD
- End DoDot:1
- +25 QUIT
- +26 ;
- ADDTBILL(IBIFN,TXST,RSUB,IBFHIR) ;Add new transmit bill rec to file 364 for bill IBIFN
- +1 ;JWS;IB*2.0*623;add field .09 setting.
- +2 ; TXST = test flag 1=live, 2=test
- +3 NEW COB,DD,DO,DIC,DLAYGO,X
- +4 SET TXST=($GET(TXST)/2\1)
- SET COB=$$COB^IBCEF(IBIFN)
- +5 ;JWS;IB*2.0*623v24;force test claim status if not Production system
- +6 IF '$$PROD^XUPROD(1)
- SET TXST=1
- +7 ;JWS;IB*2.0*641v9;change setting of FHIR transmit flag to 0 (wait for scheduled time) from 1 (instant)
- +8 ; variable IBFHIR will be passed if needing to send immediate = 1 (rtn IBCE); not implemented but leaving for future knowledge
- +9 ;;S IBFHIR=1 ; forcing to immediate transmit
- +10 ;JWS;IB*2.0*641v7;need to add resbumission flag from IBCEPTC3
- +11 SET DIC(0)="L"
- SET DIC="^IBA(364,"
- SET DLAYGO=364
- SET X=IBIFN
- SET DIC("DR")=".03///X;.04///NOW;.07////"_TXST_";.08////"_COB_$SELECT($$GET1^DIQ(350.9,"1,",8.21,"I")=1:";.09////1",1:"")_$SELECT($GET(RSUB)=1:";.1////1",1:"")
- DO FILE^DICN
- +12 QUIT Y
- +13 ;
- TXPRTS ; Save off last print date to see if bill was reprinted without queueing
- +1 IF '$$NEEDMRA^IBEFUNC(IBIFN)
- SET IBTXPRT("PRT")=$PIECE($GET(^DGCR(399,IBIFN,"S")),U,14)
- +2 QUIT
- +3 ;
- TXPRT ; Set variable if print was tasked or bill was printed (last print date changed)
- +1 IF '$$NEEDMRA^IBEFUNC(IBIFN)
- IF $SELECT($GET(ZTSK):1,1:IBTXPRT("PRT")'=$PIECE($GET(^DGCR(399,IBIFN,"S")),U,14))
- SET IBTXPRT=1
- +2 QUIT
- +3 ;
- ALT4(IBRESULT) ; WCJ;IB641;US3380;added an alternate tag 4 to pass in a parameter (by reference)
- +1 ; to show if the request claim print actually came to a successful conclusion
- +2 SET IBRESULT=0
- +3 GOTO 4