RMPR5HQD ;HCIOFO/RVD - NPPD GROUP USAGE REPORT FOR HQ ; 06 OCT 00
;;3.0;PROSTHETICS;**51**;Feb 09, 1996
;
; HNC - added grand totals
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DQ1 ;print PIP Report
F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 D:(RSTA'="")&(RSTA'=RST)&(RPR=1) HDRG S RSTA=RST 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 HDRG
.S RGRP=RI
.S RNPGRP=RMARRAY(RI)
.S RJ=""
.F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) Q:RJ="" D
..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
..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=$J($P(RDAT,U,7),5,2)
....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=$J($P(RDAT,U,13),5,2)
....S RMGISUG=RMGISUG+RMISU
....S RMGISNG=RMGISNG+RMISN
....;
....S RMGTIU=RMGTIU+RMISU
....S RMGTIN=RMGTIN+RMISN
....;
....S RMGTOU=RMGTOU+RMVALU
....S RMGTON=RMGTON+RMVALN
....;total for GROUP
....I (RMCOM'=""),$G(RMCOM) S RTUSEGC=RTUSEGC+RMCOM
....I (RMVA'=""),$G(RMVA) S RTUSEGA=RTUSEGA+RMVA
....S RMTVAG=RMTVAG+RMVA
....S RMTCOMG=RMTCOMG+RMCOM
....S RMTISUG=RMTISUG+RMISU
....S RMTISNG=RMTISNG+RMISN
....S RMTQOHUG=RMTQOHUG+RMQOHU
....S RMTQOHNG=RMTQOHNG+RMQOHN
....S RMTVALUG=RMTVALUG+RMVALU
....S RMTVALNG=RMTVALNG+RMVALN
....S (RPRINT,RPR)=1
;
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=REQ
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
I '$G(RPRINT) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="No Records to Print !!" Q
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (Used) = $"_$J($FN(RMGTIU,",",2),10)
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (Used) = $"_$J($FN(RMGTOU,",",2),12)
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (New) = $"_$J($FN(RMGTIN,",",2),10)
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (New) = $"_$J($FN(RMGTON,",",2),12)
S RMGTOT=RMGTOU+RMGTON
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RB30_RB30_"GRAND TOTAL $ VALUE ON-HAND = "_"$"_$J($FN(RMGTOT,",",2),12)
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="<End of Report>"
Q
;
HDRG ;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^RMPR5HQC(RSTA)
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY NPPD GROUP 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)="ENTIRE SUMMARY"
D LBL1^RMPR5HQA
Q
;
SUMG1 ;print summary total for NPPD GROUP
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RLN
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RGRP_RB1_RNPGRP
S:$G(RTUSEGA) RTAVEGA=RTUSEGA/RMCALDAY
S:$G(RTUSEGC) RTAVEGC=RTUSEGC/RMCALDAY
S:$G(RTUSEGA) RTDLEGA=RMTQOHUG/RTAVEGA
S:$G(RTUSEGC) RTDLEGC=RMTQOHNG/RTAVEGC
S RTDLEGA=$S(RTDLEGA>999:">999",1:$J(RTDLEGA,6,0))
S RTDLEGC=$S(RTDLEGC>999:">999",1:$J(RTDLEGC,6,0))
S:RMTQOHNG=0 RTDLEGC=""
S:RMTQOHUG=0 RTDLEGA=""
S:(RMTQOHNG>0)&(RMTCOMG<1) RTDLEGC=">"_RMCALDAY
S:(RMTQOHUG>0)&(RMTVAG<1) RTDLEGA=">"_RMCALDAY
;
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)=" (Used)"_RB13_$J(RMTVAG,5)_RB1_$J($FN(RMTISUG,",",2),9)_RB1_"|"_RB18_"|"_RB1_$J(RTUSEGA,5)_RB1_"|"_RB1_$J(RTAVEGA,8,2)_RB1_"|"
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUG,6)_RB8_"|"_RB1_$J(RTDLEGA,6)_RB1_"|"_RB1_$J($FN(RMTVALUL,",",2),11)
;next line for NEW
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)=" (New)"_RB30_"|"_RB1_$J(RMTCOMG,6)_RB1_$J($FN(RMTISNG,",",2),9)_RB1_"|"_RB1_$J(RTUSEGC,5)_RB1_"|"_RB1_$J(RTAVEGC,8,2)_RB1_"|"
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB6_$J(RMTQOHNG,8)_RB1_"|"_RB1_$J(RTDLEGC,6)_RB1_"|"_RB11_$J($FN(RMTVALNG,",",2),11)
;
S (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RTUSEGA,RTUSEGC,RTAVEGA,RTAVEGC,RMTQOHUG,RMTQOHNG,RTDLEGA,RTDLEGC,RMTVALUG,RMTVALNG)=0
S (RNPGRP,RGRP)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR5HQD 4649 printed Sep 23, 2025@20:09:16 Page 2
RMPR5HQD ;HCIOFO/RVD - NPPD GROUP USAGE REPORT FOR HQ ; 06 OCT 00
+1 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
+2 ;
+3 ; HNC - added grand totals
+4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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 HDRG
SET RSTA=RST
FOR RI=0:0
SET RI=$ORDER(^TMP($JOB,R5,RST,RI))
if $GET(RFL)
QUIT
if (RGRP'="")&(RGRP'=RI)
DO SUMG1
if RI'>0
QUIT
Begin DoDot:1
+2 if RPR=0
DO HDRG
+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 RJ=""
QUIT
Begin DoDot:2
+7 SET RLINE=RJ
SET RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
+8 SET RK=""
FOR
SET RK=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK))
if $GET(RFL)!(RK="")
QUIT
Begin DoDot:3
+9 SET RL=""
+10 FOR
SET RL=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK,RL))
if $GET(RFL)!(RL="")
QUIT
Begin DoDot:4
+11 IF RLCNT=0
DO GLN1
+12 SET RLCNT=RLCNT+1
+13 SET RDAT=^TMP($JOB,R5,RST,RI,RJ,RK,RL)
+14 SET RMVA=$PIECE(RDAT,U,1)
+15 SET RMCOM=$PIECE(RDAT,U,2)
+16 SET RMUSE=$PIECE(RDAT,U,3)
+17 SET RMISU=$PIECE(RDAT,U,4)
+18 SET RMISN=$PIECE(RDAT,U,5)
+19 SET RMAVEN=$PIECE(RDAT,U,6)
+20 SET RMDLEN=$JUSTIFY($PIECE(RDAT,U,7),5,2)
+21 SET RMQOHU=$PIECE(RDAT,U,8)
+22 SET RMQOHN=$PIECE(RDAT,U,9)
+23 SET RMVALU=$PIECE(RDAT,U,10)
+24 SET RMVALN=$PIECE(RDAT,U,11)
+25 SET RMAVEU=$PIECE(RDAT,U,12)
+26 SET RMDLEU=$JUSTIFY($PIECE(RDAT,U,13),5,2)
+27 SET RMGISUG=RMGISUG+RMISU
+28 SET RMGISNG=RMGISNG+RMISN
+29 ;
+30 SET RMGTIU=RMGTIU+RMISU
+31 SET RMGTIN=RMGTIN+RMISN
+32 ;
+33 SET RMGTOU=RMGTOU+RMVALU
+34 SET RMGTON=RMGTON+RMVALN
+35 ;total for GROUP
+36 IF (RMCOM'="")
IF $GET(RMCOM)
SET RTUSEGC=RTUSEGC+RMCOM
+37 IF (RMVA'="")
IF $GET(RMVA)
SET RTUSEGA=RTUSEGA+RMVA
+38 SET RMTVAG=RMTVAG+RMVA
+39 SET RMTCOMG=RMTCOMG+RMCOM
+40 SET RMTISUG=RMTISUG+RMISU
+41 SET RMTISNG=RMTISNG+RMISN
+42 SET RMTQOHUG=RMTQOHUG+RMQOHU
+43 SET RMTQOHNG=RMTQOHNG+RMQOHN
+44 SET RMTVALUG=RMTVALUG+RMVALU
+45 SET RMTVALNG=RMTVALNG+RMVALN
+46 SET (RPRINT,RPR)=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+47 ;
+48 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+49 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=REQ
+50 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+51 IF '$GET(RPRINT)
DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)="No Records to Print !!"
QUIT
+52 DO CNTRX^RMPR5HQA
+53 SET ^TMP($JOB,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (Used) = $"_$JUSTIFY($FNUMBER(RMGTIU,",",2),10)
+54 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (Used) = $"_$JUSTIFY($FNUMBER(RMGTOU,",",2),12)
+55 DO CNTRX^RMPR5HQA
+56 SET ^TMP($JOB,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (New) = $"_$JUSTIFY($FNUMBER(RMGTIN,",",2),10)
+57 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (New) = $"_$JUSTIFY($FNUMBER(RMGTON,",",2),12)
+58 SET RMGTOT=RMGTOU+RMGTON
+59 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+60 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=RB30_RB30_"GRAND TOTAL $ VALUE ON-HAND = "_"$"_$JUSTIFY($FNUMBER(RMGTOT,",",2),12)
+61 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)="<End of Report>"
+62 QUIT
+63 ;
HDRG ;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^RMPR5HQC(RSTA)
+6 DO CNTRX^RMPR5HQA
+7 SET ^TMP($JOB,"RI",RC)="PROSTHETIC INVENTORY NPPD GROUP 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)="ENTIRE SUMMARY"
+4 DO LBL1^RMPR5HQA
+5 QUIT
+6 ;
SUMG1 ;print summary total for NPPD GROUP
+1 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=RLN
+2 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=RGRP_RB1_RNPGRP
+3 if $GET(RTUSEGA)
SET RTAVEGA=RTUSEGA/RMCALDAY
+4 if $GET(RTUSEGC)
SET RTAVEGC=RTUSEGC/RMCALDAY
+5 if $GET(RTUSEGA)
SET RTDLEGA=RMTQOHUG/RTAVEGA
+6 if $GET(RTUSEGC)
SET RTDLEGC=RMTQOHNG/RTAVEGC
+7 SET RTDLEGA=$SELECT(RTDLEGA>999:">999",1:$JUSTIFY(RTDLEGA,6,0))
+8 SET RTDLEGC=$SELECT(RTDLEGC>999:">999",1:$JUSTIFY(RTDLEGC,6,0))
+9 if RMTQOHNG=0
SET RTDLEGC=""
+10 if RMTQOHUG=0
SET RTDLEGA=""
+11 if (RMTQOHNG>0)&(RMTCOMG<1)
SET RTDLEGC=">"_RMCALDAY
+12 if (RMTQOHUG>0)&(RMTVAG<1)
SET RTDLEGA=">"_RMCALDAY
+13 ;
+14 DO CNTRX^RMPR5HQA
+15 SET ^TMP($JOB,"RI",RC)=" (Used)"_RB13_$JUSTIFY(RMTVAG,5)_RB1_$JUSTIFY($FNUMBER(RMTISUG,",",2),9)_RB1_"|"_RB18_"|"_RB1_$JUSTIFY(RTUSEGA,5)_RB1_"|"_RB1_$JUSTIFY(RTAVEGA,8,2)_RB1_"|"
+16 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB1_$JUSTIFY(RMTQOHUG,6)_RB8_"|"_RB1_$JUSTIFY(RTDLEGA,6)_RB1_"|"_RB1_$JUSTIFY($FNUMBER(RMTVALUL,",",2),11)
+17 ;next line for NEW
+18 DO CNTRX^RMPR5HQA
+19 SET ^TMP($JOB,"RI",RC)=" (New)"_RB30_"|"_RB1_$JUSTIFY(RMTCOMG,6)_RB1_$JUSTIFY($FNUMBER(RMTISNG,",",2),9)_RB1_"|"_RB1_$JUSTIFY(RTUSEGC,5)_RB1_"|"_RB1_$JUSTIFY(RTAVEGC,8,2)_RB1_"|"
+20 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB6_$JUSTIFY(RMTQOHNG,8)_RB1_"|"_RB1_$JUSTIFY(RTDLEGC,6)_RB1_"|"_RB11_$JUSTIFY($FNUMBER(RMTVALNG,",",2),11)
+21 ;
+22 SET (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RTUSEGA,RTUSEGC,RTAVEGA,RTAVEGC,RMTQOHUG,RMTQOHNG,RTDLEGA,RTDLEGC,RMTVALUG,RMTVALNG)=0
+23 SET (RNPGRP,RGRP)=""
+24 QUIT
