VistA-FOIAVistA/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPORMB.m

156 lines
5.8 KiB
Mathematica

RMPORMB ;HIN/RVD - Home Oxygen Monthly Billing Report ;12/13/99
;;3.0;PROSTHETICS;**29,43,44,49,55**;Feb 09, 1996
;ODJ - 5/17/00 - fix FCP problem (patch 49)
; 5/25/00 - fix crash if FCP in ^RMPO(665.72) and not ^RMPR(669.9)
; 5/31/00 - fix crash if FCP is null
;
;ODJ - 10/31/00 - patch 55 - fix problem where totals not being
; displayed when page contains 16 pats.
START ;
K RQUIT,RSP,RCNT,RPAGE,RDASH,RPTDT,RSHODT,VA,VADM,DFN,RNAM,RMNADFN
K Y,RAMT,RLINE,ROVNDR,^TMP($J),RMEND,QUIT
;
SITE ;Intialize site variables.
D HOSITE^RMPOUTL0 I '$D(RMPOXITE) Q
;
FROM ; Get billing month
; specify start/end site & bill month
D MONTH^RMPOBIL0() Q:'$D(RMPODATE)!QUIT
DEV S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT I '$D(IO("Q")) U IO G PROC
K IO("Q") S ZTDESC="HOME OXYGEN MONTHLY BILLING",ZTRTN="PROC^RMPORMB",ZTIO=IO,ZTSAVE("RMPODATE")="",ZTSAVE("RMPO(""STA"")")="",ZTSAVE("RMPOXITE")=""
S ZTSAVE("RMPO(""NAME"")")=""
D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
PROC ;
S (RPAGE,RMEND,RMPORPT,RVCNT,RPCNT,RVPRCNT)=0
S Y=RMPODATE D DD^%DT S RSHODT=Y
S $P(RSP," ",79)=" ",RCNT=0,$P(RDASH,"-",80)=""
D NOW^%DTC S Y=% X ^DD("DD")
S RPTDT=$P(Y,"@",1)_" "_$P($P(Y,"@",2),":",1,2)
F I="T9","TS","TO","SP",1,2,3 S RAMT(I)=0
K RFCPT S RFCPI=""
F S RFCPI=$O(^RMPR(669.9,RMPOXITE,"RMPOFCP","B",RFCPI)) Q:RFCPI="" D
. S RFCPIEN=$O(^RMPR(669.9,RMPOXITE,"RMPOFCP","B",RFCPI,0))
. S RPSASFLG=$P(^RMPR(669.9,RMPOXITE,"RMPOFCP",RFCPIEN,0),U,2)
. ;S RFCPT(RFCPI)=$S(+RFCPI=910:1,RPSASFLG="Y":2,1:3)
. ;p49 replaces above logic - if PSAS then col 1 else col 2
. S RFCPT(RFCPI)=$S(RPSASFLG="Y":1,1:2)
. Q
D LINE
D PRINT G:$G(RMEND) EXIT
I $E(IOST)["C",(RVCNT=1),(RVPRCNT=1) D ; if terminal
.K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
.D ^DIR S:$G(X)[U RMEND=1
EXIT ;clean-up local variables and close device
D ^%ZISC K ^TMP($J)
N RMPR,RMPRSITE D KILL^XUSCLEAN
Q
;
NAME ;Write out the name
S RLINE=RLINE_$E($P(RNAM,U,1)_RSP,1,14)
S RLINE=RLINE_$E($P(RNAM,U,2)_RSP,1,6)
Q
;
LINE ;Process entire line (one for each patient)
W:$E(IOST)["C" "processing..."
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
.K VA,VADM S DFN=RN D ^VADPT
.S RNAM=$E(VADM(1),1,12)_"^"_$P(VA("PID"),"-",3)
.S RACPT=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,0),U,2)
.S RPSTD=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,0),U,3)
.S RAMT(RV,1)=0,RAMT(RV,2)=0,RAMT(RV,3)=0,RAMT(RV,"SUSP")=0
.F RI=0:0 S RI=$O(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,1,RI)) Q:RI'>0 D
..S RD=^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,1,RI,0)
..S RCOST=$P(RD,U,5),RTOTAL=$P(RD,U,6),RFCP=$P(RD,U,3),RSUSP=$P(RD,U,11)
..S:RFCP="" RFCP="???"
..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)
..S RX=RFCPT(RFCP),RAMT(RV,RX)=$G(RAMT(RV,RX))+RTOTAL,RAMT(RV,"SUSP")=$G(RAMT(RV,"SUSP"))+RSUSP
.S RLINE=$S(RACPT="Y":"a",1:" ")_$S(RPSTD="Y":"#",RPSTD="P":"p",1:" ")
.S RLINE=$E(RLINE_RSP,1,4) D NAME
.S RLINE=RLINE_$E($P(^PRC(440,RV,0),U)_RSP,1,8)_" "
.S RMT1=$G(RAMT(RV,1))
.S RMT2=$G(RAMT(RV,2))
.S RMT3=$G(RAMT(RV,3))
.S RMTP=$G(RAMT(RV,"SUSP"))
.D AMTS(RMT1,RMT2,RMT3,RMTP)
.S RTMT(RV,"T9")=RTMT(RV,"T9")+RMT1,RTMT(RV,"TS")=RTMT(RV,"TS")+RMT2
.S RTMT(RV,"TO")=RTMT(RV,"TO")+RMT3,RTMT(RV,"SP")=RTMT(RV,"SP")+RMTP
.S RMNADFN=RNAM_"^"_RN,^TMP($J,RV,RMNADFN)=RLINE
Q
;
PRINT ;print report
I '$D(^TMP($J)) W !,"***** No RECORDS to Print *****" Q
S (RVPRCNT,RPCNT,RCNT)=0
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
.W !,$G(^TMP($J,RV,RN)) S RPCNT=RPCNT+1,RCNT=RCNT+1 D:IOSL<(RCNT+9) PAGE Q:$G(RMEND)
D GTOTAL
Q
;
SETRV ;
F I=1,2,3 S RAMT(RV,I)=0
F I="T9","TS","TO","SP" S RTMT(RV,I)=0
S RVCNT=RVCNT+1
Q
;
AMTS(C,Y,Z,S) ; Amounts
S RLINE=RLINE_$E($$AMT(C)_RSP,1,9)
S RLINE=RLINE_$E($$AMT(Y)_RSP,1,9)
S RLINE=RLINE_$E($$AMT(Z)_RSP,1,9)
S RLINE=RLINE_$E($$AMT(S)_RSP,1,9)
S RLINE=RLINE_" "_$$AMT(C+Y+Z)
Q
AMT(C) ; Format Amounts
I C,C'["." S C=+C_".00"
I C?.N1"."1N S C=C_0
S:C=0 C="-" S C=$E(" ",1,8-$L(C))_C
Q C
;
PAGE ;Print page
I $E(IOST)["C",IOSL<(RCNT+9) D ; if terminal
. K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
. D ^DIR S:$G(X)[U RMEND=1
D:'$G(RMEND) RPTHDR
Q
RPTHDR ; Print out the report header
Q:$G(RMEND) K RA
S RA=RMPO("NAME"),RPAGE=RPAGE+1,RCNT=0
I $E(IOST)["C"!(RPAGE>1) W @IOF
W RPTDT,?(40-($L(RA)/2)),RA,?68,"Page: "_RPAGE
W !?15,RSHODT_" Monthly Home Oxygen Billing",!
W ?50,"Station",!?50,"Fund Control"
W !,"ACC",?4,"Name",?18,"SSN",?24,"Vendor"
W ?37,"910 Point Other Susp Total"
W !,RDASH
Q
;
DND ; Print REPORT totals
Q:$G(RMEND) K RA
S RLINE=" ",RA=RTMT(RV,"T9")+RTMT(RV,"TS")+RTMT(RV,"TO")-RTMT(RV,"SP")
I RA D
. S RMTT9=RTMT(RV,"T9"),RMTTS=RTMT(RV,"TS"),RMTTO=RTMT(RV,"TO")
. S RMTSP=RTMT(RV,"SP")
. D AMTS(RMTT9,RMTTS,RMTTO,RMTSP)
. W !,?20,"Totals: ",RLINE
S RPCNT=$E(" ",1,(6-$L(RPCNT)))_RPCNT
W !!,?30,"Total Patients: ",RPCNT
S RVPRCNT=RVPRCNT+1,RPCNT=0
I $E(IOST)["C",(RVCNT'=RVPRCNT) D ; if terminal
.K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
.D ^DIR S:$G(X)[U RMEND=1
Q
;
GTOTAL ; Print REPORT totals for all VENDORS.
Q:$G(RMEND) K RA
;S RLINE=" ",RA=RTMT(RV,"T9")+RTMT(RV,"TS")+RTMT(RV,"TO")-RTMT(RV,"SP")
S RLINE=" "
S (RMTT9,RMTTS,RMTTO,RMTSP)=0
I RVCNT>1 D
.F RI=0:0 S RI=$O(RTMT(RI)) Q:RI'>0 D
.. S RMTT9=RMTT9+RTMT(RI,"T9"),RMTTS=RMTTS+RTMT(RI,"TS"),RMTTO=RMTTO+RTMT(RI,"TO")
.. S RMTSP=RMTSP+RTMT(RI,"SP")
.D AMTS(RMTT9,RMTTS,RMTTO,RMTSP)
.W !!,?14,"Grand Totals: ",RLINE,!
.I $E(IOST)["C" D ; if terminal
..K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
..D ^DIR S:$G(X)[U RMEND=1
Q