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