source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5HQB.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1RMPR5HQB ;HCIOFO/RVD - HCPCS USAGE REPORT FOR HQ ; 06 OCT 00
2 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
3 ;
4DQ1 ;process PIP HPCPC Report and e-mail to PSAS HQ.
5 ;
6 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
7 .D:RPR=0 HDRH
8 .S RNPGRP=RMARRAY(RI)
9 .S RJ=""
10 .F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) D:(RLINE'="")&(RLINE'=RJ) SUML1^RMPR5HQA Q:RJ="" D
11 ..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
12 ..I RGCNT=0 S RGCNT=RGCNT+1
13 ..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
14 ...S RHCPC=RK
15 ...S RL=""
16 ...F S RL=$O(^TMP($J,R5,RST,RI,RJ,RK,RL)) Q:$G(RFL)!(RL="") D
17 ....S RHCPC=$P(RK,"/",1)
18 ....S RMHCDA=$P(RK,"/",2)
19 ....S RNPITEM=$P($G(^RMPR(661.1,RMHCDA,0)),U,2)
20 ....I RLCNT=0 D GLN1
21 ....S RLCNT=RLCNT+1
22 ....S RDAT=^TMP($J,R5,RST,RI,RJ,RK,RL)
23 ....S RMVA=$P(RDAT,U,1)
24 ....S RMCOM=$P(RDAT,U,2)
25 ....S RMUSE=$P(RDAT,U,3)
26 ....S RMISU=$P(RDAT,U,4)
27 ....S RMISN=$P(RDAT,U,5)
28 ....S RMAVEN=$P(RDAT,U,6)
29 ....S RMDLEN=$J($P(RDAT,U,7),5,2)
30 ....S RMQOHU=$P(RDAT,U,8)
31 ....S RMQOHN=$P(RDAT,U,9)
32 ....S RMVALU=$P(RDAT,U,10)
33 ....S RMVALN=$P(RDAT,U,11)
34 ....S RMAVEU=$P(RDAT,U,12)
35 ....S RMDLEU=$J($P(RDAT,U,13),5,2)
36 ....;total for HCPCS
37 ....S RMTVAH=RMTVAH+RMVA
38 ....S RMTCOMH=RMTCOMH+RMCOM
39 ....S RMTISUH=RMTISUH+RMISU
40 ....S RMTISNH=RMTISNH+RMISN
41 ....I (RMCOM'=""),$G(RMCOM) S RTUSEHC=RTUSEHC+RMCOM
42 ....I (RMVA'=""),$G(RMVA) S RTUSEHA=RTUSEHA+RMVA
43 ....S RMTQOHUH=RMTQOHUH+RMQOHU
44 ....S RMTQOHNH=RMTQOHNH+RMQOHN
45 ....S RMTVALUH=RMTVALUH+RMVALU
46 ....S RMTVALNH=RMTVALNH+RMVALN
47 ....S RMGTOU=RMGTOU+RMVALU
48 ....S RMGTON=RMGTON+RMVALN
49 ....S RMGTIU=RMGTIU+RMISU
50 ....S RMGTIN=RMGTIN+RMISN
51 ....;total for line item
52 ....S RMTVAL=RMTVAL+RMVA
53 ....S RMTCOML=RMTCOML+RMCOM
54 ....S:RMVA'="" RMTUSELU=RMTUSELU+RMVA
55 ....S:RMCOM'="" RMTUSELN=RMTUSELN+RMCOM
56 ....S RMTISUL=RMTISUL+RMISU
57 ....S RMTAVELU=RMTAVELU+RMAVEU
58 ....S RMTAVELN=RMTAVELN+RMAVEN
59 ....S RMTDLEL=RMTDLEL+RMDLEU+RMDLEN
60 ....S RMTISNL=RMTISNL+RMISN
61 ....S RMTQOHUL=RMTQOHUL+RMQOHU
62 ....S RMTQOHNL=RMTQOHNL+RMQOHN
63 ....S RMTVALUL=RMTVALUL+RMVALU
64 ....S RMTVALNL=RMTVALNL+RMVALN
65 ....S (RPRINT,RPR)=1
66 Q
67 ;
68HDRH ;print heading.
69 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
70 I RPR=1 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RES
71 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
72 S RPR=1
73 S RSTN=$$STN^RMPR5HQC(RSTA)
74 D CNTRX^RMPR5HQA
75 S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY HCPCS SUMMARY REPORT"_RB10_"Run Date: "_RMRDATE
76 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="STATION: "_$E(RSTN,1,30)_RB6_RMBD_"- "_RMED_" [ "_RMCALDAY_" calendar days ]"
77 Q
78 ;
79GLN1 ;print NPPD GROUP and LINE header.
80 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=""
81 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RJ_" "_RNPLINE_" ["_RNPGRP_" ]"
82 D LBL1^RMPR5HQA
83 Q
84 ;
85SUMH1 ;
86 S:$G(RTUSEHC) RTAVEHC=RTUSEHC/RMCALDAY
87 S:$G(RTAVEHC) RTDLEHC=RMTQOHNH/RTAVEHC
88 S:$G(RTUSEHA) RTAVEHA=RTUSEHA/RMCALDAY
89 S:$G(RTAVEHA) RTDLEHA=RMTQOHUH/RTAVEHA
90 S RTDLEHA=$S(RTDLEHA>999:">999",1:$J(RTDLEHA,6,0))
91 S RTDLEHC=$S(RTDLEHC>999:">999",1:$J(RTDLEHC,6,0))
92 S:RMTQOHNH=0 RTDLEHC=""
93 S:RMTQOHUH=0 RTDLEHA=""
94 S:(RMTQOHNH>0)&(RMTCOMH<1) RTDLEHC=">"_RMCALDAY
95 S:(RMTQOHUH>0)&(RMTVAH<1) RTDLEHA=">"_RMCALDAY
96 S RMTAVEL=RTAVEHA+RTAVEHC
97 S RNPITEM=RNPITEM_" "
98 S RHCPC=RHCPC_" "
99 D CNTRX^RMPR5HQA
100 ;next two lines for Used.
101 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_"|"
102 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)
103 ;next two lines print new total
104 D CNTRX^RMPR5HQA
105 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_"|"
106 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)
107 ;
108 S RPR=1
109 S (RMTVAH,RMTISUH,RMTCOMH,RMTISNH,RMTUSEH,RMTAVEH,RMTQOHUH,RMTQOHNH,RMTVALUH,RMTVALNH,RHCNT)=0
110 S (RTUSEHA,RTUSEHC,RTDLEHA,RTDLEHC,RTAVEHA,RTAVEHC)=0
111 Q
Note: See TracBrowser for help on using the repository browser.