- 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 Feb 18, 2025@23:39:06 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 ;