RMPR5HQC ;HCIOFO/RVD - NPPD LINE USAGE REPORT FOR HQ ; 06 OCT 00
;;3.0;PROSTHETICS;**51,61**;Feb 09, 1996
DQ1 ;print PIP Report
F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 D:(RSTA'="")&(RSTA'=RST)&(RPR=1) HDRL S RSTA=RST F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) D:(RGRP'="")&(RGRP'=RI) SUMG1 Q:$G(RFL)!(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="" 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 RMTUSELN=RMTUSELN+RMCOM
....I (RMVA'=""),$G(RMVA) S RMTUSELU=RMTUSELU+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
Q
;
HDRL ;print heading.
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
I RPR=1 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RES
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
S RPR=1
S RSTN=$$STN(RSTA)
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY NPPD GROUP/LINE REPORT"_RB10_"Run Date: "_RMRDATE
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="STATION: "_$E(RSTN,1,30)_RB6_RMBD_" - "_RMED_" [ "_RMCALDAY_" calendar days ]"
Q
;
GLN1 ;print NPPD GROUP and LINE header.
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RNPGRP
D LBL1^RMPR5HQA
Q
;
SUML1 ;
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RLINE_RB1_RNPLINE
S:$G(RMTUSELU) RMTAVELU=RMTUSELU/RMCALDAY
S:$G(RMTUSELN) RMTAVELN=RMTUSELN/RMCALDAY
S:$G(RMTUSELU) RTDLELA=RMTQOHUL/RMTAVELU
S:$G(RMTUSELN) RTDLELC=RMTQOHNL/RMTAVELN
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
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)=" (Used)"_RB13_$J(RMTVAL,5)_RB1_$J($FN(RMTISUL,",",2),9)_RB1_"|"_RB18_"|"_RB1_$J(RMTUSELU,5)_RB1_"|"_RB1_$J(RMTAVELU,8,2)_RB1_"|"
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUL,6)_RB8_"|"_RB1_$J(RTDLELA,6)_RB1_"|"_RB1_$J($FN(RMTVALUL,",",2),11)
;next two lines print new total
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)=" (New)"_RB30_"|"_RB1_$J(RMTCOML,6)_RB1_$J($FN(RMTISNL,",",2),9)_RB1_"|"_RB1_$J(RMTUSELN,5)_RB1_"|"_RB1_$J(RMTAVELN,8,2)_RB1_"|"
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB6_$J(RMTQOHNL,8)_RB1_"|"_RB1_$J(RTDLELC,6)_RB1_"|"_RB12_$J($FN(RMTVALNL,",",2),11)
;
S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSELU,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL)=0
S (RMTUSELN,RMTUSELU,RTDLELA,RTDLELC,RTAVELA,RTAVELC)=0
S (RNPLINE,RLINE)=""
Q
;
SUMG1 ;print summary total for NPPD GROUP
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=REQ
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)=RB24_$J(RMTVAG,5)_RB1_$J($FN(RMTISUG,",",2),9)_RB1_"|"_RB1_$J(RMTCOMG,6)_RB1_$J($FN(RMTISNG,",",2),9)_RB1_"|"_RB1_$J(RMTUSEG,5)_RB1_"|"_RB10_"|"
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUG,6)_RB1_$J(RMTQOHNG,6)_RB1_"|"_RB8_"|"_RB1_$J($FN(RMTVALUG,",",2),11)_$J($FN(RMTVALNG,",",2),11)
;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR5HQC 4911 printed Dec 13, 2024@02:33:05 Page 2
RMPR5HQC ;HCIOFO/RVD - NPPD LINE USAGE REPORT FOR HQ ; 06 OCT 00
+1 ;;3.0;PROSTHETICS;**51,61**;Feb 09, 1996
DQ1 ;print PIP Report
+1 FOR RST=0:0
SET RST=$ORDER(^TMP($JOB,R5,RST))
if RST'>0
QUIT
if (RSTA'="")&(RSTA'=RST)&(RPR=1)
DO HDRL
SET RSTA=RST
FOR RI=0:0
SET RI=$ORDER(^TMP($JOB,R5,RST,RI))
if (RGRP'="")&(RGRP'=RI)
DO SUMG1
if $GET(RFL)!(RI'>0)
QUIT
Begin DoDot:1
+2 if RPR=0
DO HDRL
+3 SET RGRP=RI
+4 SET RNPGRP=RMARRAY(RI)
+5 SET RJ=""
+6 FOR
SET RJ=$ORDER(^TMP($JOB,R5,RST,RI,RJ))
if $GET(RFL)
QUIT
if (RLINE'="")&(RLINE'=RJ)
DO SUML1
if RJ=""
QUIT
Begin DoDot:2
+7 SET RLINE=RJ
SET RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
+8 IF RGCNT=0
SET RGCNT=RGCNT+1
+9 SET RK=""
FOR
SET RK=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK))
if $GET(RFL)!(RK="")
QUIT
Begin DoDot:3
+10 SET RL=""
+11 FOR
SET RL=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK,RL))
if $GET(RFL)!(RL="")
QUIT
Begin DoDot:4
+12 IF RLCNT=0
DO GLN1
+13 SET RLCNT=RLCNT+1
+14 SET RDAT=^TMP($JOB,R5,RST,RI,RJ,RK,RL)
+15 SET RMVA=$PIECE(RDAT,U,1)
+16 SET RMCOM=$PIECE(RDAT,U,2)
+17 SET RMUSE=$PIECE(RDAT,U,3)
+18 SET RMISU=$PIECE(RDAT,U,4)
+19 SET RMISN=$PIECE(RDAT,U,5)
+20 SET RMAVEN=$PIECE(RDAT,U,6)
+21 SET RMDLEN=$PIECE(RDAT,U,7)
+22 SET RMQOHU=$PIECE(RDAT,U,8)
+23 SET RMQOHN=$PIECE(RDAT,U,9)
+24 SET RMVALU=$PIECE(RDAT,U,10)
+25 SET RMVALN=$PIECE(RDAT,U,11)
+26 SET RMAVEU=$PIECE(RDAT,U,12)
+27 SET RMDLEU=$PIECE(RDAT,U,13)
+28 ;total for GROUP
+29 SET RMTVAG=RMTVAG+RMVA
+30 SET RMTCOMG=RMTCOMG+RMCOM
+31 SET RMTUSEG=RMTUSEG+RMVA+RMCOM
+32 SET RMTISUG=RMTISUG+RMISU
+33 SET RMTISNG=RMTISNG+RMISN
+34 SET RMTDLEG=RMTDLEG+RMDLEU+RMDLEN
+35 SET RMTQOHUG=RMTQOHUG+RMQOHU
+36 SET RMTQOHNG=RMTQOHNG+RMQOHN
+37 SET RMTVALUG=RMTVALUG+RMVALU
+38 SET RMTVALNG=RMTVALNG+RMVALN
+39 SET RMGTOU=RMGTOU+RMVALU
+40 SET RMGTON=RMGTON+RMVALN
+41 SET RMGTIU=RMGTIU+RMISU
+42 SET RMGTIN=RMGTIN+RMISN
+43 ;total for line item
+44 SET RMTVAL=RMTVAL+RMVA
+45 SET RMTCOML=RMTCOML+RMCOM
+46 IF (RMCOM'="")
IF $GET(RMCOM)
SET RMTUSELN=RMTUSELN+RMCOM
+47 IF (RMVA'="")
IF $GET(RMVA)
SET RMTUSELU=RMTUSELU+RMVA
+48 SET RMTISUL=RMTISUL+RMISU
+49 SET RMTISNL=RMTISNL+RMISN
+50 SET RMTQOHUL=RMTQOHUL+RMQOHU
+51 SET RMTQOHNL=RMTQOHNL+RMQOHN
+52 SET RMTVALUL=RMTVALUL+RMVALU
+53 SET RMTVALNL=RMTVALNL+RMVALN
+54 SET (RPRINT,RPR)=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+55 QUIT
+56 ;
HDRL ;print heading.
+1 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+2 IF RPR=1
DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=RES
+3 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+4 SET RPR=1
+5 SET RSTN=$$STN(RSTA)
+6 DO CNTRX^RMPR5HQA
+7 SET ^TMP($JOB,"RI",RC)="PROSTHETIC INVENTORY NPPD GROUP/LINE REPORT"_RB10_"Run Date: "_RMRDATE
+8 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)="STATION: "_$EXTRACT(RSTN,1,30)_RB6_RMBD_" - "_RMED_" [ "_RMCALDAY_" calendar days ]"
+9 QUIT
+10 ;
GLN1 ;print NPPD GROUP and LINE header.
+1 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+2 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+3 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=RNPGRP
+4 DO LBL1^RMPR5HQA
+5 QUIT
+6 ;
SUML1 ;
+1 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=RLINE_RB1_RNPLINE
+2 if $GET(RMTUSELU)
SET RMTAVELU=RMTUSELU/RMCALDAY
+3 if $GET(RMTUSELN)
SET RMTAVELN=RMTUSELN/RMCALDAY
+4 if $GET(RMTUSELU)
SET RTDLELA=RMTQOHUL/RMTAVELU
+5 if $GET(RMTUSELN)
SET RTDLELC=RMTQOHNL/RMTAVELN
+6 SET RTDLELA=$SELECT(RTDLELA>999:">999",1:$JUSTIFY(RTDLELA,5,0))
+7 SET RTDLELC=$SELECT(RTDLELC>999:">999",1:$JUSTIFY(RTDLELC,5,0))
+8 if RMTQOHNL=0
SET RTDLELC=""
+9 if RMTQOHUL=0
SET RTDLELA=""
+10 if (RMTQOHNL>0)&(RMTCOML<1)
SET RTDLELC=">"_RMCALDAY
+11 if (RMTQOHUL>0)&(RMTVAL<1)
SET RTDLELA=">"_RMCALDAY
+12 SET RMTAVEG=RTAVELA+RTAVELC
+13 DO CNTRX^RMPR5HQA
+14 SET ^TMP($JOB,"RI",RC)=" (Used)"_RB13_$JUSTIFY(RMTVAL,5)_RB1_$JUSTIFY($FNUMBER(RMTISUL,",",2),9)_RB1_"|"_RB18_"|"_RB1_$JUSTIFY(RMTUSELU,5)_RB1_"|"_RB1_$JUSTIFY(RMTAVELU,8,2)_RB1_"|"
+15 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB1_$JUSTIFY(RMTQOHUL,6)_RB8_"|"_RB1_$JUSTIFY(RTDLELA,6)_RB1_"|"_RB1_$JUSTIFY($FNUMBER(RMTVALUL,",",2),11)
+16 ;next two lines print new total
+17 DO CNTRX^RMPR5HQA
+18 SET ^TMP($JOB,"RI",RC)=" (New)"_RB30_"|"_RB1_$JUSTIFY(RMTCOML,6)_RB1_$JUSTIFY($FNUMBER(RMTISNL,",",2),9)_RB1_"|"_RB1_$JUSTIFY(RMTUSELN,5)_RB1_"|"_RB1_$JUSTIFY(RMTAVELN,8,2)_RB1_"|"
+19 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB6_$JUSTIFY(RMTQOHNL,8)_RB1_"|"_RB1_$JUSTIFY(RTDLELC,6)_RB1_"|"_RB12_$JUSTIFY($FNUMBER(RMTVALNL,",",2),11)
+20 ;
+21 SET (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSELU,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL)=0
+22 SET (RMTUSELN,RMTUSELU,RTDLELA,RTDLELC,RTAVELA,RTAVELC)=0
+23 SET (RNPLINE,RLINE)=""
+24 QUIT
+25 ;
SUMG1 ;print summary total for NPPD GROUP
+1 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=REQ
+2 DO CNTRX^RMPR5HQA
+3 SET ^TMP($JOB,"RI",RC)=RB24_$JUSTIFY(RMTVAG,5)_RB1_$JUSTIFY($FNUMBER(RMTISUG,",",2),9)_RB1_"|"_RB1_$JUSTIFY(RMTCOMG,6)_RB1_$JUSTIFY($FNUMBER(RMTISNG,",",2),9)_RB1_"|"_RB1_$JUSTIFY(RMTUSEG,5)_RB1_"|"_RB10_"|"
+4 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB1_$JUSTIFY(RMTQOHUG,6)_RB1_$JUSTIFY(RMTQOHNG,6)_RB1_"|"_RB8_"|"_RB1_$JUSTIFY($FNUMBER(RMTVALUG,",",2),11)_$JUSTIFY($FNUMBER(RMTVALNG,",",2),11)
+5 ;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,"|"
+6 ;W ?81,$J(RMTQOHUG,5),?87,$J(RMTQOHNG,6),?94,"|",?103,"|",?104,$J($FN(RMTVALUG,",",2),11),?116,$J($FN(RMTVALNG,",",2),11)
+7 ;
+8 SET (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RMTUSEG,RMTAVEG,RMTQOHUG,RMTQOHNG,RMTVALUG,RMTVALNG,RLCNT)=0
+9 SET (RNPGRP,RGRP)=""
+10 QUIT
+11 ;
STN(RST) ;STATION FUNCTION
+1 NEW Y,RS
+2 SET RS=$ORDER(^RMPR(669.9,"C",RST,0))
SET Y=$PIECE(^RMPR(669.9,RS,0),U,1)
+3 QUIT Y
