RMPR5HQB ;HCIOFO/RVD - HCPCS USAGE REPORT FOR HQ ; 06 OCT 00
;;3.0;PROSTHETICS;**51**;Feb 09, 1996
;
DQ1 ;process PIP HPCPC Report and e-mail to PSAS HQ.
;
F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 D:(RSTA'="")&(RSTA'=RST)&(RPR=1) HDRH 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 HDRH
.S RNPGRP=RMARRAY(RI)
.S RJ=""
.F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) D:(RLINE'="")&(RLINE'=RJ) SUML1^RMPR5HQA 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) D:(RHCPC'="")&(RHCPC'=RK)&(RLCNT'=0) SUMH1 Q:RK="" D
...S RHCPC=RK
...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 RMHCDA=$P(RK,"/",2)
....S RNPITEM=$P($G(^RMPR(661.1,RMHCDA,0)),U,2)
....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=$J($P(RDAT,U,7),5,2)
....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=$J($P(RDAT,U,13),5,2)
....;total for HCPCS
....S RMTVAH=RMTVAH+RMVA
....S RMTCOMH=RMTCOMH+RMCOM
....S RMTISUH=RMTISUH+RMISU
....S RMTISNH=RMTISNH+RMISN
....I (RMCOM'=""),$G(RMCOM) S RTUSEHC=RTUSEHC+RMCOM
....I (RMVA'=""),$G(RMVA) S RTUSEHA=RTUSEHA+RMVA
....S RMTQOHUH=RMTQOHUH+RMQOHU
....S RMTQOHNH=RMTQOHNH+RMQOHN
....S RMTVALUH=RMTVALUH+RMVALU
....S RMTVALNH=RMTVALNH+RMVALN
....S RMGTOU=RMGTOU+RMVALU
....S RMGTON=RMGTON+RMVALN
....S RMGTIU=RMGTIU+RMISU
....S RMGTIN=RMGTIN+RMISN
....;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 RMTAVELU=RMTAVELU+RMAVEU
....S RMTAVELN=RMTAVELN+RMAVEN
....S RMTDLEL=RMTDLEL+RMDLEU+RMDLEN
....S RMTISNL=RMTISNL+RMISN
....S RMTQOHUL=RMTQOHUL+RMQOHU
....S RMTQOHNL=RMTQOHNL+RMQOHN
....S RMTVALUL=RMTVALUL+RMVALU
....S RMTVALNL=RMTVALNL+RMVALN
....S (RPRINT,RPR)=1
Q
;
HDRH ;print heading.
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
I RPR=1 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RES
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
S RPR=1
S RSTN=$$STN^RMPR5HQC(RSTA)
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY HCPCS SUMMARY REPORT"_RB10_"Run Date: "_RMRDATE
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="STATION: "_$E(RSTN,1,30)_RB6_RMBD_"- "_RMED_" [ "_RMCALDAY_" calendar days ]"
Q
;
GLN1 ;print NPPD GROUP and LINE header.
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RJ_" "_RNPLINE_" ["_RNPGRP_" ]"
D LBL1^RMPR5HQA
Q
;
SUMH1 ;
S:$G(RTUSEHC) RTAVEHC=RTUSEHC/RMCALDAY
S:$G(RTAVEHC) RTDLEHC=RMTQOHNH/RTAVEHC
S:$G(RTUSEHA) RTAVEHA=RTUSEHA/RMCALDAY
S:$G(RTAVEHA) RTDLEHA=RMTQOHUH/RTAVEHA
S RTDLEHA=$S(RTDLEHA>999:">999",1:$J(RTDLEHA,6,0))
S RTDLEHC=$S(RTDLEHC>999:">999",1:$J(RTDLEHC,6,0))
S:RMTQOHNH=0 RTDLEHC=""
S:RMTQOHUH=0 RTDLEHA=""
S:(RMTQOHNH>0)&(RMTCOMH<1) RTDLEHC=">"_RMCALDAY
S:(RMTQOHUH>0)&(RMTVAH<1) RTDLEHA=">"_RMCALDAY
S RMTAVEL=RTAVEHA+RTAVEHC
S RNPITEM=RNPITEM_" "
S RHCPC=RHCPC_" "
D CNTRX^RMPR5HQA
;next two lines for Used.
S ^TMP($J,"RI",RC)=$E(RHCPC,1,8)_$E(RNPITEM,1,10)_"(Used)"_$J(RMTVAH,5)_RB1_$J($FN(RMTISUH,",",2),9)_RB1_"|"_RB18_"|"_RB1_$J(RTUSEHA,5)_RB1_"|"_RB1_$J(RTAVEHA,8,2)_RB1_"|"
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUH,6)_RB8_"|"_RB1_$J(RTDLEHA,6)_RB1_"|"_RB1_$J($FN(RMTVALUH,",",2),11)
;next two lines print new total
D CNTRX^RMPR5HQA
S ^TMP($J,"RI",RC)=$E(RHCPC,1,8)_$E(RNPITEM,1,10)_"(New) "_RB16_"|"_RB1_$J(RMTCOMH,6)_RB1_$J($FN(RMTISNH,",",2),9)_RB1_"|"_RB1_$J(RTUSEHC,5)_RB1_"|"_RB1_$J(RTAVEHC,8,2)_RB1_"|"
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB6_$J(RMTQOHNH,8)_RB1_"|"_RB1_$J(RTDLEHC,6)_RB1_"|"_RB11_$J($FN(RMTVALNH,",",2),11)
;
S RPR=1
S (RMTVAH,RMTISUH,RMTCOMH,RMTISNH,RMTUSEH,RMTAVEH,RMTQOHUH,RMTQOHNH,RMTVALUH,RMTVALNH,RHCNT)=0
S (RTUSEHA,RTUSEHC,RTDLEHA,RTDLEHC,RTAVEHA,RTAVEHC)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR5HQB 4314 printed Oct 16, 2024@18:33:43 Page 2
RMPR5HQB ;HCIOFO/RVD - HCPCS USAGE REPORT FOR HQ ; 06 OCT 00
+1 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
+2 ;
DQ1 ;process PIP HPCPC Report and e-mail to PSAS HQ.
+1 ;
+2 FOR RST=0:0
SET RST=$ORDER(^TMP($JOB,R5,RST))
if RST'>0
QUIT
if (RSTA'="")&(RSTA'=RST)&(RPR=1)
DO HDRH
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
+3 if RPR=0
DO HDRH
+4 SET RNPGRP=RMARRAY(RI)
+5 SET RJ=""
+6 FOR
SET RJ=$ORDER(^TMP($JOB,R5,RST,RI,RJ))
if $GET(RFL)
QUIT
if (RLINE'="")&(RLINE'=RJ)
DO SUML1^RMPR5HQA
if RJ=""
QUIT
Begin DoDot:2
+7 SET RLINE=RJ
SET RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
+8 IF RGCNT=0
SET RGCNT=RGCNT+1
+9 SET RK=""
FOR
SET RK=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK))
if $GET(RFL)
QUIT
if (RHCPC'="")&(RHCPC'=RK)&(RLCNT'=0)
DO SUMH1
if RK=""
QUIT
Begin DoDot:3
+10 SET RHCPC=RK
+11 SET RL=""
+12 FOR
SET RL=$ORDER(^TMP($JOB,R5,RST,RI,RJ,RK,RL))
if $GET(RFL)!(RL="")
QUIT
Begin DoDot:4
+13 SET RHCPC=$PIECE(RK,"/",1)
+14 SET RMHCDA=$PIECE(RK,"/",2)
+15 SET RNPITEM=$PIECE($GET(^RMPR(661.1,RMHCDA,0)),U,2)
+16 IF RLCNT=0
DO GLN1
+17 SET RLCNT=RLCNT+1
+18 SET RDAT=^TMP($JOB,R5,RST,RI,RJ,RK,RL)
+19 SET RMVA=$PIECE(RDAT,U,1)
+20 SET RMCOM=$PIECE(RDAT,U,2)
+21 SET RMUSE=$PIECE(RDAT,U,3)
+22 SET RMISU=$PIECE(RDAT,U,4)
+23 SET RMISN=$PIECE(RDAT,U,5)
+24 SET RMAVEN=$PIECE(RDAT,U,6)
+25 SET RMDLEN=$JUSTIFY($PIECE(RDAT,U,7),5,2)
+26 SET RMQOHU=$PIECE(RDAT,U,8)
+27 SET RMQOHN=$PIECE(RDAT,U,9)
+28 SET RMVALU=$PIECE(RDAT,U,10)
+29 SET RMVALN=$PIECE(RDAT,U,11)
+30 SET RMAVEU=$PIECE(RDAT,U,12)
+31 SET RMDLEU=$JUSTIFY($PIECE(RDAT,U,13),5,2)
+32 ;total for HCPCS
+33 SET RMTVAH=RMTVAH+RMVA
+34 SET RMTCOMH=RMTCOMH+RMCOM
+35 SET RMTISUH=RMTISUH+RMISU
+36 SET RMTISNH=RMTISNH+RMISN
+37 IF (RMCOM'="")
IF $GET(RMCOM)
SET RTUSEHC=RTUSEHC+RMCOM
+38 IF (RMVA'="")
IF $GET(RMVA)
SET RTUSEHA=RTUSEHA+RMVA
+39 SET RMTQOHUH=RMTQOHUH+RMQOHU
+40 SET RMTQOHNH=RMTQOHNH+RMQOHN
+41 SET RMTVALUH=RMTVALUH+RMVALU
+42 SET RMTVALNH=RMTVALNH+RMVALN
+43 SET RMGTOU=RMGTOU+RMVALU
+44 SET RMGTON=RMGTON+RMVALN
+45 SET RMGTIU=RMGTIU+RMISU
+46 SET RMGTIN=RMGTIN+RMISN
+47 ;total for line item
+48 SET RMTVAL=RMTVAL+RMVA
+49 SET RMTCOML=RMTCOML+RMCOM
+50 if RMVA'=""
SET RMTUSELU=RMTUSELU+RMVA
+51 if RMCOM'=""
SET RMTUSELN=RMTUSELN+RMCOM
+52 SET RMTISUL=RMTISUL+RMISU
+53 SET RMTAVELU=RMTAVELU+RMAVEU
+54 SET RMTAVELN=RMTAVELN+RMAVEN
+55 SET RMTDLEL=RMTDLEL+RMDLEU+RMDLEN
+56 SET RMTISNL=RMTISNL+RMISN
+57 SET RMTQOHUL=RMTQOHUL+RMQOHU
+58 SET RMTQOHNL=RMTQOHNL+RMQOHN
+59 SET RMTVALUL=RMTVALUL+RMVALU
+60 SET RMTVALNL=RMTVALNL+RMVALN
+61 SET (RPRINT,RPR)=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+62 QUIT
+63 ;
HDRH ;print heading.
+1 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+2 IF RPR=1
DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=RES
+3 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+4 SET RPR=1
+5 SET RSTN=$$STN^RMPR5HQC(RSTA)
+6 DO CNTRX^RMPR5HQA
+7 SET ^TMP($JOB,"RI",RC)="PROSTHETIC INVENTORY HCPCS SUMMARY REPORT"_RB10_"Run Date: "_RMRDATE
+8 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)="STATION: "_$EXTRACT(RSTN,1,30)_RB6_RMBD_"- "_RMED_" [ "_RMCALDAY_" calendar days ]"
+9 QUIT
+10 ;
GLN1 ;print NPPD GROUP and LINE header.
+1 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=""
+2 DO CNTRX^RMPR5HQA
SET ^TMP($JOB,"RI",RC)=RJ_" "_RNPLINE_" ["_RNPGRP_" ]"
+3 DO LBL1^RMPR5HQA
+4 QUIT
+5 ;
SUMH1 ;
+1 if $GET(RTUSEHC)
SET RTAVEHC=RTUSEHC/RMCALDAY
+2 if $GET(RTAVEHC)
SET RTDLEHC=RMTQOHNH/RTAVEHC
+3 if $GET(RTUSEHA)
SET RTAVEHA=RTUSEHA/RMCALDAY
+4 if $GET(RTAVEHA)
SET RTDLEHA=RMTQOHUH/RTAVEHA
+5 SET RTDLEHA=$SELECT(RTDLEHA>999:">999",1:$JUSTIFY(RTDLEHA,6,0))
+6 SET RTDLEHC=$SELECT(RTDLEHC>999:">999",1:$JUSTIFY(RTDLEHC,6,0))
+7 if RMTQOHNH=0
SET RTDLEHC=""
+8 if RMTQOHUH=0
SET RTDLEHA=""
+9 if (RMTQOHNH>0)&(RMTCOMH<1)
SET RTDLEHC=">"_RMCALDAY
+10 if (RMTQOHUH>0)&(RMTVAH<1)
SET RTDLEHA=">"_RMCALDAY
+11 SET RMTAVEL=RTAVEHA+RTAVEHC
+12 SET RNPITEM=RNPITEM_" "
+13 SET RHCPC=RHCPC_" "
+14 DO CNTRX^RMPR5HQA
+15 ;next two lines for Used.
+16 SET ^TMP($JOB,"RI",RC)=$EXTRACT(RHCPC,1,8)_$EXTRACT(RNPITEM,1,10)_"(Used)"_$JUSTIFY(RMTVAH,5)_RB1_$JUSTIFY($FNUMBER(RMTISUH,",",2),9)_RB1_"|"_RB18_"|"_RB1_$JUSTIFY(RTUSEHA,5)_RB1_"|"_RB1_$JUSTIFY(RTAVEHA,8,2)_RB1_"|"
+17 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB1_$JUSTIFY(RMTQOHUH,6)_RB8_"|"_RB1_$JUSTIFY(RTDLEHA,6)_RB1_"|"_RB1_$JUSTIFY($FNUMBER(RMTVALUH,",",2),11)
+18 ;next two lines print new total
+19 DO CNTRX^RMPR5HQA
+20 SET ^TMP($JOB,"RI",RC)=$EXTRACT(RHCPC,1,8)_$EXTRACT(RNPITEM,1,10)_"(New) "_RB16_"|"_RB1_$JUSTIFY(RMTCOMH,6)_RB1_$JUSTIFY($FNUMBER(RMTISNH,",",2),9)_RB1_"|"_RB1_$JUSTIFY(RTUSEHC,5)_RB1_"|"_RB1_$JUSTIFY(RTAVEHC,8,2)_RB1_"|"
+21 SET ^TMP($JOB,"RI",RC)=^TMP($JOB,"RI",RC)_RB6_$JUSTIFY(RMTQOHNH,8)_RB1_"|"_RB1_$JUSTIFY(RTDLEHC,6)_RB1_"|"_RB11_$JUSTIFY($FNUMBER(RMTVALNH,",",2),11)
+22 ;
+23 SET RPR=1
+24 SET (RMTVAH,RMTISUH,RMTCOMH,RMTISNH,RMTUSEH,RMTAVEH,RMTQOHUH,RMTQOHNH,RMTVALUH,RMTVALNH,RHCNT)=0
+25 SET (RTUSEHA,RTUSEHC,RTDLEHA,RTDLEHC,RTAVEHA,RTAVEHC)=0
+26 QUIT
