IBCEXTRP ;ALB/JEH - VIEW/PRINT EDI EXTRACT DATA ;4/22/03 9:59am
;;2.0;INTEGRATED BILLING;**137,197,211,348,349,377,592,623,641,718**;21-MAR-94;Build 73
;;Per VA Directive 6402, this routine should not be modified.
;
EN ;
INIT ;
W !!,"This option will display the EDI extract data for a bill.",!
N IBREC1,IBIEN,IBINC,DIC,X,Y,DIR,IB364IEN,IBVNUM,IBSEG,STOP,POP,DTOUT,DUOUT
;
N DPTNOFZY S DPTNOFZY=1 ; Suppress PATIENT file fuzzy lookups
S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")="I 234[$P(^(0),U,13)" D ^DIC
I Y<1 G EXITQ
S IBIEN=+Y,IBREC1=$G(^DGCR(399,IBIEN,0))
S IB364IEN=$$LAST364^IBCEF4(IBIEN) I +$G(IB364IEN)=0 D G EXITQ
. W !,"There is no entry in the EDI Transmit Bill file for this bill number."
S IBVNUM=$P($G(^IBA(364,IB364IEN,0)),U,2)
;JWS;IB*2.0*623;add check for 837 FHIR not on
I +$G(IBVNUM)=0,'$$GET1^DIQ(350.9,"1,",8.21,"I") D G EXITQ
. W !!,"There is no batch # for this bill. It has not been transmitted."
I +$G(IBVNUM) S IBVNUM=$P($G(^IBA(364.1,IBVNUM,0)),U)
S DIR("A")="Include Fields With No Data?: ",DIR("B")="NO",DIR(0)="YA"
W ! D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G EXITQ
S IBINC=+Y
;
; IB*2*377 - esg - Ask for specific EDI segments to view
;
W !
S DIR(0)="SA^A:All EDI Segments;S:Selected EDI Segments"
S DIR("A")="Include (A)ll or (S)elected EDI Segments?: "
S DIR("B")="All EDI Segments"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G EXITQ
I Y="A" G DEV ; all segments, skip to device prompt
;
W !
K IBSEG
S STOP=0
F D Q:STOP
. S DIR(0)="FO^3:4"
. S DIR("A")=" Select EDI Segment"
. I $D(IBSEG) S DIR("A")="Another EDI Segment"
. S DIR("?")="Enter the name of the EDI segment to include."
. D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S STOP=1 Q
. S Y=$$UP^XLFSTR(Y),Y=$$TRIM^XLFSTR(Y) ; uppercase/trim spaces
. I Y="" S STOP=1 Q
. S IBSEG(Y)=""
. Q
I $D(DTOUT)!$D(DUOUT) G EXITQ
;
DEV ; - Select device
N %ZIS,ZTRTN,ZTSAVE,ZTDESC
W !
S %ZIS="QM" D ^%ZIS G:POP EXITQ
I $D(IO("Q")) D G EXITQ
. S ZTRTN="LIST^IBCEXTRP",ZTDESC="Transmitted Bill Extract Data"
. S ZTSAVE("IB*")=""
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
U IO
;
LIST ; - set up array and print data
N IBPG,IBSEQ,IBPC,IBDA,IBREC,IBQUIT,IBILL,IBLINE,IBXDATA,IBERR,IBXERR,Z,Z0,Z1
N REP ;TPF;IB*2.0*718;EBILL-1570;10/27/2021
;D EXTRACT(IBIEN,IBVNUM,8,1) ;WCJ;IB718v22;
D EXTRACT(IBIEN,IBVNUM,8,1,1) ;WCJ;IB718v22;added another parameter to execute the POST workarounds
S (IBPG,IBQUIT,IBSEQ,IBPC,IBDA,IBLINE)=0
K ^TMP($J,"IBLINES")
;IB*2.0*211 - rely on form type instead of bill charge type
N IBFMTYP S IBFMTYP=$$FT^IBCEF(IBIEN)
;JWS;IB*2.0*592 - Dental form 7 (J430D)
S IBFMTYP=$S(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",IBFMTYP=7:"J430D",1:"OTHER"_"("_IBFMTYP_")")
S IBILL=$S($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP
;
I $D(^TMP("IBXERR",$J)) D G EXITQ
. S IBERR=0 F S IBERR=$O(^TMP("IBXERR",$J,IBERR)) Q:'IBERR W !,$G(^TMP("IBXERR",$J,IBERR))
. Q
;
F S IBSEQ=$O(^IBA(364.6,"ASEQ",8,IBSEQ)) Q:'IBSEQ I $$INCLUDE(IBSEQ) F S IBPC=$O(^IBA(364.6,"ASEQ",8,IBSEQ,1,IBPC)) Q:'IBPC F S IBDA=$O(^IBA(364.6,"ASEQ",8,IBSEQ,1,IBPC,IBDA)) Q:'IBDA D
. N IBOK,Z,IBMULT,DSP,IBDATA,PCD,SN
. S IBREC=$G(^IBA(364.6,IBDA,0))
. I $P(IBREC,U,11)=1 Q ; calculate only field
. ;
. ; processing for piece 1 of this EDI segment to see if there is any
. ; other data that exists in this segment
. I IBPC=1 S IBOK=0 D
.. S Z=1 F S Z=$O(^TMP("IBXDATA",$J,1,IBSEQ,1,Z)) Q:'Z I $G(^(Z))'="" S IBOK=1 Q
.. I IBOK Q ; data exists so include segment normally
.. S SN=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,1,1)),U,1) ; segment name
.. I SN="" S SN=$P($P(IBREC,U,10),"'",2)
.. S SN=SN_" (No Data - Record Not Sent)"
.. S $P(^TMP("IBXDATA",$J,1,IBSEQ,1,1),U,1)=SN
.. Q
. ;
. ; loop thru all multiple occurrences of this segment
. S IBMULT=0 F S IBMULT=$O(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT)) Q:'IBMULT D
.. ;
.. ; field with no data; check user preference
.. I '$G(IBINC),$P($G(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT,IBPC)),U,1)="" Q
.. ;
.. ; build display data
.. S PCD="["_IBPC_"] " ; piece#
.. S DSP=$P(IBREC,U,10) ; short description field
.. S IBDATA=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT,IBPC)),U,1) ; data
.. S DSP=$J(PCD,5)_$$FO^IBCNEUT1(DSP,40)_": "_IBDATA
.. I DSP[("Value Code Dollars") S REP("Dollars")="Amount " S DSP=$$REPLACE^XLFSTR(DSP,.REP) ;TPF;IB*2.0*718;EBILL-1570;10/27/2021
.. S ^TMP($J,"IBLINES",IBSEQ,IBMULT,IBPC)=DSP
.. Q
. Q
;
S IBQUIT=0
W:$E(IOST,1,2)["C-" @IOF ; initial form feed for screen print
N IBFMTYP S IBFMTYP=$$FT^IBCEF(IBIEN)
;JWS;IB*2.0*592 - Dental form 7 (J430D)
S IBFMTYP=$S(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",IBFMTYP=7:"J430D",1:"OTHER"_"("_IBFMTYP_")")
S IBILL=$S($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP
D HDR
S Z=0 F S Z=$O(^TMP($J,"IBLINES",Z)) Q:'Z!IBQUIT S Z0=0 F S Z0=$O(^TMP($J,"IBLINES",Z,Z0)) Q:'Z0!IBQUIT S Z1=0 F S Z1=$O(^TMP($J,"IBLINES",Z,Z0,Z1)) Q:'Z1!IBQUIT D Q:IBQUIT
. I IBLINE>(IOSL-3) D HDR Q:IBQUIT
. ;JWS;IB*2.0*592;Wrap long Dental Proc Description
. I Z=60,Z1=19 D Q:IBQUIT
. . N IBNOTE,X,IBDATA
. . S IBDATA=$G(^TMP($J,"IBLINES",Z,Z0,Z1)) I IBDATA="" Q
. . S IBDATA(1)=$P(IBDATA,": "),IBDATA(2)=$P(IBDATA,": ",2),IBDATA(1)=IBDATA(1)_": "
. . S IBNOTE=$$WRAP^IBCSC10H(IBDATA(2),32,32,.IBNOTE)
. . W !,IBDATA(1)
. . S X=0 F S X=$O(IBNOTE(X)) Q:X="" Q:IBQUIT W:X'=1 ! W ?47,IBNOTE(X) S IBLINE=IBLINE+1 I IBLINE>(IOSL-3) D HDR Q:IBQUIT
. E W !,^TMP($J,"IBLINES",Z,Z0,Z1)
. S IBLINE=IBLINE+1
. I IBLINE>(IOSL-3) D HDR Q:IBQUIT
. ;
. ; end of segment add an extra line feed
. I '$O(^TMP($J,"IBLINES",Z,Z0,Z1)) W ! S IBLINE=IBLINE+1
. Q
;
K ^TMP($J,"IBLINES")
G EXITQ
;
;
HDR ; - Report header
N DIR,Y
I IBPG D Q:IBQUIT
. I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBQUIT=('Y) Q:IBQUIT
. W @IOF
;
S IBPG=IBPG+1
W !,?25,"EDI Transmitted Bill Extract Data",!,"Bill #",?11,"Type",?27,"Patient Name",?52,"SSN",?57,$$FMTE^XLFDT(DT),?71,"Page: "_IBPG
W !,$TR($J("",IOM)," ","=")
W !,$P(IBREC1,U)_" "_"("_IBILL_")",?27,$P($G(^DPT(+$P(IBREC1,U,2),0)),U),?52,$P($G(^DPT($P(IBREC1,U,2),0)),U,9),!
S IBLINE=6
Q
;
EXITQ ; - clean up and exit
I $E(IOST,1,2)["C-",'$G(IBQUIT) K DIR S DIR(0)="E" W ! D ^DIR K DIR
K ^TMP("IBXERR",$J),^TMP("IBXDATA",$J),IBXERR
D CLEAN^DILF
Q
;
;EXTRACT(IBIFN,IBBATCH,IBFORM,IBLOCAL) ; WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
; This new parameter IBXPOSTWA will not be passed in by DSS so the claims scrubber can continue unabated.
; *****************
; this label is called by 2 routines outside IB
; VEJDIBPI
; VEJDIBPZ
;
; Extracts transmitted form data into global
; ^TMP("IBXDATA",$J). Errors are in ^TMP("IBXERR",$J,err_num)=text.
; IBBATCH = Batch # of bill (if known), otherwise, set to 1. This
; variable must be > 0 to prevent a new batch from being added
; IBFORM = the ien of the form in file 353
; IBLOCAL = 1 if OK to use local form, 0 if not
; IBXPOSTWA = 1 if executing FSC post processing workarounds ;WCJ;IB718v22;
;
N IBVNUM,IBL,IBINC,IBSEG
D FORMPRE^IBCFP1
S IBVNUM=$G(IBBATCH)
S IBL=$S('$G(IBLOCAL):IBFORM,1:"") ; No local form ... set = main form
; Get local form associated with parent, if any
I IBL="" S IBL=$S($P($G(^IBE(353,+IBFORM,2)),U,8):$P(^(2),U,8),1:IBFORM)
D SETUP^IBCE837(1)
;;JWS;IB*2.0*641v11;VEJD Audit Report - ;
I '$D(IB364IEN) S IB364IEN=+$$LAST364^IBCEF4(IBIFN)
;;JWS;IB*2.0*623;allow display without Batch #
I $$GET1^DIQ(350.9,"1,",8.21,"I"),+IB364IEN,$P(^IBA(364,IB364IEN,0),"^",2)="" S ^TMP("IBHDR",$J)="NOT YET ASSIGNED"
;D ROUT^IBCFP1(IBFORM,1,IBIFN,0,IBL) ;WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
D ROUT^IBCFP1(IBFORM,1,IBIFN,0,IBL,$G(IBXPOSTWA)) ;WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
Q
;
INCLUDE(IBSEQ) ; Function to determine if segment should be included or not
N OK,LZ,SEGNAME
S OK=1 ; default is to include it
I '$D(IBSEG) G INCLX ; if nothing in array, then include all
I '$D(^TMP("IBXDATA",$J,1,IBSEQ)) S OK=0 G INCLX ; no data there
S LZ=+$O(^TMP("IBXDATA",$J,1,IBSEQ,"")) ; first line# found in data
S SEGNAME=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,LZ,1)),U,1) ; piece 1
S SEGNAME=$$TRIM^XLFSTR(SEGNAME)
I SEGNAME'="",'$D(IBSEG(SEGNAME)) S OK=0 ; don't include
INCLX ;
Q OK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEXTRP 8791 printed Apr 09, 2024@21:10:57 Page 2
IBCEXTRP ;ALB/JEH - VIEW/PRINT EDI EXTRACT DATA ;4/22/03 9:59am
+1 ;;2.0;INTEGRATED BILLING;**137,197,211,348,349,377,592,623,641,718**;21-MAR-94;Build 73
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ;
INIT ;
+1 WRITE !!,"This option will display the EDI extract data for a bill.",!
+2 NEW IBREC1,IBIEN,IBINC,DIC,X,Y,DIR,IB364IEN,IBVNUM,IBSEG,STOP,POP,DTOUT,DUOUT
+3 ;
+4 ; Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+5 SET DIC="^DGCR(399,"
SET DIC(0)="AEMQ"
SET DIC("S")="I 234[$P(^(0),U,13)"
DO ^DIC
+6 IF Y<1
GOTO EXITQ
+7 SET IBIEN=+Y
SET IBREC1=$GET(^DGCR(399,IBIEN,0))
+8 SET IB364IEN=$$LAST364^IBCEF4(IBIEN)
IF +$GET(IB364IEN)=0
Begin DoDot:1
+9 WRITE !,"There is no entry in the EDI Transmit Bill file for this bill number."
End DoDot:1
GOTO EXITQ
+10 SET IBVNUM=$PIECE($GET(^IBA(364,IB364IEN,0)),U,2)
+11 ;JWS;IB*2.0*623;add check for 837 FHIR not on
+12 IF +$GET(IBVNUM)=0
IF '$$GET1^DIQ(350.9,"1,",8.21,"I")
Begin DoDot:1
+13 WRITE !!,"There is no batch # for this bill. It has not been transmitted."
End DoDot:1
GOTO EXITQ
+14 IF +$GET(IBVNUM)
SET IBVNUM=$PIECE($GET(^IBA(364.1,IBVNUM,0)),U)
+15 SET DIR("A")="Include Fields With No Data?: "
SET DIR("B")="NO"
SET DIR(0)="YA"
+16 WRITE !
DO ^DIR
KILL DIR
+17 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXITQ
+18 SET IBINC=+Y
+19 ;
+20 ; IB*2*377 - esg - Ask for specific EDI segments to view
+21 ;
+22 WRITE !
+23 SET DIR(0)="SA^A:All EDI Segments;S:Selected EDI Segments"
+24 SET DIR("A")="Include (A)ll or (S)elected EDI Segments?: "
+25 SET DIR("B")="All EDI Segments"
+26 DO ^DIR
KILL DIR
+27 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXITQ
+28 ; all segments, skip to device prompt
IF Y="A"
GOTO DEV
+29 ;
+30 WRITE !
+31 KILL IBSEG
+32 SET STOP=0
+33 FOR
Begin DoDot:1
+34 SET DIR(0)="FO^3:4"
+35 SET DIR("A")=" Select EDI Segment"
+36 IF $DATA(IBSEG)
SET DIR("A")="Another EDI Segment"
+37 SET DIR("?")="Enter the name of the EDI segment to include."
+38 DO ^DIR
KILL DIR
+39 IF $DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
QUIT
+40 ; uppercase/trim spaces
SET Y=$$UP^XLFSTR(Y)
SET Y=$$TRIM^XLFSTR(Y)
+41 IF Y=""
SET STOP=1
QUIT
+42 SET IBSEG(Y)=""
+43 QUIT
End DoDot:1
if STOP
QUIT
+44 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXITQ
+45 ;
DEV ; - Select device
+1 NEW %ZIS,ZTRTN,ZTSAVE,ZTDESC
+2 WRITE !
+3 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXITQ
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTRTN="LIST^IBCEXTRP"
SET ZTDESC="Transmitted Bill Extract Data"
+6 SET ZTSAVE("IB*")=""
+7 DO ^%ZTLOAD
+8 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+9 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO EXITQ
+10 USE IO
+11 ;
LIST ; - set up array and print data
+1 NEW IBPG,IBSEQ,IBPC,IBDA,IBREC,IBQUIT,IBILL,IBLINE,IBXDATA,IBERR,IBXERR,Z,Z0,Z1
+2 ;TPF;IB*2.0*718;EBILL-1570;10/27/2021
NEW REP
+3 ;D EXTRACT(IBIEN,IBVNUM,8,1) ;WCJ;IB718v22;
+4 ;WCJ;IB718v22;added another parameter to execute the POST workarounds
DO EXTRACT(IBIEN,IBVNUM,8,1,1)
+5 SET (IBPG,IBQUIT,IBSEQ,IBPC,IBDA,IBLINE)=0
+6 KILL ^TMP($JOB,"IBLINES")
+7 ;IB*2.0*211 - rely on form type instead of bill charge type
+8 NEW IBFMTYP
SET IBFMTYP=$$FT^IBCEF(IBIEN)
+9 ;JWS;IB*2.0*592 - Dental form 7 (J430D)
+10 SET IBFMTYP=$SELECT(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",IBFMTYP=7:"J430D",1:"OTHER"_"("_IBFMTYP_")")
+11 SET IBILL=$SELECT($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP
+12 ;
+13 IF $DATA(^TMP("IBXERR",$JOB))
Begin DoDot:1
+14 SET IBERR=0
FOR
SET IBERR=$ORDER(^TMP("IBXERR",$JOB,IBERR))
if 'IBERR
QUIT
WRITE !,$GET(^TMP("IBXERR",$JOB,IBERR))
+15 QUIT
End DoDot:1
GOTO EXITQ
+16 ;
+17 FOR
SET IBSEQ=$ORDER(^IBA(364.6,"ASEQ",8,IBSEQ))
if 'IBSEQ
QUIT
IF $$INCLUDE(IBSEQ)
FOR
SET IBPC=$ORDER(^IBA(364.6,"ASEQ",8,IBSEQ,1,IBPC))
if 'IBPC
QUIT
FOR
SET IBDA=$ORDER(^IBA(364.6,"ASEQ",8,IBSEQ,1,IBPC,IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+18 NEW IBOK,Z,IBMULT,DSP,IBDATA,PCD,SN
+19 SET IBREC=$GET(^IBA(364.6,IBDA,0))
+20 ; calculate only field
IF $PIECE(IBREC,U,11)=1
QUIT
+21 ;
+22 ; processing for piece 1 of this EDI segment to see if there is any
+23 ; other data that exists in this segment
+24 IF IBPC=1
SET IBOK=0
Begin DoDot:2
+25 SET Z=1
FOR
SET Z=$ORDER(^TMP("IBXDATA",$JOB,1,IBSEQ,1,Z))
if 'Z
QUIT
IF $GET(^(Z))'=""
SET IBOK=1
QUIT
+26 ; data exists so include segment normally
IF IBOK
QUIT
+27 ; segment name
SET SN=$PIECE($GET(^TMP("IBXDATA",$JOB,1,IBSEQ,1,1)),U,1)
+28 IF SN=""
SET SN=$PIECE($PIECE(IBREC,U,10),"'",2)
+29 SET SN=SN_" (No Data - Record Not Sent)"
+30 SET $PIECE(^TMP("IBXDATA",$JOB,1,IBSEQ,1,1),U,1)=SN
+31 QUIT
End DoDot:2
+32 ;
+33 ; loop thru all multiple occurrences of this segment
+34 SET IBMULT=0
FOR
SET IBMULT=$ORDER(^TMP("IBXDATA",$JOB,1,IBSEQ,IBMULT))
if 'IBMULT
QUIT
Begin DoDot:2
+35 ;
+36 ; field with no data; check user preference
+37 IF '$GET(IBINC)
IF $PIECE($GET(^TMP("IBXDATA",$JOB,1,IBSEQ,IBMULT,IBPC)),U,1)=""
QUIT
+38 ;
+39 ; build display data
+40 ; piece#
SET PCD="["_IBPC_"] "
+41 ; short description field
SET DSP=$PIECE(IBREC,U,10)
+42 ; data
SET IBDATA=$PIECE($GET(^TMP("IBXDATA",$JOB,1,IBSEQ,IBMULT,IBPC)),U,1)
+43 SET DSP=$JUSTIFY(PCD,5)_$$FO^IBCNEUT1(DSP,40)_": "_IBDATA
+44 ;TPF;IB*2.0*718;EBILL-1570;10/27/2021
IF DSP[("Value Code Dollars")
SET REP("Dollars")="Amount "
SET DSP=$$REPLACE^XLFSTR(DSP,.REP)
+45 SET ^TMP($JOB,"IBLINES",IBSEQ,IBMULT,IBPC)=DSP
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
+48 ;
+49 SET IBQUIT=0
+50 ; initial form feed for screen print
if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+51 NEW IBFMTYP
SET IBFMTYP=$$FT^IBCEF(IBIEN)
+52 ;JWS;IB*2.0*592 - Dental form 7 (J430D)
+53 SET IBFMTYP=$SELECT(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",IBFMTYP=7:"J430D",1:"OTHER"_"("_IBFMTYP_")")
+54 SET IBILL=$SELECT($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP
+55 DO HDR
+56 SET Z=0
FOR
SET Z=$ORDER(^TMP($JOB,"IBLINES",Z))
if 'Z!IBQUIT
QUIT
SET Z0=0
FOR
SET Z0=$ORDER(^TMP($JOB,"IBLINES",Z,Z0))
if 'Z0!IBQUIT
QUIT
SET Z1=0
FOR
SET Z1=$ORDER(^TMP($JOB,"IBLINES",Z,Z0,Z1))
if 'Z1!IBQUIT
QUIT
Begin DoDot:1
+57 IF IBLINE>(IOSL-3)
DO HDR
if IBQUIT
QUIT
+58 ;JWS;IB*2.0*592;Wrap long Dental Proc Description
+59 IF Z=60
IF Z1=19
Begin DoDot:2
+60 NEW IBNOTE,X,IBDATA
+61 SET IBDATA=$GET(^TMP($JOB,"IBLINES",Z,Z0,Z1))
IF IBDATA=""
QUIT
+62 SET IBDATA(1)=$PIECE(IBDATA,": ")
SET IBDATA(2)=$PIECE(IBDATA,": ",2)
SET IBDATA(1)=IBDATA(1)_": "
+63 SET IBNOTE=$$WRAP^IBCSC10H(IBDATA(2),32,32,.IBNOTE)
+64 WRITE !,IBDATA(1)
+65 SET X=0
FOR
SET X=$ORDER(IBNOTE(X))
if X=""
QUIT
if IBQUIT
QUIT
if X'=1
WRITE !
WRITE ?47,IBNOTE(X)
SET IBLINE=IBLINE+1
IF IBLINE>(IOSL-3)
DO HDR
if IBQUIT
QUIT
End DoDot:2
if IBQUIT
QUIT
+66 IF '$TEST
WRITE !,^TMP($JOB,"IBLINES",Z,Z0,Z1)
+67 SET IBLINE=IBLINE+1
+68 IF IBLINE>(IOSL-3)
DO HDR
if IBQUIT
QUIT
+69 ;
+70 ; end of segment add an extra line feed
+71 IF '$ORDER(^TMP($JOB,"IBLINES",Z,Z0,Z1))
WRITE !
SET IBLINE=IBLINE+1
+72 QUIT
End DoDot:1
if IBQUIT
QUIT
+73 ;
+74 KILL ^TMP($JOB,"IBLINES")
+75 GOTO EXITQ
+76 ;
+77 ;
HDR ; - Report header
+1 NEW DIR,Y
+2 IF IBPG
Begin DoDot:1
+3 IF $EXTRACT(IOST,1,2)["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET IBQUIT=('Y)
if IBQUIT
QUIT
+4 WRITE @IOF
End DoDot:1
if IBQUIT
QUIT
+5 ;
+6 SET IBPG=IBPG+1
+7 WRITE !,?25,"EDI Transmitted Bill Extract Data",!,"Bill #",?11,"Type",?27,"Patient Name",?52,"SSN",?57,$$FMTE^XLFDT(DT),?71,"Page: "_IBPG
+8 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+9 WRITE !,$PIECE(IBREC1,U)_" "_"("_IBILL_")",?27,$PIECE($GET(^DPT(+$PIECE(IBREC1,U,2),0)),U),?52,$PIECE($GET(^DPT($PIECE(IBREC1,U,2),0)),U,9),!
+10 SET IBLINE=6
+11 QUIT
+12 ;
EXITQ ; - clean up and exit
+1 IF $EXTRACT(IOST,1,2)["C-"
IF '$GET(IBQUIT)
KILL DIR
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
+2 KILL ^TMP("IBXERR",$JOB),^TMP("IBXDATA",$JOB),IBXERR
+3 DO CLEAN^DILF
+4 QUIT
+5 ;
+6 ;EXTRACT(IBIFN,IBBATCH,IBFORM,IBLOCAL) ; WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
+7 ; This new parameter IBXPOSTWA will not be passed in by DSS so the claims scrubber can continue unabated.
+1 ; *****************
+2 ; this label is called by 2 routines outside IB
+3 ; VEJDIBPI
+4 ; VEJDIBPZ
+5 ;
+6 ; Extracts transmitted form data into global
+7 ; ^TMP("IBXDATA",$J). Errors are in ^TMP("IBXERR",$J,err_num)=text.
+8 ; IBBATCH = Batch # of bill (if known), otherwise, set to 1. This
+9 ; variable must be > 0 to prevent a new batch from being added
+10 ; IBFORM = the ien of the form in file 353
+11 ; IBLOCAL = 1 if OK to use local form, 0 if not
+12 ; IBXPOSTWA = 1 if executing FSC post processing workarounds ;WCJ;IB718v22;
+13 ;
+14 NEW IBVNUM,IBL,IBINC,IBSEG
+15 DO FORMPRE^IBCFP1
+16 SET IBVNUM=$GET(IBBATCH)
+17 ; No local form ... set = main form
SET IBL=$SELECT('$GET(IBLOCAL):IBFORM,1:"")
+18 ; Get local form associated with parent, if any
+19 IF IBL=""
SET IBL=$SELECT($PIECE($GET(^IBE(353,+IBFORM,2)),U,8):$PIECE(^(2),U,8),1:IBFORM)
+20 DO SETUP^IBCE837(1)
+21 ;;JWS;IB*2.0*641v11;VEJD Audit Report - ;
+22 IF '$DATA(IB364IEN)
SET IB364IEN=+$$LAST364^IBCEF4(IBIFN)
+23 ;;JWS;IB*2.0*623;allow display without Batch #
+24 IF $$GET1^DIQ(350.9,"1,",8.21,"I")
IF +IB364IEN
IF $PIECE(^IBA(364,IB364IEN,0),"^",2)=""
SET ^TMP("IBHDR",$JOB)="NOT YET ASSIGNED"
+25 ;D ROUT^IBCFP1(IBFORM,1,IBIFN,0,IBL) ;WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
+26 ;WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
DO ROUT^IBCFP1(IBFORM,1,IBIFN,0,IBL,$GET(IBXPOSTWA))
+27 QUIT
+28 ;
INCLUDE(IBSEQ) ; Function to determine if segment should be included or not
+1 NEW OK,LZ,SEGNAME
+2 ; default is to include it
SET OK=1
+3 ; if nothing in array, then include all
IF '$DATA(IBSEG)
GOTO INCLX
+4 ; no data there
IF '$DATA(^TMP("IBXDATA",$JOB,1,IBSEQ))
SET OK=0
GOTO INCLX
+5 ; first line# found in data
SET LZ=+$ORDER(^TMP("IBXDATA",$JOB,1,IBSEQ,""))
+6 ; piece 1
SET SEGNAME=$PIECE($GET(^TMP("IBXDATA",$JOB,1,IBSEQ,LZ,1)),U,1)
+7 SET SEGNAME=$$TRIM^XLFSTR(SEGNAME)
+8 ; don't include
IF SEGNAME'=""
IF '$DATA(IBSEG(SEGNAME))
SET OK=0
INCLX ;
+1 QUIT OK
+2 ;
