source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEXTRP.m@ 952

Last change on this file since 952 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.5 KB
Line 
1IBCEXTRP ;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 ;
5EN ;
6INIT ;
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 ;
50DEV ; - 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 ;
62LIST ; - 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 ;
127HDR ; - 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 ;
140EXITQ ; - 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 ;
146EXTRACT(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 ;
162INCLUDE(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
171INCLX ;
172 Q OK
173 ;
Note: See TracBrowser for help on using the repository browser.