source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAGMR1.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1IBAGMR1 ;WOIFO/AAT-GMT SINGLE PATIENT REPORT;12-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 ; IBDFN - Patient IEN
10 ; IBBDT - Beginning date
11 ; IBEDT - Ending date
12 ; Output:
13 ; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
14REPORT ;
15 N IBDT,IBDTE,IBDTH,IBCR,IBDA,IBAT,IBTMP,IBZ,IBCL,IBDTBF,IBDTBT
16 S IBQUIT=0
17 S IBTMP=$NA(^TMP($J,"IBAGMR")) ; The node of TMP array
18 K @IBTMP
19 ;
20 ; Marking beginning and ending of each clock within the range.
21 S IBDT="" F D Q:'IBDT Q:(-IBDT)<IBBDT
22 . S IBDT=$O(^IBE(351,"AIVDT",IBDFN,IBDT)) Q:'IBDT
23 . S IBCL=0 F D Q:'IBCL
24 .. S IBCL=$O(^IBE(351,"AIVDT",IBDFN,IBDT,IBCL)) Q:'IBCL
25 .. S IBZ=$G(^IBE(351,IBCL,0)) Q:IBZ=""
26 .. I $P(IBZ,U,4)=3 Q ; Status - CANCELLED
27 .. I (-IBDT)'<IBBDT,(-IBDT)'>IBEDT S @IBTMP@(-IBDT,"C")=IBCL ; Mark the beginning of the clock
28 .. ;S IBDTE=$P(+$P(IBZ,U,10),".") ;Expiration date
29 .. ;I IBDTE,IBDTE'<IBBDT,IBDTE'>IBEDT S @IBTMP@(IBDTE,"E")=IBCL ; Mark the ending of the clock
30 ;
31 ; Get the charges from file #350.
32 ; IBDT here - Parent Event Date
33 S IBDT=-(IBEDT+.00001) F S IBDT=$O(^IB("AFDT",IBDFN,IBDT)) Q:'IBDT D
34 . S IBCR=0 F S IBCR=$O(^IB("AFDT",IBDFN,IBDT,IBCR)) Q:'IBCR D
35 .. S IBDA=0 F S IBDA=$O(^IB("AF",IBCR,IBDA)) Q:'IBDA D
36 ... S IBZ=$G(^IB(IBDA,0)) I 'IBZ Q
37 ... Q:$P(IBZ,U,8)["ADMISSION"
38 ... ; Bill 'To' and 'From' dates
39 ... S IBDTBF=$P(IBZ,U,14),IBDTBT=$P(IBZ,U,15) S:IBDTBT="" IBDTBT=IBDTBF
40 ... I IBDTBT<IBBDT Q
41 ... I IBDTBF>IBEDT Q
42 ... S IBAT=$P(IBZ,U,3) Q:'IBAT ; Action type is really required
43 ... I $$ACTNM^IBOUTL(IBAT)["LTC " Q ; Exclude LTC action type
44 ... S @IBTMP@(+$P(IBZ,U,14),"I"_IBDA)=IBZ
45 ;
46 D PRINT
47 K @IBTMP ; Kill the temporary global node
48 S:$D(ZTQUEUED) ZTREQ="@" ; for Taskman
49 Q
50 ;
51PRINT ; Print report from the temp. global
52 N IBLINE,IBPAG,IBTOT,IBTOTS,IBPT,IBH,IBD,IBTY,IBDA,IBZ,IBCHG,IBSAV,IBSEQ,IBGMT,X,X2,X3,Y,%,IBCIS
53 D NOW^%DTC S IBDTH=$$FMTE^XLFDT($E(%,1,12))
54 S IBLINE="",$P(IBLINE,"=",IOM+1)="",(IBPAG,IBTOT,IBTOTS,IBQUIT,IBCHG)=0
55 S IBPT=$$PT^IBEFUNC(IBDFN)
56 S IBCIS=0
57 S IBH="GMT Single Patient Report for "_$P(IBPT,U)_" "_$P(IBPT,U,2) D HDR
58 I '$D(@IBTMP) W !!,"The patient has no MT/GMT bills within the specified period" D PAUSE(1) Q
59 ; - first, print detail lines
60 S IBD="" F S IBD=$O(@IBTMP@(IBD)) Q:'IBD D Q:IBQUIT
61 . S IBTY="" F S IBTY=$O(@IBTMP@(IBD,IBTY)) Q:IBTY="" D Q:IBQUIT
62 .. D CHKSTOP Q:IBQUIT
63 .. I IBTY="C" W !,$$DAT(IBD),?10,"Begin Means Test Billing Clock" K @IBTMP@(IBD,"E") Q
64 .. I IBTY="E" W !,$$DAT(IBD),?10,"Expire Means Test Billing Clock" Q
65 .. W !,$$DAT(IBD)
66 .. S IBDA=+$E(IBTY,2,99),IBZ=$G(^IB(IBDA,0)),IBSEQ=0
67 .. S IBAT=+$P(IBZ,U,3)
68 .. I $P(IBZ,U,14)'=$P(IBZ,U,15) W ?10,$$DAT($P(IBZ,U,15))
69 .. S IBSEQ=$P($G(^IBE(350.1,+$P(IBZ,U,3),0)),U,5)
70 .. W ?20,$E($$ACTNM^IBOUTL(+$P(IBZ,U,3)),1,25)
71 .. W ?46,$$STAT()
72 .. S IBCHG=+$P(IBZ,U,7)
73 .. S IBGMT=$P(IBZ,U,21)
74 .. I IBSEQ=2 S IBCHG=-IBCHG I 'IBGMT S IBGMT=$P($G(^IB(+$P(IBZ,U,9),0)),U,21)
75 .. ; The Charge provide GMT Savings if it has GMT RELATED field set to "1"
76 .. S IBSAV=$S(IBGMT:IBCHG*4,1:0) ;GMT Savings
77 .. I $P(IBZ,U,11)="",$P($G(^IBE(350.21,+$P(IBZ,U,5),0)),U,5) S (IBCHG,IBSAV)=0
78 .. W ?56,$$FORMAT(IBCHG,10) W:IBSAV ?68,$$FORMAT(IBSAV,10)
79 .. S IBTOT=IBTOT+IBCHG ; Total
80 .. S IBTOTS=IBTOTS+IBSAV ; Savings total
81 .. I IBSEQ=2!($P(IBZ,U,11)=""&($P($G(^IBE(350.21,+$P(IBZ,U,5),0)),U,5))) W !?5,"Charge Removal Reason: ",$S($D(^IBE(350.3,+$P(IBZ,U,10),0)):$P(^(0),U),1:"UNKNOWN")
82 Q:IBQUIT
83 I IBTOT D TOTALS
84 D PAUSE(1)
85 Q
86 ;Number format
87FORMAT(IBNUM,IBDIG,IBFRM) ;
88 N X,X1,X2,X3
89 S X=IBNUM,X2=$G(IBFRM,"2$"),X3=IBDIG
90 D COMMA^%DTC
91 Q X
92 ;
93CHKSTOP I $Y>(IOSL-5) D PAUSE(0) Q:IBQUIT D HDR
94 Q
95 ;
96 ;
97HDR ; Print header.
98 N IBI
99 I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
100 S IBPAG=IBPAG+1 W ?(80-$L(IBH)\2),IBH
101 W !,"From ",$$DAT(IBBDT)," through ",$$DAT(IBEDT)
102 W ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
103 W !,"BILL FROM BILL TO BILL TYPE",?46,"BILL # TOT CHRG TOT GMT DIFF"
104 W ! F IBI=1:1:80 W "-"
105 Q
106 ;
107TOTALS N IBI,X
108 W !,?56 F IBI=1:1:22 W "-"
109 W !,?54,$$FORMAT(IBTOT,12),?66,$$FORMAT(IBTOTS,12)
110 Q
111 ;
112STAT() ; Display bill number or status
113 N IBSTAT S IBSTAT=$G(^IBE(350.21,+$P(IBZ,U,5),0))
114 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")
115 ;
116HLD(STAT) ; Return an 'on hold' status string
117 Q "Hold "_$S(STAT=20:"Rate",STAT=21:"Rev",1:"Ins")
118 ;
119PAUSE(IBEND) ;
120 Q:$E(IOST,1,2)'["C-"
121 N IBJ,DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
122 W !! ;F IBJ=$Y:1:(IOSL-4) W !
123 S DIR(0)="E"
124 I $G(IBEND) S DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
125 D ^DIR K DIR I $G(DUOUT) S IBQUIT=1 W @IOF Q
126 I $G(IBEND) W @IOF
127 Q
128 ;
129DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
130 Q $$FMTE^XLFDT(IBDT,"2MZ")
131 ;
132 ; Action Billing Group
133BILGR(IBACT) ; Input pointer to Action Type File #350.1
134 ; Output - Billing Group
135 N IBNEW
136 S IBNEW=$P($G(^IBE(350.1,+IBACT,0)),U,9) ;New action type
137 Q +$S($P($G(^IBE(350.1,+IBNEW,0)),U,11):$P(^(0),U,11),1:$P($G(^IBE(350.1,+IBACT,0)),U,11))
Note: See TracBrowser for help on using the repository browser.