RMPR5HQ2 ;HCIOFO/RVD - ITEM & HCPCS USAGE REPORT ; 15 AUG 00
;;3.0;PROSTHETICS;**51**;Feb 09, 1996
;
MANUAL ;run the USAGE report manually. User needs to enter the month the
;report should be ran.
N RLN,RMPAGE,R5,REQ,RSL,RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RHCPC,RMTVAH
N RMTUSEG,RMTVAG,RMTCOMG,RMTQOHG,RMTVALG,RMGVAL,RGCNT,RLCNT,RSCNT,RFL
N RLINE,RGRP,RST,RI,RST,RJ,RK,RGRP,RDAT,RMBD,RMED,RPR,RMARRAY,RMTUSEH
N RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU
N RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTCOMH,RMTISUH,RMTISNH
N RMTVALUH,RMTVALNH,RMTQOHUH,RMTQOHNH,RMTDLEH,RMTDLEG,RMTAVEG,RMGTOT
N RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN
N RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTUSELU,RMTUSELN
N RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC,RMCALDAY,RMTAVELN
;
S X1=RMPREDT,X2=RMPRSDT
D ^%DTC S RMCALDAY=X+1
S Y=RMPRSDT D DD^%DT S RMBD=Y S Y=RMPREDT D DD^%DT S RMED=Y
D NOW^%DTC S Y=% X ^DD("DD") S RMRDATE=Y
S $P(RLN,"-",IOM)="",RMPAGE=0,R5="RMPR5"
S $P(REQ,"=",IOM)=""
S (RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RMTAVEG,RMGTOT,RMTUSELU,RMGISNG,RMGISUG)=0
S (RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU,RMTUSELN)=0
S (RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTISUH,RMTISNH)=0
S (RMTUSEG,RMTVAG,RMTCOMG,RMGTOU,RMGTON,RMTVAH,RMTCOMH,RMTVALUH,RMTVALNH,RMTQOHUH)=0
S (RMGVAL,RGCNT,RLCNT,RSCNT,RFL,RPRINT,RMTQOHNH,RMTUSEH,RMTDLEH)=0
S (RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN)=0
S (RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTAVELN)=0
S (RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC)=0
S (RLINE,RGRP,RST,RNPGRP,RNPLINE,RHCPC,RMTDLEG)=""
D GRPARY^RMPR5HQ4(.RMARRAY)
;
ITEM ;entry point for Item Detail Usage report
G:RMPRDET="I" DQ1
;
HCPCS ;entry point for HCPCS Summary Usage report.
I RMPRDET="H" D ^RMPR5HQH G TOT
LINE ;entry point for NPPD LINE Usage report.
I RMPRDET="L" D ^RMPR5HQL G TOT
;
GROUP ;entry point for NPPD GROUP Usage report.
I RMPRDET="G" D ^RMPR5HQG
G CLEAN1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
DQ1 ;print PIP Report (Item Detail Usage 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^RMPR5HQL(RST),RPR=0 F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) Q:$G(RFL) Q:RI'>0 D
.D:RPR=0 HDRI
.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
....S RHCPC=$P(RK,"/",1)
....S:RMPRDET="I" RHCPC=RHCPC_"-"_RL
....S RNPITEM=$$GETITEM^RMPR5HQ5($P(RK,"/",2),RL)
....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)
....S RMDLEU=$S(RMDLEU>999:">999",1:$J(RMDLEU,7,0))
....S RMDLEN=$S(RMDLEN>999:">999",1:$J(RMDLEN,7,0))
....S:(RMVA<1)&(RMVALU>0) RMDLEU=">"_RMCALDAY
....S:(RMCOM<1)&(RMVALN>0) RMDLEN=">"_RMCALDAY
....;total for line item
....S RMTVAL=RMTVAL+RMVA
....S RMTCOML=RMTCOML+RMCOM
....S:RMVA'="" RMTUSELU=RMTUSELU+RMVA
....S:RMCOM'="" RMTUSELN=RMTUSELN+RMCOM
....S RMTISUL=RMTISUL+RMISU
....S RMTISNL=RMTISNL+RMISN
....;S RMTAVELU=RMTAVELU+RMAVEU
....;S RMTAVELN=RMTAVELN+RMAVEN
....S RMTQOHUL=RMTQOHUL+RMQOHU
....S RMTQOHNL=RMTQOHNL+RMQOHN
....S RMTVALUL=RMTVALUL+RMVALU
....S RMTVALNL=RMTVALNL+RMVALN
....;total for group
....S RMTVAG=RMTVAG+RMVA
....S RMTCOMG=RMTCOMG+RMCOM
....S RMTUSEG=RMTUSEG+RMVA
....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 RMGTOU=RMGTOU+RMVALU
....S RMGTON=RMGTON+RMVALN
....S RMGTIU=RMGTIU+RMISU
....S RMGTIN=RMGTIN+RMISN
....S:'RMISU RMISU=""
....S:'RMISN RMISN=""
....S RMVALU=$FN(RMVALU,",",2) S:'RMVALU RMVALU=""
....S RMVALN=$FN(RMVALN,",",2) S:'RMVALN RMVALN=""
....S:RMVA="" RMVA=0 S:RMISU="" RMISU=0 S:RMCOM="" RMCOM=0
....S:RMISN="" RMISN=0
....;for used item
....W:$G(RMVA)!$G(RMVALU) !,RHCPC,?10,$E(RNPITEM,1,15),?26,$J(RMVA,5),?33,$J($FN(RMISU,",",2),7),?40,"|",?59,"|",?60,$J(RMVA,5),?67,"|",?71,$J(RMAVEU,5,2),?78,"|",?81,$J(RMQOHU,5)
....W:$G(RMVA)!$G(RMVALU) ?94,"|",?96,$J(RMDLEU,7),?103,"|",?104,$J(RMVALU,11)
....;for new item
....W:$G(RMCOM)!$G(RMVALN) !,RHCPC,?10,$E(RNPITEM,1,15),?40,"|",?41,$J(RMCOM,4),?49,$J($FN(RMISN,",",2),9),?59,"|",?60,$J(RMCOM,5),?67,"|",?71,$J(RMAVEN,5,2),?78,"|"
....W:$G(RMCOM)!$G(RMVALN) ?87,$J(RMQOHN,6),?94,"|",?96,$J(RMDLEN,7),?103,"|",?116,$J(RMVALN,11)
....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 HDRI,LBL1
....I $Y+8>IOSL,IOST'["C-" W @IOF D HDRI,LBL1
;print total for Used and New items (all report type)
TOT G:$G(RFL) CLEAN1
I '$G(RPRINT) W !!,"No Records to Print !!" G CLEAN1
W !!,?10,"GRAND TOTAL $ VALUE ISSUED (Used) = ",?38,"$",$J($FN(RMGTIU,",",2),10)
W ?80,"GRAND TOTAL $ VALUE ON-HAND (Used) = ",?115,"$",$J($FN(RMGTOU,",",2),12)
W !,?10,"GRAND TOTAL $ VALUE ISSUED (New) = ",?38,"$",$J($FN(RMGTIN,",",2),10)
W ?80,"GRAND TOTAL $ VALUE ON-HAND (New) = ",?115,"$",$J($FN(RMGTON,",",2),12)
W !,"<End of Report>"
;
CLEAN1 ; Clean and EXITS program.
I $E(IOST)["C",'$D(DUOUT) K DIR S DIR(0)="E" D ^DIR
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
N RMPR,RMPRSITE
D KILL^XUSCLEAN
K ^TMP($J)
Q
;
HDRI ;print heading.
Q:$G(RFL)
S RMPAGE=RMPAGE+1
W !,"PROSTHETIC INVENTORY ITEM DETAIL REPORT",?50,"Run Date: ",RMRDATE,?100,"Page: ",RMPAGE
W !,"STATION: ",$E(RSTN,1,20)
W ?32,RMBD," - ",RMED," [ ",RMCALDAY," calendar days ]"
Q
;
LBL1 ;print column header.
Q:$G(RFL)
W !,RLN
W:RMPRDET="I" !,"HCPCS PSAS/ITEM"
W:RMPRDET="H" !,"HCPCS DESCRIPTION"
W:RMPRDET="L" !,"NPPD LINE"
W:RMPRDET="G" !,"NPPD GROUP"
W ?23,"V.A.(Used) Total| COM. (New) Total| Total |Days Ave | Stock On-Hand| Days |Total $ Value On-Hand"
W !,?23,"Issue $ Value| Issue $ Value| Issue |Usage Rate| Used New | On-Hand| Used New"
W:RMPRDET'="G" !,RLN
Q
;
GLN1 ;print NPPD GROUP and LINE header.
Q:$G(RFL)
W !!,RJ," ",RNPLINE," [",RNPGRP," ]"
D LBL1
Q
;
SUML1 ;print summary total for NPPD LINE
Q:$G(RFL)
W !,REQ
S:$G(RMTUSELU) RMTAVELU=RMTUSELU/RMCALDAY
S:$G(RMTUSELN) RMTAVELN=RMTUSELN/RMCALDAY
;S:RMTDLEL>999 RMTDLEL=">999"
;next two lines print used total
W !,?5,"(Used)",?26,$J(RMTVAL,5),?34,$J($FN(RMTISUL,",",2),6),?40,"|",?59,"|",?60,$J(RMTUSELU,5),?67,"|",?71,$J(RMTAVELU,5,2),?78,"|"
W ?81,$J(RMTQOHUL,5),?94,"|",?103,"|",?104,$J($FN(RMTVALUL,",",2),11)
;next two lines print new total
W !,?5,"(New)",?40,"|",?41,$J(RMTCOML,4),?49,$J($FN(RMTISNL,",",2),9),?59,"|",?60,$J(RMTUSELN,5),?67,"|",?71,$J(RMTAVELN,5,2),?78,"|"
W ?87,$J(RMTQOHNL,6),?94,"|",?103,"|",?116,$J($FN(RMTVALNL,",",2),11)
S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSEL,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL,RLCNT,RMTUSELU,RMTUSELN)=0
S (RNPLINE,RLINE)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR5HQ2 7712 printed Apr 09, 2024@21:34:17 Page 2
RMPR5HQ2 ;HCIOFO/RVD - ITEM & HCPCS USAGE REPORT ; 15 AUG 00
+1 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
+2 ;
MANUAL ;run the USAGE report manually. User needs to enter the month the
+1 ;report should be ran.
+2 NEW RLN,RMPAGE,R5,REQ,RSL,RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RHCPC,RMTVAH
+3 NEW RMTUSEG,RMTVAG,RMTCOMG,RMTQOHG,RMTVALG,RMGVAL,RGCNT,RLCNT,RSCNT,RFL
+4 NEW RLINE,RGRP,RST,RI,RST,RJ,RK,RGRP,RDAT,RMBD,RMED,RPR,RMARRAY,RMTUSEH
+5 NEW RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU
+6 NEW RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTCOMH,RMTISUH,RMTISNH
+7 NEW RMTVALUH,RMTVALNH,RMTQOHUH,RMTQOHNH,RMTDLEH,RMTDLEG,RMTAVEG,RMGTOT
+8 NEW RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN
+9 NEW RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTUSELU,RMTUSELN
+10 NEW RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC,RMCALDAY,RMTAVELN
+11 ;
+12 SET X1=RMPREDT
SET X2=RMPRSDT
+13 DO ^%DTC
SET RMCALDAY=X+1
+14 SET Y=RMPRSDT
DO DD^%DT
SET RMBD=Y
SET Y=RMPREDT
DO DD^%DT
SET RMED=Y
+15 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET RMRDATE=Y
+16 SET $PIECE(RLN,"-",IOM)=""
SET RMPAGE=0
SET R5="RMPR5"
+17 SET $PIECE(REQ,"=",IOM)=""
+18 SET (RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RMTAVEG,RMGTOT,RMTUSELU,RMGISNG,RMGISUG)=0
+19 SET (RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU,RMTUSELN)=0
+20 SET (RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTISUH,RMTISNH)=0
+21 SET (RMTUSEG,RMTVAG,RMTCOMG,RMGTOU,RMGTON,RMTVAH,RMTCOMH,RMTVALUH,RMTVALNH,RMTQOHUH)=0
+22 SET (RMGVAL,RGCNT,RLCNT,RSCNT,RFL,RPRINT,RMTQOHNH,RMTUSEH,RMTDLEH)=0
+23 SET (RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN)=0
+24 SET (RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTAVELN)=0
+25 SET (RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC)=0
+26 SET (RLINE,RGRP,RST,RNPGRP,RNPLINE,RHCPC,RMTDLEG)=""
+27 DO GRPARY^RMPR5HQ4(.RMARRAY)
+28 ;
ITEM ;entry point for Item Detail Usage report
+1 if RMPRDET="I"
GOTO DQ1
+2 ;
HCPCS ;entry point for HCPCS Summary Usage report.
+1 IF RMPRDET="H"
DO ^RMPR5HQH
GOTO TOT
LINE ;entry point for NPPD LINE Usage report.
+1 IF RMPRDET="L"
DO ^RMPR5HQL
GOTO TOT
+2 ;
GROUP ;entry point for NPPD GROUP Usage report.
+1 IF RMPRDET="G"
DO ^RMPR5HQG
+2 GOTO CLEAN1
+3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+4 ;
DQ1 ;print PIP Report (Item Detail Usage report).
+1 ;$O the ^TMP( global for all the records
+2 ;print all records based on the sort criteria given.
+3 IF IOST["C-"
WRITE @IOF
+4 ;
+5 FOR RST=0:0
SET RST=$ORDER(^TMP($JOB,R5,RST))
if RST'>0
QUIT
SET RSTN=$$STN^RMPR5HQL(RST)
SET RPR=0
FOR RI=0:0
SET RI=$ORDER(^TMP($JOB,R5,RST,RI))
if $GET(RFL)
QUIT
if RI'>0
QUIT
Begin DoDot:1
+6 if RPR=0
DO HDRI
+7 SET RNPGRP=RMARRAY(RI)
+8 SET RJ=""
+9 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
+10 SET RLINE=RJ
SET RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
+11 IF RGCNT=0
SET RGCNT=RGCNT+1
+12 SET RK=""
FOR
SET RK=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK))
if $GET(RFL)!(RK="")
QUIT
Begin DoDot:3
+13 SET RL=""
+14 FOR
SET RL=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK,RL))
if $GET(RFL)!(RL="")
QUIT
Begin DoDot:4
+15 SET RHCPC=$PIECE(RK,"/",1)
+16 if RMPRDET="I"
SET RHCPC=RHCPC_"-"_RL
+17 SET RNPITEM=$$GETITEM^RMPR5HQ5($PIECE(RK,"/",2),RL)
+18 IF RLCNT=0
DO GLN1
+19 SET RLCNT=RLCNT+1
+20 SET RDAT=^TMP($JOB,R5,RST,RI,RJ,RK,RL)
+21 SET RMVA=$PIECE(RDAT,U,1)
+22 SET RMCOM=$PIECE(RDAT,U,2)
+23 SET RMUSE=$PIECE(RDAT,U,3)
+24 SET RMISU=$PIECE(RDAT,U,4)
+25 SET RMISN=$PIECE(RDAT,U,5)
+26 SET RMAVEN=$PIECE(RDAT,U,6)
+27 SET RMDLEN=$PIECE(RDAT,U,7)
+28 SET RMQOHU=$PIECE(RDAT,U,8)
+29 SET RMQOHN=$PIECE(RDAT,U,9)
+30 SET RMVALU=$PIECE(RDAT,U,10)
+31 SET RMVALN=$PIECE(RDAT,U,11)
+32 SET RMAVEU=$PIECE(RDAT,U,12)
+33 SET RMDLEU=$PIECE(RDAT,U,13)
+34 SET RMDLEU=$SELECT(RMDLEU>999:">999",1:$JUSTIFY(RMDLEU,7,0))
+35 SET RMDLEN=$SELECT(RMDLEN>999:">999",1:$JUSTIFY(RMDLEN,7,0))
+36 if (RMVA<1)&(RMVALU>0)
SET RMDLEU=">"_RMCALDAY
+37 if (RMCOM<1)&(RMVALN>0)
SET RMDLEN=">"_RMCALDAY
+38 ;total for line item
+39 SET RMTVAL=RMTVAL+RMVA
+40 SET RMTCOML=RMTCOML+RMCOM
+41 if RMVA'=""
SET RMTUSELU=RMTUSELU+RMVA
+42 if RMCOM'=""
SET RMTUSELN=RMTUSELN+RMCOM
+43 SET RMTISUL=RMTISUL+RMISU
+44 SET RMTISNL=RMTISNL+RMISN
+45 ;S RMTAVELU=RMTAVELU+RMAVEU
+46 ;S RMTAVELN=RMTAVELN+RMAVEN
+47 SET RMTQOHUL=RMTQOHUL+RMQOHU
+48 SET RMTQOHNL=RMTQOHNL+RMQOHN
+49 SET RMTVALUL=RMTVALUL+RMVALU
+50 SET RMTVALNL=RMTVALNL+RMVALN
+51 ;total for group
+52 SET RMTVAG=RMTVAG+RMVA
+53 SET RMTCOMG=RMTCOMG+RMCOM
+54 SET RMTUSEG=RMTUSEG+RMVA
+55 SET RMTISUG=RMTISUG+RMISU
+56 SET RMTISNG=RMTISNG+RMISN
+57 SET RMTQOHUG=RMTQOHUG+RMQOHU
+58 SET RMTQOHNG=RMTQOHNG+RMQOHN
+59 SET RMTVALUG=RMTVALUG+RMVALU
+60 SET RMTVALNG=RMTVALNG+RMVALN
+61 SET RMGTOU=RMGTOU+RMVALU
+62 SET RMGTON=RMGTON+RMVALN
+63 SET RMGTIU=RMGTIU+RMISU
+64 SET RMGTIN=RMGTIN+RMISN
+65 if 'RMISU
SET RMISU=""
+66 if 'RMISN
SET RMISN=""
+67 SET RMVALU=$FNUMBER(RMVALU,",",2)
if 'RMVALU
SET RMVALU=""
+68 SET RMVALN=$FNUMBER(RMVALN,",",2)
if 'RMVALN
SET RMVALN=""
+69 if RMVA=""
SET RMVA=0
if RMISU=""
SET RMISU=0
if RMCOM=""
SET RMCOM=0
+70 if RMISN=""
SET RMISN=0
+71 ;for used item
+72 if $GET(RMVA)!$GET(RMVALU)
WRITE !,RHCPC,?10,$EXTRACT(RNPITEM,1,15),?26,$JUSTIFY(RMVA,5),?33,$JUSTIFY($FNUMBER(RMISU,",",2),7),?40,"|",?59,"|",?60,$JUSTIFY(RMVA,5),?67,"|",?71,$JUSTIFY(RMAVEU,5,2),?78,"|",?81,$JUSTIFY(RMQOHU,5)
+73 if $GET(RMVA)!$GET(RMVALU)
WRITE ?94,"|",?96,$JUSTIFY(RMDLEU,7),?103,"|",?104,$JUSTIFY(RMVALU,11)
+74 ;for new item
+75 if $GET(RMCOM)!$GET(RMVALN)
WRITE !,RHCPC,?10,$EXTRACT(RNPITEM,1,15),?40,"|",?41,$JUSTIFY(RMCOM,4),?49,$JUSTIFY($FNUMBER(RMISN,",",2),9),?59,"|",?60,$JUSTIFY(RMCOM,5),?67,"|",?71,$JUSTIFY(RMAVEN,5,2),?78,"|"
+76 if $GET(RMCOM)!$GET(RMVALN)
WRITE ?87,$JUSTIFY(RMQOHN,6),?94,"|",?96,$JUSTIFY(RMDLEN,7),?103,"|",?116,$JUSTIFY(RMVALN,11)
+77 SET (RPRINT,RPR)=1
+78 IF $Y+8>IOSL
IF IOST["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
if +Y'>0
SET RFL=1
if +Y'>0
QUIT
WRITE @IOF
DO HDRI
DO LBL1
+79 IF $Y+8>IOSL
IF IOST'["C-"
WRITE @IOF
DO HDRI
DO LBL1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+80 ;print total for Used and New items (all report type)
TOT if $GET(RFL)
GOTO CLEAN1
+1 IF '$GET(RPRINT)
WRITE !!,"No Records to Print !!"
GOTO CLEAN1
+2 WRITE !!,?10,"GRAND TOTAL $ VALUE ISSUED (Used) = ",?38,"$",$JUSTIFY($FNUMBER(RMGTIU,",",2),10)
+3 WRITE ?80,"GRAND TOTAL $ VALUE ON-HAND (Used) = ",?115,"$",$JUSTIFY($FNUMBER(RMGTOU,",",2),12)
+4 WRITE !,?10,"GRAND TOTAL $ VALUE ISSUED (New) = ",?38,"$",$JUSTIFY($FNUMBER(RMGTIN,",",2),10)
+5 WRITE ?80,"GRAND TOTAL $ VALUE ON-HAND (New) = ",?115,"$",$JUSTIFY($FNUMBER(RMGTON,",",2),12)
+6 WRITE !,"<End of Report>"
+7 ;
CLEAN1 ; Clean and EXITS program.
+1 IF $EXTRACT(IOST)["C"
IF '$DATA(DUOUT)
KILL DIR
SET DIR(0)="E"
DO ^DIR
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 NEW RMPR,RMPRSITE
+5 DO KILL^XUSCLEAN
+6 KILL ^TMP($JOB)
+7 QUIT
+8 ;
HDRI ;print heading.
+1 if $GET(RFL)
QUIT
+2 SET RMPAGE=RMPAGE+1
+3 WRITE !,"PROSTHETIC INVENTORY ITEM DETAIL REPORT",?50,"Run Date: ",RMRDATE,?100,"Page: ",RMPAGE
+4 WRITE !,"STATION: ",$EXTRACT(RSTN,1,20)
+5 WRITE ?32,RMBD," - ",RMED," [ ",RMCALDAY," calendar days ]"
+6 QUIT
+7 ;
LBL1 ;print column header.
+1 if $GET(RFL)
QUIT
+2 WRITE !,RLN
+3 if RMPRDET="I"
WRITE !,"HCPCS PSAS/ITEM"
+4 if RMPRDET="H"
WRITE !,"HCPCS DESCRIPTION"
+5 if RMPRDET="L"
WRITE !,"NPPD LINE"
+6 if RMPRDET="G"
WRITE !,"NPPD GROUP"
+7 WRITE ?23,"V.A.(Used) Total| COM. (New) Total| Total |Days Ave | Stock On-Hand| Days |Total $ Value On-Hand"
+8 WRITE !,?23,"Issue $ Value| Issue $ Value| Issue |Usage Rate| Used New | On-Hand| Used New"
+9 if RMPRDET'="G"
WRITE !,RLN
+10 QUIT
+11 ;
GLN1 ;print NPPD GROUP and LINE header.
+1 if $GET(RFL)
QUIT
+2 WRITE !!,RJ," ",RNPLINE," [",RNPGRP," ]"
+3 DO LBL1
+4 QUIT
+5 ;
SUML1 ;print summary total for NPPD LINE
+1 if $GET(RFL)
QUIT
+2 WRITE !,REQ
+3 if $GET(RMTUSELU)
SET RMTAVELU=RMTUSELU/RMCALDAY
+4 if $GET(RMTUSELN)
SET RMTAVELN=RMTUSELN/RMCALDAY
+5 ;S:RMTDLEL>999 RMTDLEL=">999"
+6 ;next two lines print used total
+7 WRITE !,?5,"(Used)",?26,$JUSTIFY(RMTVAL,5),?34,$JUSTIFY($FNUMBER(RMTISUL,",",2),6),?40,"|",?59,"|",?60,$JUSTIFY(RMTUSELU,5),?67,"|",?71,$JUSTIFY(RMTAVELU,5,2),?78,"|"
+8 WRITE ?81,$JUSTIFY(RMTQOHUL,5),?94,"|",?103,"|",?104,$JUSTIFY($FNUMBER(RMTVALUL,",",2),11)
+9 ;next two lines print new total
+10 WRITE !,?5,"(New)",?40,"|",?41,$JUSTIFY(RMTCOML,4),?49,$JUSTIFY($FNUMBER(RMTISNL,",",2),9),?59,"|",?60,$JUSTIFY(RMTUSELN,5),?67,"|",?71,$JUSTIFY(RMTAVELN,5,2),?78,"|"
+11 WRITE ?87,$JUSTIFY(RMTQOHNL,6),?94,"|",?103,"|",?116,$JUSTIFY($FNUMBER(RMTVALNL,",",2),11)
+12 SET (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSEL,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL,RLCNT,RMTUSELU,RMTUSELN)=0
+13 SET (RNPLINE,RLINE)=""
+14 QUIT
