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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1IBAGMM1 ;WOIFO/AAT-GMT MONTHLY TOTALS REPORT;30-JUL-02
2 ;;2.0;INTEGRATED BILLING;**183**;21-MAR-94
3 ;; Per VHA Directive 10-93-142, this routine should not be modified
4 Q
5 ;
6 ; Prints report to the current device
7 ;
8 ; Input:
9 ; IBBDT - Beginning date
10 ; IBEDT - Ending date
11 ; Output:
12 ; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
13REPORT ;
14 N IBDT,IBDTE,IBDTH,IBCR,IBDA,IBAT,IBBG,IBTMP,IBZ,IBCL
15 S IBQUIT=0
16 S IBTMP=$NA(^TMP($J,"IBAGMM")) ; The node of TMP array
17 K @IBTMP
18 ;
19 ; Scan charges, created in the date range IBBDT-31 .. IBEDT
20 ; a charge cannot be for period longer than 30 days.
21 ; Index -
22 ;
23 ; Get the charges from file #350 to the temporary global
24 ; IBDT here - Parent Event Date
25 S IBDT=$$PLUS(IBBDT,-31) F S IBDT=$O(^IB("D",IBDT)) Q:'IBDT Q:$P(IBDT,".")>IBEDT D
26 . S IBCR=0 F S IBCR=$O(^IB("D",IBDT,IBCR)) Q:'IBCR D PROC(IBCR)
27 ;
28 D PRINT
29 K @IBTMP ; Kill the temporary global node
30 S:$D(ZTQUEUED) ZTREQ="@" ; for Taskman
31 Q
32 ;
33PRINT ; Print report from the temp. global
34 N IBLINE,IBPAG,IBTOT,IBTOTS,IBTOTI,IBD,IBTY,IBDA,IBY,IBCHG,IBSAV,IBSEQ,IBMON,X,X2,X3,Y,%
35 D NOW^%DTC S IBDTH=$$FMTE^XLFDT($E(%,1,12))
36 S IBLINE="",$P(IBLINE,"=",IOM+1)="",(IBPAG,IBTOT,IBTOTS,IBTOTI,IBQUIT,IBCHG)=0
37 D HDR
38 I '$D(@IBTMP@("M")) W !!,"No GMT charges found within the specified period" D PAUSE(1) Q
39 ; - first, print detail lines
40 F IBMON=$E(IBBDT,1,5):1:$E(IBEDT,1,5) D Q:IBQUIT
41 . D CHKSTOP Q:IBQUIT
42 . S IBY=$G(@IBTMP@("M",IBMON))
43 . W !,$$MON($E(IBMON,4,5)),?10,1700+$E(IBMON,1,3)
44 . ;W ?16,$J($P(IBY,U,1),4) ;Number of charges not required
45 . W ?22,$J($P(IBY,U,2),3)
46 . W ?31,$$FORMAT($P(IBY,U,3),12,2),?46,$$FORMAT($P(IBY,U,4),12,2)
47 . I $P(IBY,U,5) W ?61,$$FORMAT($P(IBY,U,5),12,2)
48 . S IBTOT=IBTOT+$P(IBY,U,3),IBTOTS=IBTOTS+$P(IBY,U,4),IBTOTI=IBTOTI+$P(IBY,U,5)
49 Q:IBQUIT
50 I (IBTOT!IBTOTI) D TOTALS
51 D PAUSE(1)
52 Q
53 ;Number format
54FORMAT(IBNUM,IBDIG,IBFRM) N X,X1,X2,X3
55 S X=IBNUM,X2=$G(IBFRM,"2$"),X3=IBDIG
56 D COMMA^%DTC
57 Q X
58 ;
59CHKSTOP I $Y>(IOSL-5) D PAUSE(0) Q:IBQUIT D HDR
60 Q
61 ;
62 ;
63HDR ; Print header.
64 N IBI
65 I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
66 S IBH="GMT MONTHLY TOTALS REPORT"
67 S IBPAG=IBPAG+1 W ?(70-$L(IBH)\2),IBH
68 W !,"From ",$$DAT(IBBDT)," through ",$$DAT(IBEDT)
69 W ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
70 W !!," MONTH",?10,"YEAR",?16,"# GMT PATIENTS ",?32,"GMT BILLED",?48,"GMT DIFF",?65,"PENDING"
71 W ! F IBI=1:1:80 W "-"
72 Q
73 ;
74TOTALS N IBI,X
75 W !,?30 F IBI=1:1:45 W "-"
76 W !,?29,$$FORMAT(IBTOT,14),?44,$$FORMAT(IBTOTS,14),?59,$$FORMAT(IBTOTI,14)
77 Q
78 ;
79STAT() ; Display bill number or status
80 N IBSTAT S IBSTAT=$G(^IBE(350.21,+$P(IBZ,U,5),0))
81 Q $S($P(IBSTAT,U,6):$$HLD(+$P(IBZ,U,5)),$P(IBZ,U,5)=99:"Converted",$P(IBZ,U,11)]"":$P($P(IBZ,U,11),"-",2),$P(IBSTAT,U,5):"Cancelled",1:"Pending")
82 ;
83HLD(STAT) ; Return an 'on hold' status string
84 Q "Hold "_$S(STAT=20:"Rate",STAT=21:"Rev",1:"Ins")
85 ;
86PAUSE(IBEND) ;
87 Q:$E(IOST,1,2)'["C-"
88 N IBJ,DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
89 W !! ;F IBJ=$Y:1:(IOSL-4) W !
90 S DIR(0)="E"
91 I $G(IBEND) S DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
92 D ^DIR K DIR I $G(DUOUT) S IBQUIT=1 W @IOF Q
93 I $G(IBEND) W @IOF
94 Q
95 ;
96DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
97 Q $$FMTE^XLFDT(IBDT,"2MZ")
98 ;
99PLUS(IBDT,IBDAYS) N X,X1,X2
100 S X1=IBDT,X2=IBDAYS
101 D C^%DTC
102 Q X
103 ;
104 ;Add the data to tmp global, if needed.
105PROC(IBDA) N IBDTBT,IBMON,IBZ,IBY,IBDFN,IBSTA,IBCRG,IBSEQ,IBGMT
106 S IBZ=$G(^IB(IBDA,0)) I 'IBZ Q
107 S IBSTA=$P(IBZ,U,5) I IBSTA=9 Q ; ERROR charges will not be considered
108 S IBCRG=$P(IBZ,U,7) I 'IBCRG Q ;Zero amount
109 Q:$P(IBZ,U,8)["ADMISSION"
110 S IBDTBT=$P(IBZ,U,15) S:IBDTBT="" IBDTBT=$P(IBZ,U,14)
111 S IBDTBT=$P(IBDTBT,".")
112 Q:IBDTBT<IBBDT Q:IBDTBT>IBEDT ;"BILLED TO" date must be within the date range
113 ; Do not include cancelled charges with no bill No.
114 I $P(IBZ,U,11)="",$P($G(^IBE(350.21,+$P(IBZ,U,5),0)),U,5) Q
115 S IBGMT=$P(IBZ,U,21)
116 S IBSEQ=$P($G(^IBE(350.1,+$P(IBZ,U,3),0)),U,5)
117 I IBSEQ=2,'IBGMT,$P(IBZ,U,9) S IBGMT=$P($G(^IB(+$P(IBZ,U,9),0)),U,21) ; Maybe the parent charge is GMT RELATED?
118 Q:'IBGMT ; The charge is not GMT RELATED.
119 I IBSEQ=2 S IBCRG=-IBCRG
120 S IBMON=$E(IBDTBT,1,5) ;Month
121 S IBDFN=$P(IBZ,U,2)
122 S IBY=$G(@IBTMP@("M",IBMON)) ;Monthly statistics node
123 S $P(IBY,U,1)=$P(IBY,U,1)+1 ; Charge Counter
124 I '$D(@IBTMP@("P",IBDFN,IBMON)) S $P(IBY,U,2)=$P(IBY,U,2)+1,@IBTMP@("P",IBDFN,IBMON)="" ; Patient Counter
125 I IBSTA'=1 S $P(IBY,U,3)=$P(IBY,U,3)+IBCRG ; GMT Charges Monthly Total
126 I IBSTA'=1 S $P(IBY,U,4)=$P(IBY,U,4)+(IBCRG*4) ; GMT Charges Monthly Difference
127 I IBSTA=1 S $P(IBY,U,5)=$P(IBY,U,5)+IBCRG ; GMT Incompleted Charges Monthly Total
128 S @IBTMP@("M",IBMON)=IBY
129 Q
130MON(IBMON) I (IBMON<1)!(IBMON>12) Q ""
131 Q $P("JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER"," ",IBMON)
132 ;
Note: See TracBrowser for help on using the repository browser.