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