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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1IBCROI ;ALB/ARH - RATES: REPORTS CHARGE ITEM ; 11/22/96
2 ;;2.0;INTEGRATED BILLING;**52,106,121,245**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; OPTION ENTRY POINT: Charge Item report - get parameters then run the report
6 N DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y,IBLIST,IBX,IBSORT1,IBSORT2,IBBDT,IBEDT,IBHDR,IBQUIT,IBSELITM S IBLIST=""
7 ;
8 W !!,?20,"****** Charge Item Report ******",!!
9 W !,"This report will list all charges that are effective within a date range."
10 ;
11 S DIR(0)="SO^1:Rate;2:Charge Set",DIR("A")="First sort by" D ^DIR K DIR S IBSORT1=+Y I Y<1!$D(DTOUT)!$D(DUOUT) Q
12 ;
13 S DIC=$S(IBSORT1=1:"^IBE(363.3,",1:"^IBE(363.1,") S DIC(0)="AENQ" D ^DIC I Y>0 S IBLIST=+Y
14 I '$G(IBLIST)!$D(DTOUT)!$D(DUOUT) Q
15 ;
16 W !!,"Select a single item to display or press return for all items."
17 S IBX=$S(IBSORT1=1:+IBLIST,1:$P($G(^IBE(363.1,+IBLIST,0)),U,2)),IBX=$P($G(^IBE(363.3,+IBX,0)),U,4) Q:'IBX
18 S IBSELITM=$S(IBX=1:+$$GETBED^IBCRU1(),IBX=2:+$$GETCPT^IBCRU1("",1),IBX=3:+$$GETNDC^IBCRU1(),IBX=4:+$$GETDRG^IBCRU1(),IBX=9:+$$GETMISC^IBCRU1(),1:-1) Q:IBSELITM<0
19 ;
20 I '$G(IBSELITM) S DIR(0)="SO^1:Charge Item;2:Effective Date",DIR("A")="Sort by" D ^DIR K DIR S IBSORT2=+Y I Y<1!$D(DUOUT) Q
21 I '$G(IBSORT2) S IBSORT2=1
22 ;
23 S IBBDT=$$GETDT^IBCRU1(DT,"Charges effective beginning on") Q:IBBDT'?7N
24 S IBEDT=$$GETDT^IBCRU1(DT,"Charges effective ending on") Q:IBEDT'?7N
25 ;
26 S IBQUIT=0 D DEV I IBQUIT G EXIT
27 ;
28RPT ;find, save, and print Charge Item report - entry for tasked jobs
29 ;
30 ; if IBSCRPT is defined then the report will use the existing ^TMP($J,IBSCRPT, array
31 ; this array must be in the same format as the arrays created in IBCROI1
32 ; Otherwise, the following variations on the Charges report are possible:
33 ;
34 ; IBBDT, IBEDT required, if IBSELITM is defined then a single itme will print, otherwise all
35 ; IBSORT1: 1 - primary sort is by the Billing Rate selected (IBLIST - list of Billing Rates to print, required)
36 ; all Charge Sets for a single Rate are accumulated into the sort,
37 ; the Charge Set name is printed as a date element on each charge line
38 ;
39 ; IBSORT1: 2 - primary sort is by Charge Set (IBLIST - list of Charge Sets to print, required)
40 ; group of Charge Sets are accumulated into the sort and ordered by Charge Set,
41 ; the Charge Set name is printed as a sub-header on the report, not as a line data element
42 ;
43 ; IBSORT2: 1 - secondary sort element is Charge Item Name and tertiary sort element is Effective Date
44 ; IBSORT2: 2 - secondary sort element is Effective Date and tertiary sort element is Charge Item Name
45 ;
46 ;
47 I $G(IBSCRPT)="" S IBSCRPT="IBCROI" K ^TMP($J,IBSCRPT) D
48 . I $G(IBSORT1)=1 D SRCH1^IBCROI1(IBLIST,$G(IBSORT2),$G(IBBDT),$G(IBEDT),$G(IBSELITM))
49 . I $G(IBSORT1)=2 D SRCH2^IBCROI1(IBLIST,$G(IBSORT2),$G(IBBDT),$G(IBEDT),$G(IBSELITM))
50 ;
51 D PRINT
52 ;
53EXIT ;clean up and quit
54 K ^TMP($J),IBSCRPT Q:$D(ZTQUEUED)
55 D ^%ZISC
56 Q
57 ;
58PRINT ;print the report from the temp sort file to the appropriate device
59 N IBPGN,IBLN,IBHDR1,IBHDR2,IBHDR3,IBS1,IBS2,IBS3,IBS4,IBQUIT,IBSP1,IBSP2,IBSORT1,IBSORT2
60 N IBLNX,IBITEM,IBCSN,IBEFDT,IBINDT,IBCHG,IBCHGB,IBRVCD I '$D(ZTQUEUED) U IO
61 S IBPGN=0,IBLN=999,IBQUIT=0 D GETHDR Q:$$HDR
62 ;
63 S IBS1="" F S IBS1=$O(^TMP($J,IBSCRPT,IBS1)) Q:IBS1="" D Q:IBQUIT
64 . I +IBSORT1=2 W !!,?20,"CHARGE SET: ",IBS1,! S IBLN=IBLN+3
65 . ;
66 . S IBS2="" F S IBS2=$O(^TMP($J,IBSCRPT,IBS1,IBS2)) Q:IBS2="" D Q:IBQUIT
67 .. S IBS3="" F S IBS3=$O(^TMP($J,IBSCRPT,IBS1,IBS2,IBS3)) Q:IBS3="" D Q:IBQUIT
68 ... S IBS4="" F S IBS4=$O(^TMP($J,IBSCRPT,IBS1,IBS2,IBS3,IBS4)) Q:IBS4="" D S IBQUIT=$$HDR Q:IBQUIT
69 .... ;
70 .... S IBLNX=$G(^TMP($J,IBSCRPT,IBS1,IBS2,IBS3,IBS4))
71 .... S IBITEM=$$EXPAND^IBCRU1(363.2,.01,$P(IBLNX,U,1))
72 .... S IBCSN="" I IBSORT1=1 S IBCSN=$P($G(^IBE(363.1,+$P(IBLNX,U,2),0)),U,1)
73 .... S IBEFDT=$$DATE^IBCRU1(+$P(IBLNX,U,3))
74 .... S IBINDT="" I +$P(IBLNX,U,4) S IBINDT=$$DATE^IBCRU1(+$P(IBLNX,U,4))
75 .... S IBCHG=$P(IBLNX,U,5),IBCHGB=$P(IBLNX,U,8) I IBCHGB'="" S IBCHGB="+"_$J(IBCHGB,0,2)
76 .... S IBRVCD=$$RVCPT(+$P(IBLNX,U,6),+$P(IBLNX,U,1),+$P(IBLNX,U,2))
77 .... I +$P(IBLNX,U,7) S IBITEM=IBITEM_"-"_$P($$MOD^ICPTMOD(+$P(IBLNX,U,7),"I",IBEFDT),U,2)
78 .... ;
79 .... I +IBSORT2=1 W !,$E(IBITEM,1,(31-IBSP1)),?(34-IBSP1),IBEFDT,?(44-IBSP1),IBINDT S IBLN=IBLN+1
80 .... I +IBSORT2'=1 W !,IBEFDT,?10,IBINDT,?21,$E(IBITEM,1,(32-IBSP1)) S IBLN=IBLN+1
81 .... I +IBSORT1=1 W ?(55-IBSP1),$E(IBCSN,1,(27-IBSP2)),?(82-IBSP1-IBSP2),$J(IBCHG,10,2),IBCHGB,?(102-IBSP1-IBSP2),IBRVCD
82 .... I +IBSORT1'=1 W ?(55-IBSP1),$J(IBCHG,10,2),IBCHGB,?(75-IBSP1),IBRVCD
83 I $P($G(^TMP($J,IBSCRPT)),U,4)'="" W !!,$P(^TMP($J,IBSCRPT),U,4)
84 I 'IBQUIT D PAUSE
85 Q
86 ;
87GETHDR ; set up header lines
88 N IBDT,IBS S IBHDR2="",(IBSP1,IBSP2)=0
89 S IBS=$G(^TMP($J,IBSCRPT)),IBSORT1=$P(IBS,U,2),IBSORT2=$P(IBS,U,3) I IBSORT1=1,$E(IOST,1,2)["C-" S IBSP1=23,IBSP2=2
90 S IBDT=$$HTE^XLFDT($H),IBDT=$P(IBDT,"@",1)_" "_$P($P(IBDT,"@",2),":",1,2)
91 S IBHDR1=$P(IBS,U,1),IBHDR1=IBHDR1_$J("",(IOM-$L(IBHDR1)-30))_IBDT_$J("",$L(IOM-8))_"Page "
92 ;
93 I +IBSORT2=1 S IBHDR2=$E("Charge Item ",1,(31-IBSP1))_" Effective Inactive "
94 I +IBSORT2=2 S IBHDR2="Effective Inactive "_$E("Charge Item ",1,(32-IBSP1))
95 I +IBSORT1=1 S IBHDR2=IBHDR2_" "_$E("Charge Set ",1,(27-IBSP2))_" Charge Rv Cd"
96 I +IBSORT1=2 S IBHDR2=IBHDR2_" Charge Rv Cd"
97 S IBHDR3="",$P(IBHDR3,"-",IOM+1)=""
98 Q
99 ;
100HDR() ;print the report header
101 N IBQUIT,X,Y S IBQUIT=0
102 S IBQUIT=$$STOP I +IBQUIT G HDRQ
103 I IBLN<(IOSL-3) G HDRQ
104 I IBPGN>0 D PAUSE I +IBQUIT G HDRQ
105 S IBPGN=IBPGN+1,IBLN=4
106 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
107 ;
108 W !,IBHDR1,IBPGN,!,IBHDR2,!,IBHDR3
109HDRQ Q IBQUIT
110 ;
111DEV ;get the device
112 S IBQUIT=0 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS I POP S IBQUIT=1 Q
113 I $D(IO("Q")) S ZTRTN="RPT^IBCROI",ZTDESC="Charge Item Report",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") S IBQUIT=1
114 Q
115 ;
116RVCPT(DRV,ITM,CS) ; returns revenue code: first CI rev code then rv-cpt link
117 N IBX,IBY S (IBX,IBY)=""
118 I +$G(DRV) S IBY=+DRV
119 I IBY="",+$G(ITM),+$G(CS) S IBY=$P($$RVLNK^IBCRU6(+ITM,"",+CS),U,2)
120 I IBY'="" S IBX=$P($G(^DGCR(399.2,+IBY,0)),U,1)
121 Q IBX
122 ;
123PAUSE ;pause at end of screen if being displayed on a terminal
124 Q:$E(IOST,1,2)'["C-" S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
125 Q
126 ;
127STOP() ; determine if user has requested the queued report to stop
128 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
129 Q +$G(ZTSTOP)
Note: See TracBrowser for help on using the repository browser.