RMPR5HQA ;HCIOFO/RVD - ITEM USAGE REPORT FOR HQ and CTL PRG ; 04 Oct 00
;;3.0;PROSTHETICS;**51**;Feb 09, 1996
;
;variables rmprdet,rmprpip1,rmprpip2 are external (from the server).
;all ITEMs for all STATION is the default processing for the date range.
START Q:RMPRPIP1>RMPRPIP2
D NATION^RMPR5HQ5 S RMPRSEL("*")="",RMPRSTN="*"
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
N RMTVALUH,RMTVALNH,RMTQOHUH,RMTQOHNH,RMTDLEH,RMTDLEG,RMTAVEG,RMGTOT
N RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN,RMTISNH
N RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTUSELU,RMTUSELN
N RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC,RMCALDAY,RMTAVELN
;
S (RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RMTAVEG,RMGTOT,RMTUSELU,RMGISNG)=0
S (RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU)=0
S (RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTISUH)=0
S (RMTUSEG,RMTVAG,RMTCOMG,RMGTOU,RMGTON,RMTVAH,RMTCOMH,RMTVALUH)=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,RC,RPR)=0
S (RMTVALNH,RMTQOHUH,RMTISNH,RMTUSELN,RMGISUG)=0
S (RLINE,RGRP,RST,RNPGRP,RNPLINE,RHCPC,RMTDLEG,RSTA)=""
;
S X2=RMPRPIP1,X1=RMPRPIP2 D ^%DTC S RMCALDAY=X+1
S Y=RMPRPIP1 D DD^%DT S RMBD=Y S Y=RMPRPIP2 D DD^%DT S RMED=Y
D NOW^%DTC S Y=% X ^DD("DD") S RMRDATE=Y
S $P(RLN,"-",132)="",RMPAGE=0,R5="RMPR5",$P(REQ,"=",132)=""
S $P(RES,"*",132)="",$P(RB1," ",2)=""
S $P(RB2," ",3)=""
S $P(RB3," ",4)=""
S $P(RB4," ",5)=""
S $P(RB5," ",6)=""
S $P(RB6," ",7)=""
S $P(RB7," ",8)=""
S $P(RB8," ",9)=""
S $P(RB9," ",10)=""
S $P(RB10," ",11)=""
S $P(RB11," ",12)=""
S $P(RB12," ",13)=""
S $P(RB13," ",14)=""
S $P(RB14," ",15)=""
S $P(RB15," ",16)=""
S $P(RB16," ",17)=""
S $P(RB18," ",19)=""
S $P(RB23," ",24)=""
S $P(RB24," ",25)=""
S $P(RB26," ",27)=""
S $P(RB30," ",31)=""
S $P(RB31," ",32)=""
S $P(RB33," ",34)=""
S $P(RB50," ",51)=""
K RX D GRPARY^RMPR5HQ4(.RMARRAY)
;
ITEM ;entry point for Item Detail Usage report
I RMPRDET="I" S RMQSUBJ="PIP DETAIL ITEM REPORT" G DQ1
;
HCPCS ;entry point for HCPCS Summary Usage report.
I RMPRDET="H" S RMQSUBJ="PIP HCPCS SUMMARY REPORT" D ^RMPR5HQB G TOT
LINE ;entry point for NPPD LINE Usage report.
I RMPRDET="L" S RMQSUBJ="PIP NPPD LINE SUMMARY REPORT" D ^RMPR5HQC G TOT
;
GROUP ;entry point for NPPD GROUP Usage report.
I RMPRDET="G" S RMQSUBJ="PIP NPPD GROUP SUMMARY REPORT" D ^RMPR5HQD
G SEND
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
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.
F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 D:(RSTA'="")&(RSTA'=RST)&(RPR=1) HDRI S RSTA=RST 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),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,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,6,0))
....S RMDLEN=$S(RMDLEN>999:">999",1:$J(RMDLEN,6,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 RNPITEM=RNPITEM_" "
....S RHCPC=RHCPC_" "
....;for used item
....I (RMVA>0)!(RMVALU>0)!(RMVALU<0) D CNTRX S ^TMP($J,"RI",RC)=$E(RHCPC,1,11)_$E(RNPITEM,1,12)_RB1_$J(RMVA,5)_RB1_$J($FN(RMISU,",",2),9)_RB1_"|"_RB18_"|"_RB1_$J(RMVA,5)_RB1_"|"_RB1_$J(RMAVEU,8,2)_RB1_"|"_RB1_$J(RMQOHU,6)
....I (RMVA>0)!(RMVALU>0)!(RMVALU<0) S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB8_"|"_RB1_$J(RMDLEU,6)_RB1_"|"_RB1_$J(RMVALU,11)
....;for new item
....I (RMCOM>0)!(RMVALN>0)!(RMVALN<0) D CNTRX S ^TMP($J,"RI",RC)=$E(RHCPC,1,11)_$E(RNPITEM,1,13)_RB16_"|"_RB1_$J(RMCOM,6)_RB1_$J($FN(RMISN,",",2),9)_RB1_"|"_RB1_$J(RMCOM,5)_RB1_"|"_RB1_$J(RMAVEN,8,2)_RB1_"|"
....I (RMCOM>0)!(RMVALN>0)!(RMVALN<0) S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB6_$J(RMQOHN,8)_RB1_"|"_RB1_$J(RMDLEN,6)_RB1_"|"_RB11_$J(RMVALN,11)
....S (RPRINT,RPR)=1
;
TOT ;print total for Used and New items (all report type)
G:$G(RFL) CLEAN1
D CNTRX S ^TMP($J,"RI",RC)="" D CNTRX S ^TMP($J,"RI",RC)=RLN
D CNTRX S ^TMP($J,"RI",RC)=""
I '$G(RPRINT) D CNTRX S ^TMP($J,"RI",RC)="No Records to Print !!" G CLEAN1
D CNTRX
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
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)
D CNTRX S ^TMP($J,"RI",RC)="<End of Report>"
;
SEND ;send report to HQ
S RMQMAIL=$$GETADDR^RMPR5HQ1()
D:RMQMAIL="" NOADDR^RMPR5HQ1() G:$D(RQUIT) CLEAN1
S RD=$O(^TMP($J,"RMPR5",0)) S RMBDT=RMPRPIP1,RMEDT=RMPRPIP2
S XMSUB=RMQSUBJ,XMCHAN=1,XMDUZ=.5,XMY(RMQMAIL)=""
;next line for testing
D GET^XMA2 I XMZ<1 G CLEAN1
S RMQMES=XMZ,XMTEXT="^TMP($J,""RI""," D ^XMD
;send a confirmation message to local user.
D SENDCONF^RMPR5HQ1(RMQSUBJ,RMBD,RMED)
;
CLEAN1 ; Clean and EXITS program.
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC N RMPR,RMPRSITE D KILL^XUSCLEAN K ^TMP($J) Q
;
HDRI ;print heading.
D CNTRX S ^TMP($J,"RI",RC)=""
I RPR=1 D CNTRX S ^TMP($J,"RI",RC)=RES
D CNTRX S ^TMP($J,"RI",RC)="",RPR=1,RMPAGE=RMPAGE+1 D CNTRX
S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY ITEM DETAIL REPORT"_RB10_"Run Date: "_RMRDATE
S RSTN=$$STN^RMPR5HQC(RSTA)
D CNTRX S ^TMP($J,"RI",RC)="STATION: "_$E(RSTN,1,30)_RB6_RMBD_" - "_RMED_" [ "_RMCALDAY_" calendar days ]"
Q
;
CNTRX ;INCREMENT MAIL LINE COUNTER
S RC=RC+1 Q
;
LBL1 ;print column header.
D CNTRX S ^TMP($J,"RI",RC)=RLN D CNTRX
I RMPRDET="I" S ^TMP($J,"RI",RC)="HCPCS PSAS/ITEM"
I RMPRDET="H" S ^TMP($J,"RI",RC)="HCPCS DESCRIPTION"
I RMPRDET="L" S ^TMP($J,"RI",RC)="NPPD LINE "
I RMPRDET="G" S ^TMP($J,"RI",RC)="NPPD GROUP "
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_" V.A.(Used) Total| COM. (New) Total| Total |Days Ave | Stock On-Hand| Days |Total $ Value On-Hand"
D CNTRX
S ^TMP($J,"RI",RC)=RB23_"Issue $ Value| Issue $ Value| Issue |Usage Rate| Used New | On-Hand| Used New"
I RMPRDET'="G" D CNTRX S ^TMP($J,"RI",RC)=RLN
Q
;
GLN1 ;print NPPD GROUP and LINE header.
D CNTRX S ^TMP($J,"RI",RC)=""
D CNTRX S ^TMP($J,"RI",RC)=RJ_" "_RNPLINE_" ["_RNPGRP_" ]"
D LBL1 Q
;
SUML1 ;print summary total for NPPD LINE
D CNTRX S ^TMP($J,"RI",RC)=REQ
;next two lines print used total
D CNTRX S:$G(RMTUSELU) RMTAVELU=RMTUSELU/RMCALDAY
S:$G(RMTUSELN) RMTAVELN=RMTUSELN/RMCALDAY
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_"|"_RB8_"|"_RB1_$J($FN(RMTVALUL,",",2),11)
;next two lines print new total
D CNTRX
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_"|"_RB8_"|"_RB11_$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[HRMPR5HQA 9720 printed Dec 13, 2024@02:33:03 Page 2
RMPR5HQA ;HCIOFO/RVD - ITEM USAGE REPORT FOR HQ and CTL PRG ; 04 Oct 00
+1 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
+2 ;
+3 ;variables rmprdet,rmprpip1,rmprpip2 are external (from the server).
+4 ;all ITEMs for all STATION is the default processing for the date range.
START if RMPRPIP1>RMPRPIP2
QUIT
+1 DO NATION^RMPR5HQ5
SET RMPRSEL("*")=""
SET RMPRSTN="*"
+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
+7 NEW RMTVALUH,RMTVALNH,RMTQOHUH,RMTQOHNH,RMTDLEH,RMTDLEG,RMTAVEG,RMGTOT
+8 NEW RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN,RMTISNH
+9 NEW RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTUSELU,RMTUSELN
+10 NEW RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC,RMCALDAY,RMTAVELN
+11 ;
+12 SET (RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RMTAVEG,RMGTOT,RMTUSELU,RMGISNG)=0
+13 SET (RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU)=0
+14 SET (RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTISUH)=0
+15 SET (RMTUSEG,RMTVAG,RMTCOMG,RMGTOU,RMGTON,RMTVAH,RMTCOMH,RMTVALUH)=0
+16 SET (RMGVAL,RGCNT,RLCNT,RSCNT,RFL,RPRINT,RMTQOHNH,RMTUSEH,RMTDLEH)=0
+17 SET (RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN)=0
+18 SET (RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTAVELN)=0
+19 SET (RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC,RC,RPR)=0
+20 SET (RMTVALNH,RMTQOHUH,RMTISNH,RMTUSELN,RMGISUG)=0
+21 SET (RLINE,RGRP,RST,RNPGRP,RNPLINE,RHCPC,RMTDLEG,RSTA)=""
+22 ;
+23 SET X2=RMPRPIP1
SET X1=RMPRPIP2
DO ^%DTC
SET RMCALDAY=X+1
+24 SET Y=RMPRPIP1
DO DD^%DT
SET RMBD=Y
SET Y=RMPRPIP2
DO DD^%DT
SET RMED=Y
+25 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET RMRDATE=Y
+26 SET $PIECE(RLN,"-",132)=""
SET RMPAGE=0
SET R5="RMPR5"
SET $PIECE(REQ,"=",132)=""
+27 SET $PIECE(RES,"*",132)=""
SET $PIECE(RB1," ",2)=""
+28 SET $PIECE(RB2," ",3)=""
+29 SET $PIECE(RB3," ",4)=""
+30 SET $PIECE(RB4," ",5)=""
+31 SET $PIECE(RB5," ",6)=""
+32 SET $PIECE(RB6," ",7)=""
+33 SET $PIECE(RB7," ",8)=""
+34 SET $PIECE(RB8," ",9)=""
+35 SET $PIECE(RB9," ",10)=""
+36 SET $PIECE(RB10," ",11)=""
+37 SET $PIECE(RB11," ",12)=""
+38 SET $PIECE(RB12," ",13)=""
+39 SET $PIECE(RB13," ",14)=""
+40 SET $PIECE(RB14," ",15)=""
+41 SET $PIECE(RB15," ",16)=""
+42 SET $PIECE(RB16," ",17)=""
+43 SET $PIECE(RB18," ",19)=""
+44 SET $PIECE(RB23," ",24)=""
+45 SET $PIECE(RB24," ",25)=""
+46 SET $PIECE(RB26," ",27)=""
+47 SET $PIECE(RB30," ",31)=""
+48 SET $PIECE(RB31," ",32)=""
+49 SET $PIECE(RB33," ",34)=""
+50 SET $PIECE(RB50," ",51)=""
+51 KILL RX
DO GRPARY^RMPR5HQ4(.RMARRAY)
+52 ;
ITEM ;entry point for Item Detail Usage report
+1 IF RMPRDET="I"
SET RMQSUBJ="PIP DETAIL ITEM REPORT"
GOTO DQ1
+2 ;
HCPCS ;entry point for HCPCS Summary Usage report.
+1 IF RMPRDET="H"
SET RMQSUBJ="PIP HCPCS SUMMARY REPORT"
DO ^RMPR5HQB
GOTO TOT
LINE ;entry point for NPPD LINE Usage report.
+1 IF RMPRDET="L"
SET RMQSUBJ="PIP NPPD LINE SUMMARY REPORT"
DO ^RMPR5HQC
GOTO TOT
+2 ;
GROUP ;entry point for NPPD GROUP Usage report.
+1 IF RMPRDET="G"
SET RMQSUBJ="PIP NPPD GROUP SUMMARY REPORT"
DO ^RMPR5HQD
+2 GOTO SEND
+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 FOR RST=0:0
SET RST=$ORDER(^TMP($JOB,R5,RST))
if RST'>0
QUIT
if (RSTA'="")&(RSTA'=RST)&(RPR=1)
DO HDRI
SET RSTA=RST
FOR RI=0:0
SET RI=$ORDER(^TMP($JOB,R5,RST,RI))
if $GET(RFL)
QUIT
if RI'>0
QUIT
Begin DoDot:1
+4 if RPR=0
DO HDRI
SET RNPGRP=RMARRAY(RI)
SET RJ=""
+5 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
+6 SET RLINE=RJ
SET RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
+7 IF RGCNT=0
SET RGCNT=RGCNT+1
+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=""
FOR
SET RL=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK,RL))
if $GET(RFL)!(RL="")
QUIT
Begin DoDot:4
+10 SET RHCPC=$PIECE(RK,"/",1)
if RMPRDET="I"
SET RHCPC=RHCPC_"-"_RL
+11 SET RNPITEM=$$GETITEM^RMPR5HQ5($PIECE(RK,"/",2),RL)
+12 IF RLCNT=0
DO GLN1
+13 SET RLCNT=RLCNT+1
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=$PIECE(RDAT,U,7)
+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=$PIECE(RDAT,U,13)
+27 SET RMDLEU=$SELECT(RMDLEU>999:">999",1:$JUSTIFY(RMDLEU,6,0))
+28 SET RMDLEN=$SELECT(RMDLEN>999:">999",1:$JUSTIFY(RMDLEN,6,0))
+29 if (RMVA<1)&(RMVALU>0)
SET RMDLEU=">"_RMCALDAY
+30 if (RMCOM<1)&(RMVALN>0)
SET RMDLEN=">"_RMCALDAY
+31 ;total for line item
+32 SET RMTVAL=RMTVAL+RMVA
+33 SET RMTCOML=RMTCOML+RMCOM
+34 if RMVA'=""
SET RMTUSELU=RMTUSELU+RMVA
+35 if RMCOM'=""
SET RMTUSELN=RMTUSELN+RMCOM
+36 SET RMTISUL=RMTISUL+RMISU
+37 SET RMTISNL=RMTISNL+RMISN
+38 SET RMTAVELU=RMTAVELU+RMAVEU
+39 SET RMTAVELN=RMTAVELN+RMAVEN
+40 SET RMTQOHUL=RMTQOHUL+RMQOHU
+41 SET RMTQOHNL=RMTQOHNL+RMQOHN
+42 SET RMTVALUL=RMTVALUL+RMVALU
+43 SET RMTVALNL=RMTVALNL+RMVALN
+44 ;total for group
+45 SET RMTVAG=RMTVAG+RMVA
+46 SET RMTCOMG=RMTCOMG+RMCOM
+47 SET RMTUSEG=RMTUSEG+RMVA
+48 SET RMTISUG=RMTISUG+RMISU
+49 SET RMTISNG=RMTISNG+RMISN
+50 SET RMTQOHUG=RMTQOHUG+RMQOHU
+51 SET RMTQOHNG=RMTQOHNG+RMQOHN
+52 SET RMTVALUG=RMTVALUG+RMVALU
+53 SET RMTVALNG=RMTVALNG+RMVALN
+54 SET RMGTOU=RMGTOU+RMVALU
+55 SET RMGTON=RMGTON+RMVALN
+56 SET RMGTIU=RMGTIU+RMISU
+57 SET RMGTIN=RMGTIN+RMISN
+58 if 'RMISU
SET RMISU=""
+59 if 'RMISN
SET RMISN=""
+60 SET RMVALU=$FNUMBER(RMVALU,",",2)
if 'RMVALU
SET RMVALU=""
+61 SET RMVALN=$FNUMBER(RMVALN,",",2)
if 'RMVALN
SET RMVALN=""
+62 SET RNPITEM=RNPITEM_" "
+63 SET RHCPC=RHCPC_" "
+64 ;for used item
+65 IF (RMVA>0)!(RMVALU>0)!(RMVALU<0)
DO CNTRX
SET ^TMP($JOB,"RI",RC)=$EXTRACT(RHCPC,1,11)_$EXTRACT(RNPITEM,1,12)_RB1_$JUSTIFY(RMVA,5)_RB1_$JUSTIFY($FNUMBER(RMISU,",",2),9)_RB1_"|"_RB18_"|"_RB1_$JUSTIFY(RMVA,5)_RB1_"|"_RB1_$JUSTIFY(RMAVEU,8,2)_RB1_"|"
_RB1_$JUSTIFY(RMQOHU,6)
+66 IF (RMVA>0)!(RMVALU>0)!(RMVALU<0)
SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB8_"|"_RB1_$JUSTIFY(RMDLEU,6)_RB1_"|"_RB1_$JUSTIFY(RMVALU,11)
+67 ;for new item
+68 IF (RMCOM>0)!(RMVALN>0)!(RMVALN<0)
DO CNTRX
SET ^TMP($JOB,"RI",RC)=$EXTRACT(RHCPC,1,11)_$EXTRACT(RNPITEM,1,13)_RB16_"|"_RB1_$JUSTIFY(RMCOM,6)_RB1_$JUSTIFY($FNUMBER(RMISN,",",2),9)_RB1_"|"_RB1_$JUSTIFY(RMCOM,5)_RB1_"|"_RB1_$JUSTIFY(RMAVEN,8,2)_RB1_"
|"
+69 IF (RMCOM>0)!(RMVALN>0)!(RMVALN<0)
SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB6_$JUSTIFY(RMQOHN,8)_RB1_"|"_RB1_$JUSTIFY(RMDLEN,6)_RB1_"|"_RB11_$JUSTIFY(RMVALN,11)
+70 SET (RPRINT,RPR)=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+71 ;
TOT ;print total for Used and New items (all report type)
+1 if $GET(RFL)
GOTO CLEAN1
+2 DO CNTRX
SET ^TMP($JOB,"RI",RC)=""
DO CNTRX
SET ^TMP($JOB,"RI",RC)=RLN
+3 DO CNTRX
SET ^TMP($JOB,"RI",RC)=""
+4 IF '$GET(RPRINT)
DO CNTRX
SET ^TMP($JOB,"RI",RC)="No Records to Print !!"
GOTO CLEAN1
+5 DO CNTRX
+6 SET ^TMP($JOB,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (Used) = $"_$JUSTIFY($FNUMBER(RMGTIU,",",2),10)
+7 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (Used) = $"_$JUSTIFY($FNUMBER(RMGTOU,",",2),12)
+8 DO CNTRX
+9 SET ^TMP($JOB,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (New) = $"_$JUSTIFY($FNUMBER(RMGTIN,",",2),10)
+10 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (New) = $"_$JUSTIFY($FNUMBER(RMGTON,",",2),12)
+11 DO CNTRX
SET ^TMP($JOB,"RI",RC)="<End of Report>"
+12 ;
SEND ;send report to HQ
+1 SET RMQMAIL=$$GETADDR^RMPR5HQ1()
+2 if RMQMAIL=""
DO NOADDR^RMPR5HQ1()
if $DATA(RQUIT)
GOTO CLEAN1
+3 SET RD=$ORDER(^TMP($JOB,"RMPR5",0))
SET RMBDT=RMPRPIP1
SET RMEDT=RMPRPIP2
+4 SET XMSUB=RMQSUBJ
SET XMCHAN=1
SET XMDUZ=.5
SET XMY(RMQMAIL)=""
+5 ;next line for testing
+6 DO GET^XMA2
IF XMZ<1
GOTO CLEAN1
+7 SET RMQMES=XMZ
SET XMTEXT="^TMP($J,""RI"","
DO ^XMD
+8 ;send a confirmation message to local user.
+9 DO SENDCONF^RMPR5HQ1(RMQSUBJ,RMBD,RMED)
+10 ;
CLEAN1 ; Clean and EXITS program.
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 DO ^%ZISC
NEW RMPR,RMPRSITE
DO KILL^XUSCLEAN
KILL ^TMP($JOB)
QUIT
+3 ;
HDRI ;print heading.
+1 DO CNTRX
SET ^TMP($JOB,"RI",RC)=""
+2 IF RPR=1
DO CNTRX
SET ^TMP($JOB,"RI",RC)=RES
+3 DO CNTRX
SET ^TMP($JOB,"RI",RC)=""
SET RPR=1
SET RMPAGE=RMPAGE+1
DO CNTRX
+4 SET ^TMP($JOB,"RI",RC)="PROSTHETIC INVENTORY ITEM DETAIL REPORT"_RB10_"Run Date: "_RMRDATE
+5 SET RSTN=$$STN^RMPR5HQC(RSTA)
+6 DO CNTRX
SET ^TMP($JOB,"RI",RC)="STATION: "_$EXTRACT(RSTN,1,30)_RB6_RMBD_" - "_RMED_" [ "_RMCALDAY_" calendar days ]"
+7 QUIT
+8 ;
CNTRX ;INCREMENT MAIL LINE COUNTER
+1 SET RC=RC+1
QUIT
+2 ;
LBL1 ;print column header.
+1 DO CNTRX
SET ^TMP($JOB,"RI",RC)=RLN
DO CNTRX
+2 IF RMPRDET="I"
SET ^TMP($JOB,"RI",RC)="HCPCS PSAS/ITEM"
+3 IF RMPRDET="H"
SET ^TMP($JOB,"RI",RC)="HCPCS DESCRIPTION"
+4 IF RMPRDET="L"
SET ^TMP($JOB,"RI",RC)="NPPD LINE "
+5 IF RMPRDET="G"
SET ^TMP($JOB,"RI",RC)="NPPD GROUP "
+6 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_" V.A.(Used) Total| COM. (New) Total| Total |Days Ave | Stock On-Hand| Days |Total $ Value On-Hand"
+7 DO CNTRX
+8 SET ^TMP($JOB,"RI",RC)=RB23_"Issue $ Value| Issue $ Value| Issue |Usage Rate| Used New | On-Hand| Used New"
+9 IF RMPRDET'="G"
DO CNTRX
SET ^TMP($JOB,"RI",RC)=RLN
+10 QUIT
+11 ;
GLN1 ;print NPPD GROUP and LINE header.
+1 DO CNTRX
SET ^TMP($JOB,"RI",RC)=""
+2 DO CNTRX
SET ^TMP($JOB,"RI",RC)=RJ_" "_RNPLINE_" ["_RNPGRP_" ]"
+3 DO LBL1
QUIT
+4 ;
SUML1 ;print summary total for NPPD LINE
+1 DO CNTRX
SET ^TMP($JOB,"RI",RC)=REQ
+2 ;next two lines print used total
+3 DO CNTRX
if $GET(RMTUSELU)
SET RMTAVELU=RMTUSELU/RMCALDAY
+4 if $GET(RMTUSELN)
SET RMTAVELN=RMTUSELN/RMCALDAY
+5 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_"|"
+6 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB1_$JUSTIFY(RMTQOHUL,6)_RB8_"|"_RB8_"|"_RB1_$JUSTIFY($FNUMBER(RMTVALUL,",",2),11)
+7 ;next two lines print new total
+8 DO CNTRX
+9 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_"|"
+10 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB6_$JUSTIFY(RMTQOHNL,8)_RB1_"|"_RB8_"|"_RB11_$JUSTIFY($FNUMBER(RMTVALNL,",",2),11)
+11 SET (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSEL,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL,RLCNT,RMTUSELU,RMTUSELN)=0
+12 SET (RNPLINE,RLINE)=""
+13 QUIT
