Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPR5HQ2

RMPR5HQ2.m

Go to the documentation of this file.
  1. RMPR5HQ2 ;HCIOFO/RVD - ITEM & HCPCS USAGE REPORT ; 15 AUG 00
  1. ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
  1. ;
  1. MANUAL ;run the USAGE report manually. User needs to enter the month the
  1. ;report should be ran.
  1. N RLN,RMPAGE,R5,REQ,RSL,RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RHCPC,RMTVAH
  1. N RMTUSEG,RMTVAG,RMTCOMG,RMTQOHG,RMTVALG,RMGVAL,RGCNT,RLCNT,RSCNT,RFL
  1. N RLINE,RGRP,RST,RI,RST,RJ,RK,RGRP,RDAT,RMBD,RMED,RPR,RMARRAY,RMTUSEH
  1. N RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU
  1. N RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTCOMH,RMTISUH,RMTISNH
  1. N RMTVALUH,RMTVALNH,RMTQOHUH,RMTQOHNH,RMTDLEH,RMTDLEG,RMTAVEG,RMGTOT
  1. N RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN
  1. N RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTUSELU,RMTUSELN
  1. N RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC,RMCALDAY,RMTAVELN
  1. ;
  1. S X1=RMPREDT,X2=RMPRSDT
  1. D ^%DTC S RMCALDAY=X+1
  1. S Y=RMPRSDT D DD^%DT S RMBD=Y S Y=RMPREDT D DD^%DT S RMED=Y
  1. D NOW^%DTC S Y=% X ^DD("DD") S RMRDATE=Y
  1. S $P(RLN,"-",IOM)="",RMPAGE=0,R5="RMPR5"
  1. S $P(REQ,"=",IOM)=""
  1. S (RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RMTAVEG,RMGTOT,RMTUSELU,RMGISNG,RMGISUG)=0
  1. S (RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU,RMTUSELN)=0
  1. S (RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTISUH,RMTISNH)=0
  1. S (RMTUSEG,RMTVAG,RMTCOMG,RMGTOU,RMGTON,RMTVAH,RMTCOMH,RMTVALUH,RMTVALNH,RMTQOHUH)=0
  1. S (RMGVAL,RGCNT,RLCNT,RSCNT,RFL,RPRINT,RMTQOHNH,RMTUSEH,RMTDLEH)=0
  1. S (RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN)=0
  1. S (RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTAVELN)=0
  1. S (RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC)=0
  1. S (RLINE,RGRP,RST,RNPGRP,RNPLINE,RHCPC,RMTDLEG)=""
  1. D GRPARY^RMPR5HQ4(.RMARRAY)
  1. ;
  1. ITEM ;entry point for Item Detail Usage report
  1. G:RMPRDET="I" DQ1
  1. ;
  1. HCPCS ;entry point for HCPCS Summary Usage report.
  1. I RMPRDET="H" D ^RMPR5HQH G TOT
  1. LINE ;entry point for NPPD LINE Usage report.
  1. I RMPRDET="L" D ^RMPR5HQL G TOT
  1. ;
  1. GROUP ;entry point for NPPD GROUP Usage report.
  1. I RMPRDET="G" D ^RMPR5HQG
  1. G CLEAN1
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1. ;
  1. DQ1 ;print PIP Report (Item Detail Usage report).
  1. ;$O the ^TMP( global for all the records
  1. ;print all records based on the sort criteria given.
  1. I IOST["C-" W @IOF
  1. ;
  1. 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
  1. .D:RPR=0 HDRI
  1. .S RNPGRP=RMARRAY(RI)
  1. .S RJ=""
  1. .F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) D:(RLINE'="")&(RLINE'=RJ) SUML1 Q:RJ="" D
  1. ..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
  1. ..I RGCNT=0 S RGCNT=RGCNT+1
  1. ..S RK="" F S RK=$O(^TMP($J,R5,RST,RI,RJ,RK)) Q:$G(RFL)!(RK="") D
  1. ...S RL=""
  1. ...F S RL=$O(^TMP($J,R5,RST,RI,RJ,RK,RL)) Q:$G(RFL)!(RL="") D
  1. ....S RHCPC=$P(RK,"/",1)
  1. ....S:RMPRDET="I" RHCPC=RHCPC_"-"_RL
  1. ....S RNPITEM=$$GETITEM^RMPR5HQ5($P(RK,"/",2),RL)
  1. ....I RLCNT=0 D GLN1
  1. ....S RLCNT=RLCNT+1
  1. ....S RDAT=^TMP($J,R5,RST,RI,RJ,RK,RL)
  1. ....S RMVA=$P(RDAT,U,1)
  1. ....S RMCOM=$P(RDAT,U,2)
  1. ....S RMUSE=$P(RDAT,U,3)
  1. ....S RMISU=$P(RDAT,U,4)
  1. ....S RMISN=$P(RDAT,U,5)
  1. ....S RMAVEN=$P(RDAT,U,6)
  1. ....S RMDLEN=$P(RDAT,U,7)
  1. ....S RMQOHU=$P(RDAT,U,8)
  1. ....S RMQOHN=$P(RDAT,U,9)
  1. ....S RMVALU=$P(RDAT,U,10)
  1. ....S RMVALN=$P(RDAT,U,11)
  1. ....S RMAVEU=$P(RDAT,U,12)
  1. ....S RMDLEU=$P(RDAT,U,13)
  1. ....S RMDLEU=$S(RMDLEU>999:">999",1:$J(RMDLEU,7,0))
  1. ....S RMDLEN=$S(RMDLEN>999:">999",1:$J(RMDLEN,7,0))
  1. ....S:(RMVA<1)&(RMVALU>0) RMDLEU=">"_RMCALDAY
  1. ....S:(RMCOM<1)&(RMVALN>0) RMDLEN=">"_RMCALDAY
  1. ....;total for line item
  1. ....S RMTVAL=RMTVAL+RMVA
  1. ....S RMTCOML=RMTCOML+RMCOM
  1. ....S:RMVA'="" RMTUSELU=RMTUSELU+RMVA
  1. ....S:RMCOM'="" RMTUSELN=RMTUSELN+RMCOM
  1. ....S RMTISUL=RMTISUL+RMISU
  1. ....S RMTISNL=RMTISNL+RMISN
  1. ....;S RMTAVELU=RMTAVELU+RMAVEU
  1. ....;S RMTAVELN=RMTAVELN+RMAVEN
  1. ....S RMTQOHUL=RMTQOHUL+RMQOHU
  1. ....S RMTQOHNL=RMTQOHNL+RMQOHN
  1. ....S RMTVALUL=RMTVALUL+RMVALU
  1. ....S RMTVALNL=RMTVALNL+RMVALN
  1. ....;total for group
  1. ....S RMTVAG=RMTVAG+RMVA
  1. ....S RMTCOMG=RMTCOMG+RMCOM
  1. ....S RMTUSEG=RMTUSEG+RMVA
  1. ....S RMTISUG=RMTISUG+RMISU
  1. ....S RMTISNG=RMTISNG+RMISN
  1. ....S RMTQOHUG=RMTQOHUG+RMQOHU
  1. ....S RMTQOHNG=RMTQOHNG+RMQOHN
  1. ....S RMTVALUG=RMTVALUG+RMVALU
  1. ....S RMTVALNG=RMTVALNG+RMVALN
  1. ....S RMGTOU=RMGTOU+RMVALU
  1. ....S RMGTON=RMGTON+RMVALN
  1. ....S RMGTIU=RMGTIU+RMISU
  1. ....S RMGTIN=RMGTIN+RMISN
  1. ....S:'RMISU RMISU=""
  1. ....S:'RMISN RMISN=""
  1. ....S RMVALU=$FN(RMVALU,",",2) S:'RMVALU RMVALU=""
  1. ....S RMVALN=$FN(RMVALN,",",2) S:'RMVALN RMVALN=""
  1. ....S:RMVA="" RMVA=0 S:RMISU="" RMISU=0 S:RMCOM="" RMCOM=0
  1. ....S:RMISN="" RMISN=0
  1. ....;for used item
  1. ....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)
  1. ....W:$G(RMVA)!$G(RMVALU) ?94,"|",?96,$J(RMDLEU,7),?103,"|",?104,$J(RMVALU,11)
  1. ....;for new item
  1. ....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,"|"
  1. ....W:$G(RMCOM)!$G(RMVALN) ?87,$J(RMQOHN,6),?94,"|",?96,$J(RMDLEN,7),?103,"|",?116,$J(RMVALN,11)
  1. ....S (RPRINT,RPR)=1
  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
  1. ....I $Y+8>IOSL,IOST'["C-" W @IOF D HDRI,LBL1
  1. ;print total for Used and New items (all report type)
  1. TOT G:$G(RFL) CLEAN1
  1. I '$G(RPRINT) W !!,"No Records to Print !!" G CLEAN1
  1. W !!,?10,"GRAND TOTAL $ VALUE ISSUED (Used) = ",?38,"$",$J($FN(RMGTIU,",",2),10)
  1. W ?80,"GRAND TOTAL $ VALUE ON-HAND (Used) = ",?115,"$",$J($FN(RMGTOU,",",2),12)
  1. W !,?10,"GRAND TOTAL $ VALUE ISSUED (New) = ",?38,"$",$J($FN(RMGTIN,",",2),10)
  1. W ?80,"GRAND TOTAL $ VALUE ON-HAND (New) = ",?115,"$",$J($FN(RMGTON,",",2),12)
  1. W !,"<End of Report>"
  1. ;
  1. CLEAN1 ; Clean and EXITS program.
  1. I $E(IOST)["C",'$D(DUOUT) K DIR S DIR(0)="E" D ^DIR
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC
  1. N RMPR,RMPRSITE
  1. D KILL^XUSCLEAN
  1. K ^TMP($J)
  1. Q
  1. ;
  1. HDRI ;print heading.
  1. Q:$G(RFL)
  1. S RMPAGE=RMPAGE+1
  1. W !,"PROSTHETIC INVENTORY ITEM DETAIL REPORT",?50,"Run Date: ",RMRDATE,?100,"Page: ",RMPAGE
  1. W !,"STATION: ",$E(RSTN,1,20)
  1. W ?32,RMBD," - ",RMED," [ ",RMCALDAY," calendar days ]"
  1. Q
  1. ;
  1. LBL1 ;print column header.
  1. Q:$G(RFL)
  1. W !,RLN
  1. W:RMPRDET="I" !,"HCPCS PSAS/ITEM"
  1. W:RMPRDET="H" !,"HCPCS DESCRIPTION"
  1. W:RMPRDET="L" !,"NPPD LINE"
  1. W:RMPRDET="G" !,"NPPD GROUP"
  1. W ?23,"V.A.(Used) Total| COM. (New) Total| Total |Days Ave | Stock On-Hand| Days |Total $ Value On-Hand"
  1. W !,?23,"Issue $ Value| Issue $ Value| Issue |Usage Rate| Used New | On-Hand| Used New"
  1. W:RMPRDET'="G" !,RLN
  1. Q
  1. ;
  1. GLN1 ;print NPPD GROUP and LINE header.
  1. Q:$G(RFL)
  1. W !!,RJ," ",RNPLINE," [",RNPGRP," ]"
  1. D LBL1
  1. Q
  1. ;
  1. SUML1 ;print summary total for NPPD LINE
  1. Q:$G(RFL)
  1. W !,REQ
  1. S:$G(RMTUSELU) RMTAVELU=RMTUSELU/RMCALDAY
  1. S:$G(RMTUSELN) RMTAVELN=RMTUSELN/RMCALDAY
  1. ;S:RMTDLEL>999 RMTDLEL=">999"
  1. ;next two lines print used total
  1. 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,"|"
  1. W ?81,$J(RMTQOHUL,5),?94,"|",?103,"|",?104,$J($FN(RMTVALUL,",",2),11)
  1. ;next two lines print new total
  1. 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,"|"
  1. W ?87,$J(RMTQOHNL,6),?94,"|",?103,"|",?116,$J($FN(RMTVALNL,",",2),11)
  1. S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSEL,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL,RLCNT,RMTUSELU,RMTUSELN)=0
  1. S (RNPLINE,RLINE)=""
  1. Q