source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5HQL.m@ 1796

Last change on this file since 1796 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1RMPR5HQL ;HCIOFO/RVD - NPPD LINE USAGE REPORT ; 15 AUG 00
2 ;;3.0;PROSTHETICS;**51,61**;Feb 09, 1996
3 ;
4DQ1 ;print PIP Report
5 ;$O the ^TMP( global for all the records
6 ;print all records based on the sort criteria given.
7 I IOST["C-" W @IOF
8 F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 S RSTN=$$STN(RST),RPR=0 F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) Q:$G(RFL) D:(RGRP'="")&(RGRP'=RI) SUMG1 Q:RI'>0 D
9 .D:RPR=0 HDRL
10 .S RGRP=RI
11 .S RNPGRP=RMARRAY(RI)
12 .S RJ=""
13 .F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) D:(RLINE'="")&(RLINE'=RJ) SUML1 Q:(RJ="")!(RFL=1) D
14 ..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
15 ..I RGCNT=0 S RGCNT=RGCNT+1
16 ..S RK="" F S RK=$O(^TMP($J,R5,RST,RI,RJ,RK)) Q:$G(RFL)!(RK="") D
17 ...S RL=""
18 ...F S RL=$O(^TMP($J,R5,RST,RI,RJ,RK,RL)) Q:$G(RFL)!(RL="") D
19 ....I RLCNT=0 D GLN1
20 ....S RLCNT=RLCNT+1
21 ....S RDAT=^TMP($J,R5,RST,RI,RJ,RK,RL)
22 ....S RMVA=$P(RDAT,U,1)
23 ....S RMCOM=$P(RDAT,U,2)
24 ....S RMUSE=$P(RDAT,U,3)
25 ....S RMISU=$P(RDAT,U,4)
26 ....S RMISN=$P(RDAT,U,5)
27 ....S RMAVEN=$P(RDAT,U,6)
28 ....S RMDLEN=$P(RDAT,U,7)
29 ....S RMQOHU=$P(RDAT,U,8)
30 ....S RMQOHN=$P(RDAT,U,9)
31 ....S RMVALU=$P(RDAT,U,10)
32 ....S RMVALN=$P(RDAT,U,11)
33 ....S RMAVEU=$P(RDAT,U,12)
34 ....S RMDLEU=$P(RDAT,U,13)
35 ....;total for GROUP
36 ....S RMTVAG=RMTVAG+RMVA
37 ....S RMTCOMG=RMTCOMG+RMCOM
38 ....S RMTUSEG=RMTUSEG+RMVA+RMCOM
39 ....S RMTISUG=RMTISUG+RMISU
40 ....S RMTISNG=RMTISNG+RMISN
41 ....S RMTDLEG=RMTDLEG+RMDLEU+RMDLEN
42 ....S RMTQOHUG=RMTQOHUG+RMQOHU
43 ....S RMTQOHNG=RMTQOHNG+RMQOHN
44 ....S RMTVALUG=RMTVALUG+RMVALU
45 ....S RMTVALNG=RMTVALNG+RMVALN
46 ....S RMGTOU=RMGTOU+RMVALU
47 ....S RMGTON=RMGTON+RMVALN
48 ....S RMGTIU=RMGTIU+RMISU
49 ....S RMGTIN=RMGTIN+RMISN
50 ....;total for line item
51 ....S RMTVAL=RMTVAL+RMVA
52 ....S RMTCOML=RMTCOML+RMCOM
53 ....I (RMCOM'=""),$G(RMCOM) S RTUSELC=RTUSELC+RMCOM
54 ....I (RMVA'=""),$G(RMVA) S RTUSELA=RTUSELA+RMVA
55 ....S RMTISUL=RMTISUL+RMISU
56 ....S RMTISNL=RMTISNL+RMISN
57 ....S RMTQOHUL=RMTQOHUL+RMQOHU
58 ....S RMTQOHNL=RMTQOHNL+RMQOHN
59 ....S RMTVALUL=RMTVALUL+RMVALU
60 ....S RMTVALNL=RMTVALNL+RMVALN
61 ....S (RPRINT,RPR)=1
62 ....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 HDRL,LBL1^RMPR5HQ2
63 ....I $Y+8>IOSL,IOST'["C-" W @IOF D HDRL,LBL1^RMPR5HQ2
64 Q
65 ;
66HDRL ;print heading.
67 Q:$G(RFL)
68 S RMPAGE=RMPAGE+1
69 W !,"PROSTHETIC INVENTORY NPPD GROUP/LINE REPORT",?55,"Run Date: ",RMRDATE,?100,"Page: ",RMPAGE
70 W !,"STATION: ",$E(RSTN,1,20)
71 W ?32,RMBD," - ",RMED," [ ",RMCALDAY," calendar days ]"
72 Q
73 ;
74GLN1 ;print NPPD GROUP and LINE header.
75 Q:$G(RFL)
76 W !!,RNPGRP
77 D LBL1^RMPR5HQ2
78 Q
79SUML1 ;
80 Q:$G(RFL)
81 W !,RLINE," ",RNPLINE
82 S:$G(RTUSELA) RTAVELA=RTUSELA/RMCALDAY
83 S:$G(RTUSELC) RTAVELC=RTUSELC/RMCALDAY
84 S:$G(RTUSELA) RTDLELA=RMTQOHUL/RTAVELA
85 S:$G(RTUSELC) RTDLELC=RMTQOHNL/RTAVELC
86 S RTDLELA=$S(RTDLELA>999:">999",1:$J(RTDLELA,5,0))
87 S RTDLELC=$S(RTDLELC>999:">999",1:$J(RTDLELC,5,0))
88 S:RMTQOHNL=0 RTDLELC=""
89 S:RMTQOHUL=0 RTDLELA=""
90 S:(RMTQOHNL>0)&(RMTCOML<1) RTDLELC=">"_RMCALDAY
91 S:(RMTQOHUL>0)&(RMTVAL<1) RTDLELA=">"_RMCALDAY
92 S RMTAVEG=RTAVELA+RTAVELC
93 ;next 2 lines for used:
94 W !,?5,"(Used)",?26,$J(RMTVAL,5),?34,$J($FN(RMTISUL,",",2),6),?40,"|",?59,"|",?60,$J(RTUSELA,5),?67,"|",?71,$J(RTAVELA,5,2),?78,"|"
95 W ?81,$J(RMTQOHUL,5),?94,"|",?97,$J(RTDLELA,6),?103,"|",?103,$J($FN(RMTVALUL,",",2),11)
96 ;next 2 lines for new:
97 W !,?5,"(New)",?40,"|",?41,$J(RMTCOML,4),?49,$J($FN(RMTISNL,",",2),9),?59,"|",?60,$J(RTUSELC,5),?67,"|",?71,$J(RTAVELC,5,2),?78,"|"
98 W ?87,$J(RMTQOHNL,6),?94,"|",?97,$J(RTDLELC,6),?103,"|",?116,$J($FN(RMTVALNL,",",2),11)
99 ;
100 S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSEL,RMTAVEL,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL)=0
101 S (RTUSELA,RTUSELC,RTDLELA,RTDLELC,RTAVELA,RTAVELC)=0
102 S (RNPLINE,RLINE)=""
103 Q
104 ;
105SUMG1 ;print summary total for NPPD GROUP
106 Q:$G(RFL)
107 W !,REQ
108 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,"|"
109 W ?81,$J(RMTQOHUG,5),?87,$J(RMTQOHNG,6),?94,"|",?103,"|",?104,$J($FN(RMTVALUG,",",2),11),?116,$J($FN(RMTVALNG,",",2),11)
110 S (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RMTUSEG,RMTAVEG,RMTQOHUG,RMTQOHNG,RMTVALUG,RMTVALNG,RLCNT)=0
111 S (RNPGRP,RGRP)=""
112 Q
113STN(RST) ;STATION FUNCTION
114 N Y,RS
115 S RS=$O(^RMPR(669.9,"C",RST,0)),Y=$P(^RMPR(669.9,RS,0),U,1)
116 Q Y
Note: See TracBrowser for help on using the repository browser.