RMPR5HQL ;HCIOFO/RVD - NPPD LINE USAGE REPORT ; 15 AUG 00 ;;3.0;PROSTHETICS;**51,61**;Feb 09, 1996 ; DQ1 ;print PIP Report ;$O the ^TMP( global for all the records ;print all records based on the sort criteria given. I IOST["C-" W @IOF F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 S RSTN=$$STN(RST),RPR=0 F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) Q:$G(RFL) D:(RGRP'="")&(RGRP'=RI) SUMG1 Q:RI'>0 D .D:RPR=0 HDRL .S RGRP=RI .S RNPGRP=RMARRAY(RI) .S RJ="" .F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) D:(RLINE'="")&(RLINE'=RJ) SUML1 Q:(RJ="")!(RFL=1) D ..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ) ..I RGCNT=0 S RGCNT=RGCNT+1 ..S RK="" F S RK=$O(^TMP($J,R5,RST,RI,RJ,RK)) Q:$G(RFL)!(RK="") D ...S RL="" ...F S RL=$O(^TMP($J,R5,RST,RI,RJ,RK,RL)) Q:$G(RFL)!(RL="") D ....I RLCNT=0 D GLN1 ....S RLCNT=RLCNT+1 ....S RDAT=^TMP($J,R5,RST,RI,RJ,RK,RL) ....S RMVA=$P(RDAT,U,1) ....S RMCOM=$P(RDAT,U,2) ....S RMUSE=$P(RDAT,U,3) ....S RMISU=$P(RDAT,U,4) ....S RMISN=$P(RDAT,U,5) ....S RMAVEN=$P(RDAT,U,6) ....S RMDLEN=$P(RDAT,U,7) ....S RMQOHU=$P(RDAT,U,8) ....S RMQOHN=$P(RDAT,U,9) ....S RMVALU=$P(RDAT,U,10) ....S RMVALN=$P(RDAT,U,11) ....S RMAVEU=$P(RDAT,U,12) ....S RMDLEU=$P(RDAT,U,13) ....;total for GROUP ....S RMTVAG=RMTVAG+RMVA ....S RMTCOMG=RMTCOMG+RMCOM ....S RMTUSEG=RMTUSEG+RMVA+RMCOM ....S RMTISUG=RMTISUG+RMISU ....S RMTISNG=RMTISNG+RMISN ....S RMTDLEG=RMTDLEG+RMDLEU+RMDLEN ....S RMTQOHUG=RMTQOHUG+RMQOHU ....S RMTQOHNG=RMTQOHNG+RMQOHN ....S RMTVALUG=RMTVALUG+RMVALU ....S RMTVALNG=RMTVALNG+RMVALN ....S RMGTOU=RMGTOU+RMVALU ....S RMGTON=RMGTON+RMVALN ....S RMGTIU=RMGTIU+RMISU ....S RMGTIN=RMGTIN+RMISN ....;total for line item ....S RMTVAL=RMTVAL+RMVA ....S RMTCOML=RMTCOML+RMCOM ....I (RMCOM'=""),$G(RMCOM) S RTUSELC=RTUSELC+RMCOM ....I (RMVA'=""),$G(RMVA) S RTUSELA=RTUSELA+RMVA ....S RMTISUL=RMTISUL+RMISU ....S RMTISNL=RMTISNL+RMISN ....S RMTQOHUL=RMTQOHUL+RMQOHU ....S RMTQOHNL=RMTQOHNL+RMQOHN ....S RMTVALUL=RMTVALUL+RMVALU ....S RMTVALNL=RMTVALNL+RMVALN ....S (RPRINT,RPR)=1 ....I $Y+8>IOSL,IOST["C-" K DIR S DIR(0)="E" D ^DIR S:+Y'>0 RFL=1 Q:+Y'>0 W @IOF D HDRL,LBL1^RMPR5HQ2 ....I $Y+8>IOSL,IOST'["C-" W @IOF D HDRL,LBL1^RMPR5HQ2 Q ; HDRL ;print heading. Q:$G(RFL) S RMPAGE=RMPAGE+1 W !,"PROSTHETIC INVENTORY NPPD GROUP/LINE REPORT",?55,"Run Date: ",RMRDATE,?100,"Page: ",RMPAGE W !,"STATION: ",$E(RSTN,1,20) W ?32,RMBD," - ",RMED," [ ",RMCALDAY," calendar days ]" Q ; GLN1 ;print NPPD GROUP and LINE header. Q:$G(RFL) W !!,RNPGRP D LBL1^RMPR5HQ2 Q SUML1 ; Q:$G(RFL) W !,RLINE," ",RNPLINE S:$G(RTUSELA) RTAVELA=RTUSELA/RMCALDAY S:$G(RTUSELC) RTAVELC=RTUSELC/RMCALDAY S:$G(RTUSELA) RTDLELA=RMTQOHUL/RTAVELA S:$G(RTUSELC) RTDLELC=RMTQOHNL/RTAVELC S RTDLELA=$S(RTDLELA>999:">999",1:$J(RTDLELA,5,0)) S RTDLELC=$S(RTDLELC>999:">999",1:$J(RTDLELC,5,0)) S:RMTQOHNL=0 RTDLELC="" S:RMTQOHUL=0 RTDLELA="" S:(RMTQOHNL>0)&(RMTCOML<1) RTDLELC=">"_RMCALDAY S:(RMTQOHUL>0)&(RMTVAL<1) RTDLELA=">"_RMCALDAY S RMTAVEG=RTAVELA+RTAVELC ;next 2 lines for used: W !,?5,"(Used)",?26,$J(RMTVAL,5),?34,$J($FN(RMTISUL,",",2),6),?40,"|",?59,"|",?60,$J(RTUSELA,5),?67,"|",?71,$J(RTAVELA,5,2),?78,"|" W ?81,$J(RMTQOHUL,5),?94,"|",?97,$J(RTDLELA,6),?103,"|",?103,$J($FN(RMTVALUL,",",2),11) ;next 2 lines for new: W !,?5,"(New)",?40,"|",?41,$J(RMTCOML,4),?49,$J($FN(RMTISNL,",",2),9),?59,"|",?60,$J(RTUSELC,5),?67,"|",?71,$J(RTAVELC,5,2),?78,"|" W ?87,$J(RMTQOHNL,6),?94,"|",?97,$J(RTDLELC,6),?103,"|",?116,$J($FN(RMTVALNL,",",2),11) ; S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSEL,RMTAVEL,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL)=0 S (RTUSELA,RTUSELC,RTDLELA,RTDLELC,RTAVELA,RTAVELC)=0 S (RNPLINE,RLINE)="" Q ; SUMG1 ;print summary total for NPPD GROUP Q:$G(RFL) W !,REQ W !,?26,$J(RMTVAG,5),?34,$J($FN(RMTISUG,",",2),6),?40,"|",?41,$J(RMTCOMG,4),?49,$J($FN(RMTISNG,",",2),9),?59,"|",?60,$J(RMTUSEG,5),?67,"|",?78,"|" W ?81,$J(RMTQOHUG,5),?87,$J(RMTQOHNG,6),?94,"|",?103,"|",?104,$J($FN(RMTVALUG,",",2),11),?116,$J($FN(RMTVALNG,",",2),11) S (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RMTUSEG,RMTAVEG,RMTQOHUG,RMTQOHNG,RMTVALUG,RMTVALNG,RLCNT)=0 S (RNPGRP,RGRP)="" Q STN(RST) ;STATION FUNCTION N Y,RS S RS=$O(^RMPR(669.9,"C",RST,0)),Y=$P(^RMPR(669.9,RS,0),U,1) Q Y