- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEXTRP.m
r613 r623 1 IBCEXTRP ;ALB/JEH - VIEW/PRINT EDI EXTRACT DATA ;4/22/03 9:59am 2 ;;2.0;INTEGRATED BILLING;**137,197,211,348,349,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 EN ; 6 INIT ; 7 W !!,"This option will display the EDI extract data for a bill.",! 8 N IBREC1,IBIEN,IBINC,DIC,X,Y,DIR,IB364IEN,IBVNUM,IBSEG,STOP,POP,DTOUT,DUOUT 9 ; 10 N DPTNOFZY S DPTNOFZY=1 ; Suppress PATIENT file fuzzy lookups 11 S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")="I 234[$P(^(0),U,13)" D ^DIC 12 I Y<1 G EXITQ 13 S IBIEN=+Y,IBREC1=$G(^DGCR(399,IBIEN,0)) 14 S IB364IEN=$$LAST364^IBCEF4(IBIEN) I +$G(IB364IEN)=0 D G EXITQ 15 . W !,"There is no entry in the EDI Transmit Bill file for this bill number." 16 S IBVNUM=$P($G(^IBA(364,IB364IEN,0)),U,2) I +$G(IBVNUM)=0 D G EXITQ 17 . W !!,"There is no batch # for this bill. It has not been transmitted." 18 S IBVNUM=$P($G(^IBA(364.1,IBVNUM,0)),U) 19 S DIR("A")="Include Fields With No Data?: ",DIR("B")="NO",DIR(0)="YA" 20 W ! D ^DIR K DIR 21 I $D(DTOUT)!$D(DUOUT) G EXITQ 22 S IBINC=+Y 23 ; 24 ; IB*2*377 - esg - Ask for specific EDI segments to view 25 ; 26 W ! 27 S DIR(0)="SA^A:All EDI Segments;S:Selected EDI Segments" 28 S DIR("A")="Include (A)ll or (S)elected EDI Segments?: " 29 S DIR("B")="All EDI Segments" 30 D ^DIR K DIR 31 I $D(DTOUT)!$D(DUOUT) G EXITQ 32 I Y="A" G DEV ; all segments, skip to device prompt 33 ; 34 W ! 35 K IBSEG 36 S STOP=0 37 F D Q:STOP 38 . S DIR(0)="FO^3:4" 39 . S DIR("A")=" Select EDI Segment" 40 . I $D(IBSEG) S DIR("A")="Another EDI Segment" 41 . S DIR("?")="Enter the name of the EDI segment to include." 42 . D ^DIR K DIR 43 . I $D(DTOUT)!$D(DUOUT) S STOP=1 Q 44 . S Y=$$UP^XLFSTR(Y),Y=$$TRIM^XLFSTR(Y) ; uppercase/trim spaces 45 . I Y="" S STOP=1 Q 46 . S IBSEG(Y)="" 47 . Q 48 I $D(DTOUT)!$D(DUOUT) G EXITQ 49 ; 50 DEV ; - Select device 51 N %ZIS,ZTRTN,ZTSAVE,ZTDESC 52 W ! 53 S %ZIS="QM" D ^%ZIS G:POP EXITQ 54 I $D(IO("Q")) D G EXITQ 55 . S ZTRTN="LIST^IBCEXTRP",ZTDESC="Transmitted Bill Extract Data" 56 . S ZTSAVE("IB*")="" 57 . D ^%ZTLOAD 58 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.") 59 .K ZTSK,IO("Q") D HOME^%ZIS 60 U IO 61 ; 62 LIST ; - set up array and print data 63 N IBPG,IBSEQ,IBPC,IBDA,IBREC,IBQUIT,IBILL,IBLINE,IBXDATA,IBERR,IBXERR,Z,Z0,Z1 64 D EXTRACT(IBIEN,IBVNUM,8,1) 65 S (IBPG,IBQUIT,IBSEQ,IBPC,IBDA,IBLINE)=0 66 K ^TMP($J,"IBLINES") 67 ;IB*2.0*211 - rely on form type instead of bill charge type 68 N IBFMTYP S IBFMTYP=$$FT^IBCEF(IBIEN) 69 S IBFMTYP=$S(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",1:"OTHER"_"("_IBFMTYP_")") 70 S IBILL=$S($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP 71 ; 72 I $D(^TMP("IBXERR",$J)) D G EXITQ 73 . S IBERR=0 F S IBERR=$O(^TMP("IBXERR",$J,IBERR)) Q:'IBERR W !,$G(^TMP("IBXERR",$J,IBERR)) 74 . Q 75 ; 76 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 77 . N IBOK,Z,IBMULT,DSP,IBDATA,PCD,SN 78 . S IBREC=$G(^IBA(364.6,IBDA,0)) 79 . I $P(IBREC,U,11)=1 Q ; calculate only field 80 . ; 81 . ; processing for piece 1 of this EDI segment to see if there is any 82 . ; other data that exists in this segment 83 . I IBPC=1 S IBOK=0 D 84 .. S Z=1 F S Z=$O(^TMP("IBXDATA",$J,1,IBSEQ,1,Z)) Q:'Z I $G(^(Z))'="" S IBOK=1 Q 85 .. I IBOK Q ; data exists so include segment normally 86 .. S SN=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,1,1)),U,1) ; segment name 87 .. I SN="" S SN=$P($P(IBREC,U,10),"'",2) 88 .. S SN=SN_" (No Data - Record Not Sent)" 89 .. S $P(^TMP("IBXDATA",$J,1,IBSEQ,1,1),U,1)=SN 90 .. Q 91 . ; 92 . ; loop thru all multiple occurrences of this segment 93 . S IBMULT=0 F S IBMULT=$O(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT)) Q:'IBMULT D 94 .. ; 95 .. ; field with no data; check user preference 96 .. I '$G(IBINC),$P($G(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT,IBPC)),U,1)="" Q 97 .. ; 98 .. ; build display data 99 .. S PCD="["_IBPC_"] " ; piece# 100 .. S DSP=$P(IBREC,U,10) ; short description field 101 .. S IBDATA=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT,IBPC)),U,1) ; data 102 .. S DSP=$J(PCD,5)_$$FO^IBCNEUT1(DSP,40)_": "_IBDATA 103 .. S ^TMP($J,"IBLINES",IBSEQ,IBMULT,IBPC)=DSP 104 .. Q 105 . Q 106 ; 107 S IBQUIT=0 108 W:$E(IOST,1,2)["C-" @IOF ; initial form feed for screen print 109 N IBFMTYP S IBFMTYP=$$FT^IBCEF(IBIEN) 110 S IBFMTYP=$S(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",1:"OTHER"_"("_IBFMTYP_")") 111 S IBILL=$S($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP 112 D HDR 113 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 114 . I IBLINE>(IOSL-3) D HDR Q:IBQUIT 115 . W !,^TMP($J,"IBLINES",Z,Z0,Z1) 116 . S IBLINE=IBLINE+1 117 . I IBLINE>(IOSL-3) D HDR Q:IBQUIT 118 . ; 119 . ; end of segment add an extra line feed 120 . I '$O(^TMP($J,"IBLINES",Z,Z0,Z1)) W ! S IBLINE=IBLINE+1 121 . Q 122 ; 123 K ^TMP($J,"IBLINES") 124 G EXITQ 125 ; 126 ; 127 HDR ; - Report header 128 N DIR,Y 129 I IBPG D Q:IBQUIT 130 . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBQUIT=('Y) Q:IBQUIT 131 . W @IOF 132 ; 133 S IBPG=IBPG+1 134 W !,?25,"EDI Transmitted Bill Extract Data",!,"Bill #",?11,"Type",?27,"Patient Name",?52,"SSN",?57,$$FMTE^XLFDT(DT),?71,"Page: "_IBPG 135 W !,$TR($J("",IOM)," ","=") 136 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),! 137 S IBLINE=6 138 Q 139 ; 140 EXITQ ; - clean up and exit 141 I $E(IOST,1,2)["C-",'$G(IBQUIT) K DIR S DIR(0)="E" W ! D ^DIR K DIR 142 K ^TMP("IBXERR",$J),^TMP("IBXDATA",$J),IBXERR 143 D CLEAN^DILF 144 Q 145 ; 146 EXTRACT(IBIFN,IBBATCH,IBFORM,IBLOCAL) ; Extracts transmitted form data into global 147 ; ^TMP("IBXDATA",$J). Errors are in ^TMP("IBXERR",$J,err_num)=text. 148 ; IBBATCH = Batch # of bill (if known), otherwise, set to 1. This 149 ; variable must be > 0 to prevent a new batch from being added 150 ; IBFORM = the ien of the form in file 353 151 ; IBLOCAL = 1 if OK to use local form, 0 if not 152 N IBVNUM,IBL,IBINC,IBSEG 153 D FORMPRE^IBCFP1 154 S IBVNUM=$G(IBBATCH) 155 S IBL=$S('$G(IBLOCAL):IBFORM,1:"") ; No local form ... set = main form 156 ; Get local form associated with parent, if any 157 I IBL="" S IBL=$S($P($G(^IBE(353,+IBFORM,2)),U,8):$P(^(2),U,8),1:IBFORM) 158 D SETUP^IBCE837(1) 159 D ROUT^IBCFP1(IBFORM,1,IBIFN,0,IBL) 160 Q 161 ; 162 INCLUDE(IBSEQ) ; Function to determine if segment should be included or not 163 N OK,LZ,SEGNAME 164 S OK=1 ; default is to include it 165 I '$D(IBSEG) G INCLX ; if nothing in array, then include all 166 I '$D(^TMP("IBXDATA",$J,1,IBSEQ)) S OK=0 G INCLX ; no data there 167 S LZ=+$O(^TMP("IBXDATA",$J,1,IBSEQ,"")) ; first line# found in data 168 S SEGNAME=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,LZ,1)),U,1) ; piece 1 169 S SEGNAME=$$TRIM^XLFSTR(SEGNAME) 170 I SEGNAME'="",'$D(IBSEG(SEGNAME)) S OK=0 ; don't include 171 INCLX ; 172 Q OK 173 ; 1 IBCEXTRP ;ALB/JEH - VIEW/PRINT EDI EXTRACT DATA ; 4/22/03 9:59am 2 ;;2.0;INTEGRATED BILLING;**137,197,211,348,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 EN ; 6 INIT ; 7 W !!,"This option will display the EDI extract data for a bill.",! 8 N IBREC1,IBIEN,IBINC,DIC,X,Y,DIR,IB364IEN,IBVNUM 9 ; 10 N DPTNOFZY S DPTNOFZY=1 ; Suppress PATIENT file fuzzy lookups 11 S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")="I 234[$P(^(0),U,13)" D ^DIC 12 I Y<1 G EXITQ 13 S IBIEN=+Y,IBREC1=$G(^DGCR(399,IBIEN,0)) 14 S IB364IEN=$$LAST364^IBCEF4(IBIEN) I +$G(IB364IEN)=0 D G EXITQ 15 . W !,"There is no entry in the EDI Transmit Bill file for this bill number." 16 S IBVNUM=$P($G(^IBA(364,IB364IEN,0)),U,2) I +$G(IBVNUM)=0 D G EXITQ 17 . W !!,"There is no batch # for this bill. It has not been transmitted." 18 S IBVNUM=$P($G(^IBA(364.1,IBVNUM,0)),U) 19 S DIR("A")="INCLUDE FIELDS WITH NO DATA?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR 20 I $D(DTOUT)!$D(DUOUT) G EXITQ 21 S IBINC=+Y 22 DEV ; - Select device 23 N %ZIS,ZTRTN,ZTSAVE,ZTDESC 24 S %ZIS="QM" D ^%ZIS G:POP EXITQ 25 I $D(IO("Q")) D G EXITQ 26 . S ZTRTN="LIST^IBCEXTRP",ZTDESC="Transmitted Bill Extract Data" 27 . S ZTSAVE("IB*")="" 28 . D ^%ZTLOAD 29 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.") 30 .K ZTSK,IO("Q") D HOME^%ZIS 31 U IO 32 ; 33 LIST ; - set up array and print data 34 N IBPG,IBSEQ,IBPC,IBDA,IBREC,IBQUIT,IBILL,IBLINE,IBXDATA,IBERR,IBXERR,Z,Z0,Z1 35 D EXTRACT(IBIEN,IBVNUM,8,1) 36 S (IBPG,IBQUIT,IBSEQ,IBPC,IBDA,IBLINE)=0 37 K ^TMP($J,"IBLINES") 38 ;IB*2.0*211 - rely on form type instead of bill charge type 39 N IBFMTYP S IBFMTYP=$$FT^IBCEF(IBIEN) 40 S IBFMTYP=$S(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",1:"OTHER"_"("_IBFMTYP_")") 41 S IBILL=$S($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP 42 I $D(^TMP("IBXERR",$J)) D G EXITQ 43 . S IBERR=0 F S IBERR=$O(^TMP("IBXERR",$J,IBERR)) Q:'IBERR W !,$G(^TMP("IBXERR",$J,IBERR)) 44 F S IBSEQ=$O(^IBA(364.6,"ASEQ",8,IBSEQ)) Q:'IBSEQ!(IBQUIT) F S IBPC=$O(^IBA(364.6,"ASEQ",8,IBSEQ,1,IBPC)) Q:'IBPC!(IBQUIT) F S IBDA=$O(^IBA(364.6,"ASEQ",8,IBSEQ,1,IBPC,IBDA)) Q:'IBDA!(IBQUIT) S IBREC=$G(^IBA(364.6,IBDA,0)) D Q:IBQUIT 45 . N IBOK,Z,IBMULT 46 . I $P(IBREC,U,11)=1 Q 47 . I IBPC=1 S IBOK=0 D 48 .. S Z=1 F S Z=$O(^TMP("IBXDATA",$J,1,IBSEQ,1,Z)) Q:'Z I $G(^(Z))'="" S IBOK=1 Q 49 .. I 'IBOK S $P(^TMP("IBXDATA",$J,1,IBSEQ,1,1),U)=$P($G(^TMP("IBXDATA",$J,1,IBSEQ,1,1)),U)_" (NO DATA - RECORD NOT SENT)" 50 . S IBMULT=0 F S IBMULT=$O(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT)) Q:'IBMULT D 51 .. I '$G(IBINC),$P($G(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT,IBPC)),U)="" Q 52 .. S ^TMP($J,"IBLINES",IBSEQ,IBMULT,IBPC)=$E($P(IBREC,U,10)_$J("",30),1,30)_": "_$P($G(^TMP("IBXDATA",$J,1,IBSEQ,IBMULT,IBPC)),U) 53 . 54 W:$E(IOST,1,2)["C-" @IOF ; initial form feed for screen print 55 N IBFMTYP S IBFMTYP=$$FT^IBCEF(IBIEN) 56 S IBFMTYP=$S(IBFMTYP=2:"CMS-1500",IBFMTYP=3:"UB-04",1:"OTHER"_"("_IBFMTYP_")") 57 S IBILL=$S($$INPAT^IBCEF(IBIEN,1):"Inpt",1:"Oupt")_"/"_IBFMTYP 58 D HDR 59 S Z=0 F S Z=$O(^TMP($J,"IBLINES",Z)) Q:'Z S Z0=0 F S Z0=$O(^TMP($J,"IBLINES",Z,Z0)) Q:'Z0 S Z1=0 F S Z1=$O(^TMP($J,"IBLINES",Z,Z0,Z1)) Q:'Z1 D G:IBQUIT Q1 60 . D:IBLINE>(IOSL-5) HDR Q:IBQUIT 61 . W !,^TMP($J,"IBLINES",Z,Z0,Z1) 62 . S IBLINE=IBLINE+1 63 Q1 K ^TMP($J,"IBLINES") 64 Q 65 ; 66 HDR ; - Report header 67 N DIR,Y 68 I IBPG D Q:IBQUIT 69 . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBQUIT=('Y) Q:IBQUIT 70 . W @IOF 71 ; 72 S IBPG=IBPG+1 73 W !!,?25,"EDI Transmitted Bill Extract Data",!,"Bill #",?11,"Type",?27,"Patient Name",?52,"SSN",?57,$$FMTE^XLFDT(DT),?71,"Page: "_IBPG 74 W !,$TR($J("",IOM)," ","=") 75 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),! 76 S IBLINE=5 77 Q 78 ; 79 ASK ; 80 I $E(IOST,1,2)'["C-" Q 81 N DIR,DIROUT,DIRUT,DTOUT,DUOUT 82 S DIR(0)="E" D ^DIR 83 I ($D(DIRUT))!($D(DUOUT)) S IBQUIT=1 84 Q 85 ; 86 EXITQ ; - clean up and exit 87 I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" W ! D ^DIR K DIR 88 K ^TMP("IBXERR",$J),^TMP("IBXDATA",$J),IBXERR 89 D CLEAN^DILF 90 Q 91 ; 92 EXTRACT(IBIFN,IBBATCH,IBFORM,IBLOCAL) ; Extracts transmitted form data into global 93 ; ^TMP("IBXDATA",$J). Errors are in ^TMP("IBXERR",$J,err_num)=text. 94 ; IBBATCH = Batch # of bill (if known), otherwise, set to 1. This 95 ; variable must be > 0 to prevent a new batch from being added 96 ; IBFORM = the ien of the form in file 353 97 ; IBLOCAL = 1 if OK to use local form, 0 if not 98 N IBVNUM,IBL 99 D FORMPRE^IBCFP1 100 S IBVNUM=$G(IBBATCH) 101 S IBL=$S('$G(IBLOCAL):IBFORM,1:"") ; No local form ... set = main form 102 ; Get local form associated with parent, if any 103 I IBL="" S IBL=$S($P($G(^IBE(353,+IBFORM,2)),U,8):$P(^(2),U,8),1:IBFORM) 104 D SETUP^IBCE837(1) 105 D ROUT^IBCFP1(IBFORM,1,IBIFN,0,IBL) 106 Q 107 ;
Note:
See TracChangeset
for help on using the changeset viewer.
