source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPORMB.m@ 1396

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1RMPORMB ;HIN/RVD - Home Oxygen Monthly Billing Report ;12/13/99
2 ;;3.0;PROSTHETICS;**29,43,44,49,55**;Feb 09, 1996
3 ;ODJ - 5/17/00 - fix FCP problem (patch 49)
4 ; 5/25/00 - fix crash if FCP in ^RMPO(665.72) and not ^RMPR(669.9)
5 ; 5/31/00 - fix crash if FCP is null
6 ;
7 ;ODJ - 10/31/00 - patch 55 - fix problem where totals not being
8 ; displayed when page contains 16 pats.
9START ;
10 K RQUIT,RSP,RCNT,RPAGE,RDASH,RPTDT,RSHODT,VA,VADM,DFN,RNAM,RMNADFN
11 K Y,RAMT,RLINE,ROVNDR,^TMP($J),RMEND,QUIT
12 ;
13SITE ;Intialize site variables.
14 D HOSITE^RMPOUTL0 I '$D(RMPOXITE) Q
15 ;
16FROM ; Get billing month
17 ; specify start/end site & bill month
18 D MONTH^RMPOBIL0() Q:'$D(RMPODATE)!QUIT
19DEV S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT I '$D(IO("Q")) U IO G PROC
20 K IO("Q") S ZTDESC="HOME OXYGEN MONTHLY BILLING",ZTRTN="PROC^RMPORMB",ZTIO=IO,ZTSAVE("RMPODATE")="",ZTSAVE("RMPO(""STA"")")="",ZTSAVE("RMPOXITE")=""
21 S ZTSAVE("RMPO(""NAME"")")=""
22 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
23PROC ;
24 S (RPAGE,RMEND,RMPORPT,RVCNT,RPCNT,RVPRCNT)=0
25 S Y=RMPODATE D DD^%DT S RSHODT=Y
26 S $P(RSP," ",79)=" ",RCNT=0,$P(RDASH,"-",80)=""
27 D NOW^%DTC S Y=% X ^DD("DD")
28 S RPTDT=$P(Y,"@",1)_" "_$P($P(Y,"@",2),":",1,2)
29 F I="T9","TS","TO","SP",1,2,3 S RAMT(I)=0
30 K RFCPT S RFCPI=""
31 F S RFCPI=$O(^RMPR(669.9,RMPOXITE,"RMPOFCP","B",RFCPI)) Q:RFCPI="" D
32 . S RFCPIEN=$O(^RMPR(669.9,RMPOXITE,"RMPOFCP","B",RFCPI,0))
33 . S RPSASFLG=$P(^RMPR(669.9,RMPOXITE,"RMPOFCP",RFCPIEN,0),U,2)
34 . ;S RFCPT(RFCPI)=$S(+RFCPI=910:1,RPSASFLG="Y":2,1:3)
35 . ;p49 replaces above logic - if PSAS then col 1 else col 2
36 . S RFCPT(RFCPI)=$S(RPSASFLG="Y":1,1:2)
37 . Q
38 D LINE
39 D PRINT G:$G(RMEND) EXIT
40 I $E(IOST)["C",(RVCNT=1),(RVPRCNT=1) D ; if terminal
41 .K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
42 .D ^DIR S:$G(X)[U RMEND=1
43EXIT ;clean-up local variables and close device
44 D ^%ZISC K ^TMP($J)
45 N RMPR,RMPRSITE D KILL^XUSCLEAN
46 Q
47 ;
48NAME ;Write out the name
49 S RLINE=RLINE_$E($P(RNAM,U,1)_RSP,1,14)
50 S RLINE=RLINE_$E($P(RNAM,U,2)_RSP,1,6)
51 Q
52 ;
53LINE ;Process entire line (one for each patient)
54 W:$E(IOST)["C" "processing..."
55 F RV=0:0 S RV=$O(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV)) Q:RV'>0 D SETRV F RN=0:0 S RN=$O(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN)) Q:RN'>0 D
56 .K VA,VADM S DFN=RN D ^VADPT
57 .S RNAM=$E(VADM(1),1,12)_"^"_$P(VA("PID"),"-",3)
58 .S RACPT=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,0),U,2)
59 .S RPSTD=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,0),U,3)
60 .S RAMT(RV,1)=0,RAMT(RV,2)=0,RAMT(RV,3)=0,RAMT(RV,"SUSP")=0
61 .F RI=0:0 S RI=$O(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,1,RI)) Q:RI'>0 D
62 ..S RD=^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,1,RI,0)
63 ..S RCOST=$P(RD,U,5),RTOTAL=$P(RD,U,6),RFCP=$P(RD,U,3),RSUSP=$P(RD,U,11)
64 ..S:RFCP="" RFCP="???"
65 ..I '$D(RFCPT(RFCP)) S RFCPT(RFCP)=2 ;p49 fix problem where FCP not in site file ^RMPR(669.9) (use the OTHER col. in this case)
66 ..S RX=RFCPT(RFCP),RAMT(RV,RX)=$G(RAMT(RV,RX))+RTOTAL,RAMT(RV,"SUSP")=$G(RAMT(RV,"SUSP"))+RSUSP
67 .S RLINE=$S(RACPT="Y":"a",1:" ")_$S(RPSTD="Y":"#",RPSTD="P":"p",1:" ")
68 .S RLINE=$E(RLINE_RSP,1,4) D NAME
69 .S RLINE=RLINE_$E($P(^PRC(440,RV,0),U)_RSP,1,8)_" "
70 .S RMT1=$G(RAMT(RV,1))
71 .S RMT2=$G(RAMT(RV,2))
72 .S RMT3=$G(RAMT(RV,3))
73 .S RMTP=$G(RAMT(RV,"SUSP"))
74 .D AMTS(RMT1,RMT2,RMT3,RMTP)
75 .S RTMT(RV,"T9")=RTMT(RV,"T9")+RMT1,RTMT(RV,"TS")=RTMT(RV,"TS")+RMT2
76 .S RTMT(RV,"TO")=RTMT(RV,"TO")+RMT3,RTMT(RV,"SP")=RTMT(RV,"SP")+RMTP
77 .S RMNADFN=RNAM_"^"_RN,^TMP($J,RV,RMNADFN)=RLINE
78 Q
79 ;
80PRINT ;print report
81 I '$D(^TMP($J)) W !,"***** No RECORDS to Print *****" Q
82 S (RVPRCNT,RPCNT,RCNT)=0
83 F RV=0:0 S RV=$O(^TMP($J,RV)) Q:RV'>0!($G(RMEND)) D RPTHDR S RN="" F S RN=$O(^TMP($J,RV,RN)) Q:$G(RMEND) D:RN="" DND Q:RN="" D
84 .W !,$G(^TMP($J,RV,RN)) S RPCNT=RPCNT+1,RCNT=RCNT+1 D:IOSL<(RCNT+9) PAGE Q:$G(RMEND)
85 D GTOTAL
86 Q
87 ;
88SETRV ;
89 F I=1,2,3 S RAMT(RV,I)=0
90 F I="T9","TS","TO","SP" S RTMT(RV,I)=0
91 S RVCNT=RVCNT+1
92 Q
93 ;
94AMTS(C,Y,Z,S) ; Amounts
95 S RLINE=RLINE_$E($$AMT(C)_RSP,1,9)
96 S RLINE=RLINE_$E($$AMT(Y)_RSP,1,9)
97 S RLINE=RLINE_$E($$AMT(Z)_RSP,1,9)
98 S RLINE=RLINE_$E($$AMT(S)_RSP,1,9)
99 S RLINE=RLINE_" "_$$AMT(C+Y+Z)
100 Q
101AMT(C) ; Format Amounts
102 I C,C'["." S C=+C_".00"
103 I C?.N1"."1N S C=C_0
104 S:C=0 C="-" S C=$E(" ",1,8-$L(C))_C
105 Q C
106 ;
107PAGE ;Print page
108 I $E(IOST)["C",IOSL<(RCNT+9) D ; if terminal
109 . K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
110 . D ^DIR S:$G(X)[U RMEND=1
111 D:'$G(RMEND) RPTHDR
112 Q
113RPTHDR ; Print out the report header
114 Q:$G(RMEND) K RA
115 S RA=RMPO("NAME"),RPAGE=RPAGE+1,RCNT=0
116 I $E(IOST)["C"!(RPAGE>1) W @IOF
117 W RPTDT,?(40-($L(RA)/2)),RA,?68,"Page: "_RPAGE
118 W !?15,RSHODT_" Monthly Home Oxygen Billing",!
119 W ?50,"Station",!?50,"Fund Control"
120 W !,"ACC",?4,"Name",?18,"SSN",?24,"Vendor"
121 W ?37,"910 Point Other Susp Total"
122 W !,RDASH
123 Q
124 ;
125DND ; Print REPORT totals
126 Q:$G(RMEND) K RA
127 S RLINE=" ",RA=RTMT(RV,"T9")+RTMT(RV,"TS")+RTMT(RV,"TO")-RTMT(RV,"SP")
128 I RA D
129 . S RMTT9=RTMT(RV,"T9"),RMTTS=RTMT(RV,"TS"),RMTTO=RTMT(RV,"TO")
130 . S RMTSP=RTMT(RV,"SP")
131 . D AMTS(RMTT9,RMTTS,RMTTO,RMTSP)
132 . W !,?20,"Totals: ",RLINE
133 S RPCNT=$E(" ",1,(6-$L(RPCNT)))_RPCNT
134 W !!,?30,"Total Patients: ",RPCNT
135 S RVPRCNT=RVPRCNT+1,RPCNT=0
136 I $E(IOST)["C",(RVCNT'=RVPRCNT) D ; if terminal
137 .K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
138 .D ^DIR S:$G(X)[U RMEND=1
139 Q
140 ;
141GTOTAL ; Print REPORT totals for all VENDORS.
142 Q:$G(RMEND) K RA
143 ;S RLINE=" ",RA=RTMT(RV,"T9")+RTMT(RV,"TS")+RTMT(RV,"TO")-RTMT(RV,"SP")
144 S RLINE=" "
145 S (RMTT9,RMTTS,RMTTO,RMTSP)=0
146 I RVCNT>1 D
147 .F RI=0:0 S RI=$O(RTMT(RI)) Q:RI'>0 D
148 .. S RMTT9=RMTT9+RTMT(RI,"T9"),RMTTS=RMTTS+RTMT(RI,"TS"),RMTTO=RMTTO+RTMT(RI,"TO")
149 .. S RMTSP=RMTSP+RTMT(RI,"SP")
150 .D AMTS(RMTT9,RMTTS,RMTTO,RMTSP)
151 .W !!,?14,"Grand Totals: ",RLINE,!
152 .I $E(IOST)["C" D ; if terminal
153 ..K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
154 ..D ^DIR S:$G(X)[U RMEND=1
155 Q
Note: See TracBrowser for help on using the repository browser.