source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5N4.m@ 1540

RMPR5N4 ;HIN/RVD-PRINT LAB ITEM SUMMARY BY EMPLOYEE ;3/13/1998
 ;;3.0;PROSTHETICS;**33,37**;Feb 09, 1996
EN N RMEMP D DIV4^RMPRSIT
 K ^TMP($J),RMPRFLG,RMPRI S RMPREND=0 D HOME^%ZIS G:$D(X) EXIT1
 S DIC="^VA(200,",DIC(0)="MAEQ"
EN1 R !!,"Enter 'ALL' for all Lab Employees or 'RETURN' to select individual names: ",RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1
 G:RMENTER["?" EN1
 S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y I RMENTER="ALL" S RMPRI(0)=1 G CONT
 W ! F EMP=1:1 S DIC("A")="Select EMPLOYEE "_EMP_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(EMP=1)) EXIT1 Q:X=""  D
 .S RMEMP=$P(^VA(200,+Y,0),U,1) Q:RMEMP=""
 .I $D(RMPRI(RMEMP)) W $C(7)," ??",?40,"..Duplicate employee name" S EMP=EMP-1 Q
 .S RMPRI(RMEMP)=+Y
CONT G:'$D(RMPRI) EXIT1 S RMPRCOUN=0 W !! S %DT("A")="Beginning Date: ",%DT="AEPX",%DT("B")="T-30" D ^%DT S RMPRBDT=Y G:Y<0 EXIT1
ENDATE S %DT("A")="Ending Date: ",%DT="AEX",%DT("B")="TODAY" D ^%DT G:Y<0 EXIT1 I RMPRBDT>Y W !,$C(7),"Invalid Date Range Selection!!" G ENDATE
 G:Y<0 EXIT1 S RMPREDT=Y,Y=RMPRBDT D DD^%DT S RMPRX=Y,Y=RMPREDT D DD^%DT S RMPRY=Y
 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
 I '$D(IO("Q")) U IO G PRINT
 K IO("Q") S ZTDESC="PROS LAB ITEM SUMMARY",ZTRTN="PRINT^RMPR5N4",ZTIO=IO,ZTSAVE("RMPRBDT")="",ZTSAVE("RMPREDT")="",ZTSAVE("RMPRI(")="",ZTSAVE("RMPRX")="",ZTSAVE("RMPRY")="",ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPR(")=""
 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
PRINT I $E(IOST)["C" W !!,"Processing report......"
 ;ENTRY POINT FOR PRINTING REPORT
 W:$E(IOST)["C" @IOF S RMPAGE=1,RMPREND=0 D:$D(RMPRI(0)) ALL
 I '$D(RMPRI) D NONEALL G EXIT
 ;D HEAD
 S RMD="" F  S RMD=$O(RMPRI(RMD)) Q:RMD=""  S RMI=RMPRI(RMD) D PRI1
 G:RMPREND EXIT D WRI D:'$D(^TMP($J)) NONEALL G EXIT
 ;
PRI1 F RO=0:0 S RO=$O(^RMPR(661.2,"F",RMI,RO)) Q:(RO'>0)!(RMPREND)  D REST
 D:'$D(^TMP($J,RMD))&'$D(RMPRI(0)) NONE
 Q
 ;
EXIT ;Exit
 ;I RMPRCOUN>0,$D(RMPREDT),'$D(KILL) D  W !!?32,"END OF REPORT"
 ;I $E(IOST)["C"&($Y<22) F  W ! Q:$Y>20
 I $D(RMPREDT),$E(IOST)["C",'$D(DUOUT),'$D(DTOUT),'RMPREND K DIR S DIR(0)="E" D ^DIR
EXIT1 ;
 D ^%ZISC
 N RMPR,RMPRSITE D KILL^XUSCLEAN
 Q
 ;
HEAD ;write heading
 W !,?18,"PROSTHETICS LAB ITEM SUMMARY BY EMPLOYEE",?64,"Page: ",RMPAGE
 W !,RMPRX," to ",RMPRY
 S RMPAGE=RMPAGE+1
 Q
HEAD1 I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND  W @IOF D HEAD
 I $E(IOST)'["C"&($Y>(IOSL-6)) W @IOF D HEAD
 W !,RMPR("L"),!,"Employee: ",I
 W !,"  DATE",?17,"ITEM",?43,"HCPCS",?51,"TIME SPENT(hr)",?68,"LABOR COST"
 W !,"  ----",?17,"----",?43,"-----",?51,"--------------",?68,"----------"
 S RMPRFLG=1
 Q
 ;
SUM W !,?53,"--------",?70,"--------",!,?39,"***TOTALS =",?53,$J(RMTITOT,7,2),?67,$J(RMDOTOT,10,2),!
 W @IOF K RMPRFLG
 Q
 ;
REST Q:'$D(^RMPR(661.2,RO,1))
 S RM20=$G(^RMPR(661.2,RO,0)),RMDAT=$P(RM20,U,1)
 Q:(RMDAT<RMPRBDT)!(RMDAT>RMPREDT)
 S ^TMP($J,RMD,RO)=RMDAT
 Q
WRI ;
 ;S RMD="" F  S RMD=$O(RMPRI(RMD)) Q:RMD=""
 ;
 S I="" F  S I=$O(^TMP($J,I)) Q:I=""  Q:RMPREND  S (RMDOTOT,RMTITOT,RMSUF)=0 F J=0:0 S J=$O(^TMP($J,I,J)) Q:RMPREND  D:J'>0 SUM Q:J'>0  D
 .S RMSUF=1
 .I '$D(RMPRFLG) D HEAD,HEAD1
 .S RMDAT=^TMP($J,I,J)
 .S RM20=$G(^RMPR(661.2,J,0)),RM21=$G(^RMPR(661.2,J,1))
 .S RMPAT=$P(RM20,U,2)
 .S RMIT=$P(RM20,U,9)
 .S RMDAHC=$P(RM20,U,4)
 .S RMDAIT=$P(RMIT,"-",2)
 .Q:'RMDAHC
 .S:RMDAIT RM1=$P($G(^RMPR(661.1,RMDAHC,3,RMDAIT,0)),U,1)
 .S:'RMDAIT RM1=$P($G(^RMPR(661.1,RMDAHC,0)),U,2) Q:RM1=""
 .S RMHCPC=$P(^RMPR(661.1,RMDAHC,0),U,1)
 .S RMITEM=$E($P(RM1,U,1),1,31)
 .S RMHOUR=$P(RM21,U,1),RMDOL=$P(RM21,U,2)
 .S RMDAT=$E(RMDAT,4,5)_"/"_$E(RMDAT,6,7)_"/"_$E(RMDAT,2,3)
 .W !,RMDAT,?11,RMITEM,?43,RMHCPC,?56,$J(RMHOUR,4,2),?70,$J(RMDOL,7,2)
 .S:RMDOL RMDOTOT=RMDOTOT+RMDOL
 .S:RMHOUR RMTITOT=RMTITOT+RMHOUR
 .S RMPRFLG=1
 .I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND  W @IOF D HEAD,HEAD1 Q
 .I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 S RMPRFLG=1
 Q
 ;
ALL ;process all lab employees.
 S RMEMP=""
 F I=0:0 S I=$O(^RMPR(661.2,"F",I)) Q:I'>0  S RMEMP=$P(^VA(200,I,0),U,1) S RMPRI(RMEMP)=I
 Q
 ;
NONE ;No data for certain employee
 W !,RMPR("L"),!,"No Lab data for Employee: ",RMD," ....for this date range !!!"
 Q
NONEALL W !!,"NO DATA FOR THIS DATE RANGE!!!"
 Q