Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEXTRP

IBCEXTRP.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ;
  1. INIT ;
  1. W !!,"This option will display the EDI extract data for a bill.",!
  1. N IBREC1,IBIEN,IBINC,DIC,X,Y,DIR,IB364IEN,IBVNUM,IBSEG,STOP,POP,DTOUT,DUOUT
  1. ;
  1. N DPTNOFZY S DPTNOFZY=1 ; Suppress PATIENT file fuzzy lookups
  1. S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")="I 234[$P(^(0),U,13)" D ^DIC
  1. I Y<1 G EXITQ
  1. S IBIEN=+Y,IBREC1=$G(^DGCR(399,IBIEN,0))
  1. S IB364IEN=$$LAST364^IBCEF4(IBIEN) I +$G(IB364IEN)=0 D G EXITQ
  1. . W !,"There is no entry in the EDI Transmit Bill file for this bill number."
  1. S IBVNUM=$P($G(^IBA(364,IB364IEN,0)),U,2)
  1. ;JWS;IB*2.0*623;add check for 837 FHIR not on
  1. I +$G(IBVNUM)=0,'$$GET1^DIQ(350.9,"1,",8.21,"I") D G EXITQ
  1. . W !!,"There is no batch # for this bill. It has not been transmitted."
  1. I +$G(IBVNUM) S IBVNUM=$P($G(^IBA(364.1,IBVNUM,0)),U)
  1. S DIR("A")="Include Fields With No Data?: ",DIR("B")="NO",DIR(0)="YA"
  1. W ! D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) G EXITQ
  1. S IBINC=+Y
  1. ;
  1. ; IB*2*377 - esg - Ask for specific EDI segments to view
  1. ;
  1. W !
  1. S DIR(0)="SA^A:All EDI Segments;S:Selected EDI Segments"
  1. S DIR("A")="Include (A)ll or (S)elected EDI Segments?: "
  1. S DIR("B")="All EDI Segments"
  1. D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) G EXITQ
  1. I Y="A" G DEV ; all segments, skip to device prompt
  1. ;
  1. W !
  1. K IBSEG
  1. S STOP=0
  1. F D Q:STOP
  1. . S DIR(0)="FO^3:4"
  1. . S DIR("A")=" Select EDI Segment"
  1. . I $D(IBSEG) S DIR("A")="Another EDI Segment"
  1. . S DIR("?")="Enter the name of the EDI segment to include."
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT) S STOP=1 Q
  1. . S Y=$$UP^XLFSTR(Y),Y=$$TRIM^XLFSTR(Y) ; uppercase/trim spaces
  1. . I Y="" S STOP=1 Q
  1. . S IBSEG(Y)=""
  1. . Q
  1. I $D(DTOUT)!$D(DUOUT) G EXITQ
  1. ;
  1. DEV ; - Select device
  1. N %ZIS,ZTRTN,ZTSAVE,ZTDESC
  1. W !
  1. S %ZIS="QM" D ^%ZIS G:POP EXITQ
  1. I $D(IO("Q")) D G EXITQ
  1. . S ZTRTN="LIST^IBCEXTRP",ZTDESC="Transmitted Bill Extract Data"
  1. . S ZTSAVE("IB*")=""
  1. . D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1. .K ZTSK,IO("Q") D HOME^%ZIS
  1. U IO
  1. ;
  1. LIST ; - set up array and print data
  1. N IBPG,IBSEQ,IBPC,IBDA,IBREC,IBQUIT,IBILL,IBLINE,IBXDATA,IBERR,IBXERR,Z,Z0,Z1
  1. N REP ;TPF;IB*2.0*718;EBILL-1570;10/27/2021
  1. ;D EXTRACT(IBIEN,IBVNUM,8,1) ;WCJ;IB718v22;
  1. D EXTRACT(IBIEN,IBVNUM,8,1,1) ;WCJ;IB718v22;added another parameter to execute the POST workarounds
  1. S (IBPG,IBQUIT,IBSEQ,IBPC,IBDA,IBLINE)=0
  1. K ^TMP($J,"IBLINES")
  1. ;IB*2.0*211 - rely on form type instead of bill charge type
  1. N IBFMTYP S IBFMTYP=$$FT^IBCEF(IBIEN)
  1. ;JWS;IB*2.0*592 - Dental form 7 (J430D)
  1. S IBFMTYP=$S(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",IBFMTYP=7:"J430D",1:"OTHER"_"("_IBFMTYP_")")
  1. S IBILL=$S($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP
  1. ;
  1. I $D(^TMP("IBXERR",$J)) D G EXITQ
  1. . S IBERR=0 F S IBERR=$O(^TMP("IBXERR",$J,IBERR)) Q:'IBERR W !,$G(^TMP("IBXERR",$J,IBERR))
  1. . Q
  1. ;
  1. 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
  1. . N IBOK,Z,IBMULT,DSP,IBDATA,PCD,SN
  1. . S IBREC=$G(^IBA(364.6,IBDA,0))
  1. . I $P(IBREC,U,11)=1 Q ; calculate only field
  1. . ;
  1. . ; processing for piece 1 of this EDI segment to see if there is any
  1. . ; other data that exists in this segment
  1. . I IBPC=1 S IBOK=0 D
  1. .. S Z=1 F S Z=$O(^TMP("IBXDATA",$J,1,IBSEQ,1,Z)) Q:'Z I $G(^(Z))'="" S IBOK=1 Q
  1. .. I IBOK Q ; data exists so include segment normally
  1. .. S SN=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,1,1)),U,1) ; segment name
  1. .. I SN="" S SN=$P($P(IBREC,U,10),"'",2)
  1. .. S SN=SN_" (No Data - Record Not Sent)"
  1. .. S $P(^TMP("IBXDATA",$J,1,IBSEQ,1,1),U,1)=SN
  1. .. Q
  1. . ;
  1. . ; loop thru all multiple occurrences of this segment
  1. . S IBMULT=0 F S IBMULT=$O(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT)) Q:'IBMULT D
  1. .. ;
  1. .. ; field with no data; check user preference
  1. .. I '$G(IBINC),$P($G(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT,IBPC)),U,1)="" Q
  1. .. ;
  1. .. ; build display data
  1. .. S PCD="["_IBPC_"] " ; piece#
  1. .. S DSP=$P(IBREC,U,10) ; short description field
  1. .. S IBDATA=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT,IBPC)),U,1) ; data
  1. .. S DSP=$J(PCD,5)_$$FO^IBCNEUT1(DSP,40)_": "_IBDATA
  1. .. 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
  1. .. S ^TMP($J,"IBLINES",IBSEQ,IBMULT,IBPC)=DSP
  1. .. Q
  1. . Q
  1. ;
  1. S IBQUIT=0
  1. W:$E(IOST,1,2)["C-" @IOF ; initial form feed for screen print
  1. N IBFMTYP S IBFMTYP=$$FT^IBCEF(IBIEN)
  1. ;JWS;IB*2.0*592 - Dental form 7 (J430D)
  1. S IBFMTYP=$S(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",IBFMTYP=7:"J430D",1:"OTHER"_"("_IBFMTYP_")")
  1. S IBILL=$S($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP
  1. D HDR
  1. 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
  1. . I IBLINE>(IOSL-3) D HDR Q:IBQUIT
  1. . ;JWS;IB*2.0*592;Wrap long Dental Proc Description
  1. . I Z=60,Z1=19 D Q:IBQUIT
  1. . . N IBNOTE,X,IBDATA
  1. . . S IBDATA=$G(^TMP($J,"IBLINES",Z,Z0,Z1)) I IBDATA="" Q
  1. . . S IBDATA(1)=$P(IBDATA,": "),IBDATA(2)=$P(IBDATA,": ",2),IBDATA(1)=IBDATA(1)_": "
  1. . . S IBNOTE=$$WRAP^IBCSC10H(IBDATA(2),32,32,.IBNOTE)
  1. . . W !,IBDATA(1)
  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
  1. . E W !,^TMP($J,"IBLINES",Z,Z0,Z1)
  1. . S IBLINE=IBLINE+1
  1. . I IBLINE>(IOSL-3) D HDR Q:IBQUIT
  1. . ;
  1. . ; end of segment add an extra line feed
  1. . I '$O(^TMP($J,"IBLINES",Z,Z0,Z1)) W ! S IBLINE=IBLINE+1
  1. . Q
  1. ;
  1. K ^TMP($J,"IBLINES")
  1. G EXITQ
  1. ;
  1. ;
  1. HDR ; - Report header
  1. N DIR,Y
  1. I IBPG D Q:IBQUIT
  1. . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBQUIT=('Y) Q:IBQUIT
  1. . W @IOF
  1. ;
  1. S IBPG=IBPG+1
  1. W !,?25,"EDI Transmitted Bill Extract Data",!,"Bill #",?11,"Type",?27,"Patient Name",?52,"SSN",?57,$$FMTE^XLFDT(DT),?71,"Page: "_IBPG
  1. W !,$TR($J("",IOM)," ","=")
  1. 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),!
  1. S IBLINE=6
  1. Q
  1. ;
  1. EXITQ ; - clean up and exit
  1. I $E(IOST,1,2)["C-",'$G(IBQUIT) K DIR S DIR(0)="E" W ! D ^DIR K DIR
  1. K ^TMP("IBXERR",$J),^TMP("IBXDATA",$J),IBXERR
  1. D CLEAN^DILF
  1. Q
  1. ;
  1. ;EXTRACT(IBIFN,IBBATCH,IBFORM,IBLOCAL) ; WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
  1. ; This new parameter IBXPOSTWA will not be passed in by DSS so the claims scrubber can continue unabated.
  1. EXTRACT(IBIFN,IBBATCH,IBFORM,IBLOCAL,IBXPOSTWA) ;
  1. ; *****************
  1. ; this label is called by 2 routines outside IB
  1. ; VEJDIBPI
  1. ; VEJDIBPZ
  1. ;
  1. ; Extracts transmitted form data into global
  1. ; ^TMP("IBXDATA",$J). Errors are in ^TMP("IBXERR",$J,err_num)=text.
  1. ; IBBATCH = Batch # of bill (if known), otherwise, set to 1. This
  1. ; variable must be > 0 to prevent a new batch from being added
  1. ; IBFORM = the ien of the form in file 353
  1. ; IBLOCAL = 1 if OK to use local form, 0 if not
  1. ; IBXPOSTWA = 1 if executing FSC post processing workarounds ;WCJ;IB718v22;
  1. ;
  1. N IBVNUM,IBL,IBINC,IBSEG
  1. D FORMPRE^IBCFP1
  1. S IBVNUM=$G(IBBATCH)
  1. S IBL=$S('$G(IBLOCAL):IBFORM,1:"") ; No local form ... set = main form
  1. ; Get local form associated with parent, if any
  1. I IBL="" S IBL=$S($P($G(^IBE(353,+IBFORM,2)),U,8):$P(^(2),U,8),1:IBFORM)
  1. D SETUP^IBCE837(1)
  1. ;;JWS;IB*2.0*641v11;VEJD Audit Report - ;
  1. I '$D(IB364IEN) S IB364IEN=+$$LAST364^IBCEF4(IBIFN)
  1. ;;JWS;IB*2.0*623;allow display without Batch #
  1. I $$GET1^DIQ(350.9,"1,",8.21,"I"),+IB364IEN,$P(^IBA(364,IB364IEN,0),"^",2)="" S ^TMP("IBHDR",$J)="NOT YET ASSIGNED"
  1. ;D ROUT^IBCFP1(IBFORM,1,IBIFN,0,IBL) ;WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
  1. 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)
  1. Q
  1. ;
  1. INCLUDE(IBSEQ) ; Function to determine if segment should be included or not
  1. N OK,LZ,SEGNAME
  1. S OK=1 ; default is to include it
  1. I '$D(IBSEG) G INCLX ; if nothing in array, then include all
  1. I '$D(^TMP("IBXDATA",$J,1,IBSEQ)) S OK=0 G INCLX ; no data there
  1. S LZ=+$O(^TMP("IBXDATA",$J,1,IBSEQ,"")) ; first line# found in data
  1. S SEGNAME=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,LZ,1)),U,1) ; piece 1
  1. S SEGNAME=$$TRIM^XLFSTR(SEGNAME)
  1. I SEGNAME'="",'$D(IBSEG(SEGNAME)) S OK=0 ; don't include
  1. INCLX ;
  1. Q OK
  1. ;