112 lines
4.1 KiB
Mathematica
112 lines
4.1 KiB
Mathematica
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
|