- 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 Jan 18, 2025@03:34:08 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