source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5HQD.m@ 1700

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1RMPR5HQD ;HCIOFO/RVD - NPPD GROUP USAGE REPORT FOR HQ ; 06 OCT 00
2 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
3 ;
4 ; HNC - added grand totals
5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6DQ1 ;print PIP Report
7 F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 D:(RSTA'="")&(RSTA'=RST)&(RPR=1) HDRG S RSTA=RST F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) Q:$G(RFL) D:(RGRP'="")&(RGRP'=RI) SUMG1 Q:RI'>0 D
8 .D:RPR=0 HDRG
9 .S RGRP=RI
10 .S RNPGRP=RMARRAY(RI)
11 .S RJ=""
12 .F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) Q:RJ="" D
13 ..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
14 ..S RK="" F S RK=$O(^TMP($J,R5,RST,RI,RJ,RK)) Q:$G(RFL)!(RK="") D
15 ...S RL=""
16 ...F S RL=$O(^TMP($J,R5,RST,RI,RJ,RK,RL)) Q:$G(RFL)!(RL="") D
17 ....I RLCNT=0 D GLN1
18 ....S RLCNT=RLCNT+1
19 ....S RDAT=^TMP($J,R5,RST,RI,RJ,RK,RL)
20 ....S RMVA=$P(RDAT,U,1)
21 ....S RMCOM=$P(RDAT,U,2)
22 ....S RMUSE=$P(RDAT,U,3)
23 ....S RMISU=$P(RDAT,U,4)
24 ....S RMISN=$P(RDAT,U,5)
25 ....S RMAVEN=$P(RDAT,U,6)
26 ....S RMDLEN=$J($P(RDAT,U,7),5,2)
27 ....S RMQOHU=$P(RDAT,U,8)
28 ....S RMQOHN=$P(RDAT,U,9)
29 ....S RMVALU=$P(RDAT,U,10)
30 ....S RMVALN=$P(RDAT,U,11)
31 ....S RMAVEU=$P(RDAT,U,12)
32 ....S RMDLEU=$J($P(RDAT,U,13),5,2)
33 ....S RMGISUG=RMGISUG+RMISU
34 ....S RMGISNG=RMGISNG+RMISN
35 ....;
36 ....S RMGTIU=RMGTIU+RMISU
37 ....S RMGTIN=RMGTIN+RMISN
38 ....;
39 ....S RMGTOU=RMGTOU+RMVALU
40 ....S RMGTON=RMGTON+RMVALN
41 ....;total for GROUP
42 ....I (RMCOM'=""),$G(RMCOM) S RTUSEGC=RTUSEGC+RMCOM
43 ....I (RMVA'=""),$G(RMVA) S RTUSEGA=RTUSEGA+RMVA
44 ....S RMTVAG=RMTVAG+RMVA
45 ....S RMTCOMG=RMTCOMG+RMCOM
46 ....S RMTISUG=RMTISUG+RMISU
47 ....S RMTISNG=RMTISNG+RMISN
48 ....S RMTQOHUG=RMTQOHUG+RMQOHU
49 ....S RMTQOHNG=RMTQOHNG+RMQOHN
50 ....S RMTVALUG=RMTVALUG+RMVALU
51 ....S RMTVALNG=RMTVALNG+RMVALN
52 ....S (RPRINT,RPR)=1
53 ;
54 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
55 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=REQ
56 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
57 I '$G(RPRINT) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="No Records to Print !!" Q
58 D CNTRX^RMPR5HQA
59 S ^TMP($J,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (Used) = $"_$J($FN(RMGTIU,",",2),10)
60 S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (Used) = $"_$J($FN(RMGTOU,",",2),12)
61 D CNTRX^RMPR5HQA
62 S ^TMP($J,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (New) = $"_$J($FN(RMGTIN,",",2),10)
63 S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (New) = $"_$J($FN(RMGTON,",",2),12)
64 S RMGTOT=RMGTOU+RMGTON
65 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
66 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RB30_RB30_"GRAND TOTAL $ VALUE ON-HAND = "_"$"_$J($FN(RMGTOT,",",2),12)
67 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="<End of Report>"
68 Q
69 ;
70HDRG ;print heading.
71 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
72 I RPR=1 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RES
73 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
74 S RPR=1
75 S RSTN=$$STN^RMPR5HQC(RSTA)
76 D CNTRX^RMPR5HQA
77 S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY NPPD GROUP REPORT"_RB10_"Run Date: "_RMRDATE
78 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="STATION: "_$E(RSTN,1,30)_RB6_RMBD_"- "_RMED_" [ "_RMCALDAY_" calendar days ]"
79 Q
80 ;
81GLN1 ;print NPPD GROUP and LINE header.
82 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
83 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
84 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="ENTIRE SUMMARY"
85 D LBL1^RMPR5HQA
86 Q
87 ;
88SUMG1 ;print summary total for NPPD GROUP
89 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RLN
90 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RGRP_RB1_RNPGRP
91 S:$G(RTUSEGA) RTAVEGA=RTUSEGA/RMCALDAY
92 S:$G(RTUSEGC) RTAVEGC=RTUSEGC/RMCALDAY
93 S:$G(RTUSEGA) RTDLEGA=RMTQOHUG/RTAVEGA
94 S:$G(RTUSEGC) RTDLEGC=RMTQOHNG/RTAVEGC
95 S RTDLEGA=$S(RTDLEGA>999:">999",1:$J(RTDLEGA,6,0))
96 S RTDLEGC=$S(RTDLEGC>999:">999",1:$J(RTDLEGC,6,0))
97 S:RMTQOHNG=0 RTDLEGC=""
98 S:RMTQOHUG=0 RTDLEGA=""
99 S:(RMTQOHNG>0)&(RMTCOMG<1) RTDLEGC=">"_RMCALDAY
100 S:(RMTQOHUG>0)&(RMTVAG<1) RTDLEGA=">"_RMCALDAY
101 ;
102 D CNTRX^RMPR5HQA
103 S ^TMP($J,"RI",RC)=" (Used)"_RB13_$J(RMTVAG,5)_RB1_$J($FN(RMTISUG,",",2),9)_RB1_"|"_RB18_"|"_RB1_$J(RTUSEGA,5)_RB1_"|"_RB1_$J(RTAVEGA,8,2)_RB1_"|"
104 S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUG,6)_RB8_"|"_RB1_$J(RTDLEGA,6)_RB1_"|"_RB1_$J($FN(RMTVALUL,",",2),11)
105 ;next line for NEW
106 D CNTRX^RMPR5HQA
107 S ^TMP($J,"RI",RC)=" (New)"_RB30_"|"_RB1_$J(RMTCOMG,6)_RB1_$J($FN(RMTISNG,",",2),9)_RB1_"|"_RB1_$J(RTUSEGC,5)_RB1_"|"_RB1_$J(RTAVEGC,8,2)_RB1_"|"
108 S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB6_$J(RMTQOHNG,8)_RB1_"|"_RB1_$J(RTDLEGC,6)_RB1_"|"_RB11_$J($FN(RMTVALNG,",",2),11)
109 ;
110 S (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RTUSEGA,RTUSEGC,RTAVEGA,RTAVEGC,RMTQOHUG,RMTQOHNG,RTDLEGA,RTDLEGC,RMTVALUG,RMTVALNG)=0
111 S (RNPGRP,RGRP)=""
112 Q
Note: See TracBrowser for help on using the repository browser.