120 lines
4.7 KiB
Mathematica
120 lines
4.7 KiB
Mathematica
RMPR5HQC ;HCIOFO/RVD - NPPD LINE USAGE REPORT FOR HQ ; 06 OCT 00
|
|
;;3.0;PROSTHETICS;**51,61**;Feb 09, 1996
|
|
DQ1 ;print PIP Report
|
|
F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 D:(RSTA'="")&(RSTA'=RST)&(RPR=1) HDRL S RSTA=RST F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) D:(RGRP'="")&(RGRP'=RI) SUMG1 Q:$G(RFL)!(RI'>0) D
|
|
.D:RPR=0 HDRL
|
|
.S RGRP=RI
|
|
.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
|
|
....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)
|
|
....;total for GROUP
|
|
....S RMTVAG=RMTVAG+RMVA
|
|
....S RMTCOMG=RMTCOMG+RMCOM
|
|
....S RMTUSEG=RMTUSEG+RMVA+RMCOM
|
|
....S RMTISUG=RMTISUG+RMISU
|
|
....S RMTISNG=RMTISNG+RMISN
|
|
....S RMTDLEG=RMTDLEG+RMDLEU+RMDLEN
|
|
....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
|
|
....;total for line item
|
|
....S RMTVAL=RMTVAL+RMVA
|
|
....S RMTCOML=RMTCOML+RMCOM
|
|
....I (RMCOM'=""),$G(RMCOM) S RMTUSELN=RMTUSELN+RMCOM
|
|
....I (RMVA'=""),$G(RMVA) S RMTUSELU=RMTUSELU+RMVA
|
|
....S RMTISUL=RMTISUL+RMISU
|
|
....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
|
|
;
|
|
HDRL ;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(RSTA)
|
|
D CNTRX^RMPR5HQA
|
|
S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY NPPD GROUP/LINE 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)=""
|
|
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RNPGRP
|
|
D LBL1^RMPR5HQA
|
|
Q
|
|
;
|
|
SUML1 ;
|
|
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RLINE_RB1_RNPLINE
|
|
S:$G(RMTUSELU) RMTAVELU=RMTUSELU/RMCALDAY
|
|
S:$G(RMTUSELN) RMTAVELN=RMTUSELN/RMCALDAY
|
|
S:$G(RMTUSELU) RTDLELA=RMTQOHUL/RMTAVELU
|
|
S:$G(RMTUSELN) RTDLELC=RMTQOHNL/RMTAVELN
|
|
S RTDLELA=$S(RTDLELA>999:">999",1:$J(RTDLELA,5,0))
|
|
S RTDLELC=$S(RTDLELC>999:">999",1:$J(RTDLELC,5,0))
|
|
S:RMTQOHNL=0 RTDLELC=""
|
|
S:RMTQOHUL=0 RTDLELA=""
|
|
S:(RMTQOHNL>0)&(RMTCOML<1) RTDLELC=">"_RMCALDAY
|
|
S:(RMTQOHUL>0)&(RMTVAL<1) RTDLELA=">"_RMCALDAY
|
|
S RMTAVEG=RTAVELA+RTAVELC
|
|
D CNTRX^RMPR5HQA
|
|
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_"|"_RB1_$J(RTDLELA,6)_RB1_"|"_RB1_$J($FN(RMTVALUL,",",2),11)
|
|
;next two lines print new total
|
|
D CNTRX^RMPR5HQA
|
|
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_"|"_RB1_$J(RTDLELC,6)_RB1_"|"_RB12_$J($FN(RMTVALNL,",",2),11)
|
|
;
|
|
S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSELU,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL)=0
|
|
S (RMTUSELN,RMTUSELU,RTDLELA,RTDLELC,RTAVELA,RTAVELC)=0
|
|
S (RNPLINE,RLINE)=""
|
|
Q
|
|
;
|
|
SUMG1 ;print summary total for NPPD GROUP
|
|
D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=REQ
|
|
D CNTRX^RMPR5HQA
|
|
S ^TMP($J,"RI",RC)=RB24_$J(RMTVAG,5)_RB1_$J($FN(RMTISUG,",",2),9)_RB1_"|"_RB1_$J(RMTCOMG,6)_RB1_$J($FN(RMTISNG,",",2),9)_RB1_"|"_RB1_$J(RMTUSEG,5)_RB1_"|"_RB10_"|"
|
|
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUG,6)_RB1_$J(RMTQOHNG,6)_RB1_"|"_RB8_"|"_RB1_$J($FN(RMTVALUG,",",2),11)_$J($FN(RMTVALNG,",",2),11)
|
|
;W !,?26,$J(RMTVAG,5),?34,$J($FN(RMTISUG,",",2),6),?40,"|",?41,$J(RMTCOMG,4),?49,$J($FN(RMTISNG,",",2),9),?59,"|",?60,$J(RMTUSEG,5),?67,"|",?78,"|"
|
|
;W ?81,$J(RMTQOHUG,5),?87,$J(RMTQOHNG,6),?94,"|",?103,"|",?104,$J($FN(RMTVALUG,",",2),11),?116,$J($FN(RMTVALNG,",",2),11)
|
|
;
|
|
S (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RMTUSEG,RMTAVEG,RMTQOHUG,RMTQOHNG,RMTVALUG,RMTVALNG,RLCNT)=0
|
|
S (RNPGRP,RGRP)=""
|
|
Q
|
|
;
|
|
STN(RST) ;STATION FUNCTION
|
|
N Y,RS
|
|
S RS=$O(^RMPR(669.9,"C",RST,0)),Y=$P(^RMPR(669.9,RS,0),U,1)
|
|
Q Y
|