source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9PU.m@ 702

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

initial load of WorldVistAEHR
File size: 8.1 KB
Line 
1RMPR9PU ;HOIFO/HNC/SPS - PURCHASE ORDER CONROL PROCESSING-REMOTE PROCEDURE ;9/8/03 07:12
2 ;;3.0;PROSTHETICS;**75,60**;Feb 09, 1996;Build 18
3 ;
4 ;CLONED AND EDITED FROM RMPR9DO TO SEPERATE DELAYED ORDER REPORT
5 ;
6EN(RESULT,DUZ,START,STOP,SITE,SORT,DATE,RMPRPRSN) ; -- Broker callback to get list to display
7 ;entry to send to PCM, WHAT=ALL or S for Summary Only
8 ;RMPRPRSN=P for Purchasing D for Delayed Order Report
9 S (WHO,RMPRSC)=""
10 I RMPRPRSN="P" S RMPRSC=$O(^RMPR(669.9,"PA",DUZ,RMPRSC)) Q:(RMPRSC="")!(WHO'="") D
11 . I '$D(^RMPR(669.9,RMPRSC,0)) Q
12 . I '$D(^RMPR(669.9,RMPRSC,5,"B",DUZ)) Q
13 . S WHO=$O(^RMPR(669.9,RMPRSC,5,"B",DUZ,""))
14 . I START="" S START=$P(^RMPR(669.9,RMPRSC,5,WHO,0),U,2)
15 . I STOP="" S STOP=$P(^RMPR(669.9,RMPRSC,5,WHO,0),U,3)
16A2 N STRING,CLREND,COLUMN,ON,OFF
17 Q:SORT=""
18 Q:DATE=""
19 Q:START=""
20 Q:STOP=""
21 Q:SITE=""
22 I SITE'="ALL" S SITE=$P(^RMPR(669.9,SITE,0),U,2)
23 K ^TMP($J)
24 N RMPRA,CDATE,X
25 K ADATE,PDAY,RMPRCD
26 S VALMCNT=0,RRX=""
27 ;if sort for open or pending include all regardless of date
28 ;if sort for cancelled or closed include from date passed forward
29 ;
30 ;PPD# status=pending before date, total days create to 1st action
31 ;MHD# manual totals days create to 1st action
32 ;CHD# consult totals days create to 1st action
33 ;PPDD# status=pending before date, total days in pending state, 1st
34 ; action to current date
35 ;
36 S (LINE,MHD1,MHD2,MHD3,MHD4,MHD5,CHD1,CHD2,CHD3,CHD4,CHD5,CLNK,MLNK)=0
37 S (PPDAY,PPD,PPD1,PPD2,PPD3,PPD4,PPD5)=0
38 S (PPDDAY,PPDD1,PPDD2,PPDD3,PPDD4,PPDD5)=0
39 I SORT["O"!(SORT["P") D ALL
40 I SORT["C"!(SORT["X") D DTFWD
41 S ^TMP($J,"A1")="^^^^^^^^"_MHD1_U_MHD2_U_MHD3_U_MHD4_U_MHD5_"^^^^"_MLNK_U_0
42 S ^TMP($J,"A2")="^^^^^^^^"_CHD1_U_CHD2_U_CHD3_U_CHD4_U_CHD5_"^^^^"_CLNK_U_1
43 S ^TMP($J,"A3")="^^^^^^^^"_PPDD1_U_PPDD2_U_PPDD3_U_PPDD4_U_PPDD5_"^^^^^"_2
44 S ^TMP($J,"A4")="^^^^^^^^"_PPD1_U_PPD2_U_PPD3_U_PPD4_U_PPD5_"^^^^^"_3
45 G EXIT
46 Q
47ALL ;all open pending records regardless of date passed
48 S RMPRI1=0
49 F RMPRI1=START:1:STOP D
50 .I $L(RMPRI1)=1 S RMPRI=0_RMPRI1
51 .E S RMPRI=RMPRI1
52 .S RMPRST=""
53 .F S RMPRST=$O(^RMPR(668,"L1",RMPRI,RMPRST)) Q:RMPRST="" D
54 . .Q:RMPRST="X"
55 . .Q:RMPRST="C"
56 . .I SORT'["P"&(RMPRST="P") Q
57 . .S RMPRA=0
58 . .F S RMPRA=$O(^RMPR(668,"L1",RMPRI,RMPRST,RMPRA)) Q:RMPRA'>0 D
59 . . .S STN=$P(^RMPR(668,RMPRA,0),U,7)
60 . . .I SITE'="ALL"&(SITE'=STN) Q
61 . . .S STNX=$$STATN^RMPRUTIL(STN)
62 . . .I $G(WHAT)="S" S VISNX=$P($G(^RMPR(669.9,STN1,"INV")),U,2)
63 . . .S STS=$P(^RMPR(668,RMPRA,0),U,10)
64 . . .Q:STS["X"
65 . . .Q:STS["C"
66 . . .I SORT'["O"&(STS="O") Q
67 . . .I SORT'["P"&(STS="P") Q
68 . . .D REC
69 Q
70DTFWD ;from date passed forward
71 S RMPRI1=0
72 F RMPRI1=START:1:STOP D
73 .I $L(RMPRI1)=1 S RMPRI=0_RMPRI1
74 .E S RMPRI=RMPRI1
75 .S RMPRDTM=""
76 .F S RMPRDTM=$O(^RMPR(668,"L",RMPRI,RMPRDTM)) Q:RMPRDTM="" D
77 ..Q:RMPRDTM=""
78 ..Q:RMPRDTM<DATE
79 ..S RMPRST=""
80 ..F S RMPRST=$O(^RMPR(668,"L",RMPRI,RMPRDTM,RMPRST)) Q:RMPRST="" D
81 .. .Q:RMPRST="O"
82 .. .Q:RMPRST="P"
83 .. .I SORT'["X"&(RMPRST="X") Q
84 .. .I SORT'["C"&(RMPRST="C") Q
85 .. .S RMPRA=0
86 .. .F S RMPRA=$O(^RMPR(668,"L",RMPRI,RMPRDTM,RMPRST,RMPRA)) Q:RMPRA'>0 D
87 .. . .Q:RMPRA=""
88 .. . .S STN=$P(^RMPR(668,RMPRA,0),U,7)
89 .. . .I SITE'="ALL"&(SITE'=STN) Q
90 .. . .S STNX=$$STATN^RMPRUTIL(STN)
91 .. . .I $G(WHAT)'="" S VISNX=$P($G(^RMPR(669.9,SITE,"INV")),U,2)
92 .. . .S STS=$P(^RMPR(668,RMPRA,0),U,10)
93 .. . .Q:STS["O"
94 .. . .Q:STS["P"
95 .. . .I SORT'["C"&(STS="C") Q
96 .. . .I SORT'["X"&(STS="X") Q
97 .. . .D REC
98 S RMPRDTC=$P(DATE,".",1)
99 F S RMPRDTC=$O(^RMPR(668,"CD",RMPRDTC)) Q:RMPRDTC="" D
100 .Q:RMPRDTC<DATE
101 .S RMPRDYS=0
102 .F S RMPRDYS=$O(^RMPR(668,"CD",RMPRDTC,RMPRDYS)) Q:RMPRDYS="" D
103 . .Q:RMPRDYS'>5
104 . .S RMPRA=0
105 . .F S RMPRA=$O(^RMPR(668,"CD",RMPRDTC,RMPRDYS,RMPRA)) Q:RMPRA'>0 D
106 . . .;check site
107 . . .S STN=$P(^RMPR(668,RMPRA,0),U,7)
108 . . .I SITE'="ALL"&(SITE'=STN) Q
109 . . .S STNX=$$STATN^RMPRUTIL(STN)
110 . . .;check status
111 . . .S STS=$P(^RMPR(668,RMPRA,0),U,10)
112 . . .I SORT'["O"&(STS="O") Q
113 . . .I SORT'["P"&(STS="P") Q
114 . . .I SORT'["C"&(STS="C") Q
115 . . .I SORT'["X"&(STS="X") Q
116 . . .;ssn range filter
117 . . .S DFN=$P(^RMPR(668,RMPRA,0),U,2)
118 . . .D DEM^VADPT
119 . . .S SSNEN=$E($P(VADM(2),"^",2),10,11)
120 . . .I SSNEN>STOP Q
121 . . .I SSNEN<START Q
122 . . .K SSNEN,VADM
123 . . .D REC
124 Q
125REC ;records to grid
126 ;stop date, init action date
127 ;check ien, patch 77
128 ;
129 Q:$D(^TMP($J,RMPRA))
130 ;
131 N DIC,DIQ,DR,STOPDT
132 S DA=RMPRA
133 S DIC=668,DIQ="RE",DR=10,DIQ(0)="EN" D EN^DIQ1
134 S STOPDT=$P($G(^RMPR(668,RMPRA,0)),U,9),STOPDT=$$DAT2^RMPRUTL1(STOPDT)
135 S LINE=LINE+1
136 S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT2^RMPRUTL1(CDATE)
137 S DFN=$P(^RMPR(668,RMPRA,0),U,2) Q:DFN=""
138 N VA,VADM
139 D DEM^VADPT
140 S WHO=VADM(1)
141 S SSN=VADM(2)
142 D SVC^VADPT
143 S RMPROEOI=$S(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
144 D KVAR^VADPT
145 ; Added line below for OIF/OEF field 15 file 668
146 I RMPROEOI="<!>" S $P(^RMPR(668,RMPRA,7),U,1)=1
147 ;type
148 S TYPE=$$TYPE^RMPREOU(RMPRA,8)
149 ;display description if manual
150 S DES=$$DES^RMPREOU(RMPRA,22)
151 S DES=$TR(DES,"^","*")
152 S DES=$TR(DES,"""","'")
153 ;init action date
154 S ADATE="",PDAY="",WRKDAY=""
155 S ADATE=$P(^RMPR(668,RMPRA,0),U,9)
156 ;PPD=1 for previous pending
157 I ADATE'="" S (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA)
158 I ADATE="" S (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA)
159 I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA)
160 ;
161 S STATUS=$$STATUS^RMPREOU(RMPRA)
162 I STATUS["PENDING" D
163 .I ADATE'=""&(ADATE<DATE) S PPD=1
164 .S PPDAY=$$PWRKDAY^RMPREOU(RMPRA)
165 S LINKED=$P($G(^RMPR(668,RMPRA,10,0)),U,4)
166 I LINKED="" S LINKED=0
167 ;
168 ;If work order get ien of 664.1,WO#,Assigned Tech DUZ
169 S (RMPR6641,RMPRWON)="",RMATECH=""
170 S RMPR6641=$O(^RMPR(664.1,"SUS",RMPRA,0))
171 I +RMPR6641>0 S:$D(^RMPR(664.1,RMPR6641,0)) RMATECH=$P(^RMPR(664.1,RMPR6641,0),U,16),RMPRWON=$P(^(0),U,13)
172 I RMPROEOI="<!>" S WHO=RMPROEOI_WHO
173 S ^TMP($J,RMPRA)=CDATE_U_WHO_U_SSN_U_TYPE_U_DES_U
174 ;look at pday and parse
175 S (HD1,HD2,HD3,HD4,HD5,DH6)=""
176 ;SD Working Days in Pending Status
177 S (SD1,SD2,SD3,SD4,SD5)=0
178 I (PDAY>0)&(PDAY<6)!(PDAY=0) S HD1=PDAY,DH6="NO"
179 I (PPDAY>0)&(PPDAY<6)!(PPDAY=0) S SD1=PPDAY
180 I (PDAY>0)&(PDAY<6)&(TYPE["MANUAL")!(PDAY=0)&(TYPE["MANUAL") S MHD1=MHD1+1
181 I (PDAY>0)&(PDAY<6)&(TYPE'["MANUAL")!(PDAY=0)&(TYPE'["MANUAL") S CHD1=CHD1+1
182 I (PPDAY>0)&(PPDAY<6)&(STATUS["PENDING") S PPDD1=PPDD1+1
183 I (PDAY>0)&(PDAY<6)&(PPD=1) S PPD1=PPD1+1
184 I HD1="" S HD1=0
185 I (PDAY>5)&(PDAY<10) S HD2=PDAY,DH6="YES"
186 I (PPDAY>5)&(PPDAY<10) S SD2=PPDAY
187 I (PDAY>5)&(PDAY<10)&(TYPE["MANUAL") S MHD2=MHD2+1
188 I (PDAY>5)&(PDAY<10)&(TYPE'["MANUAL") S CHD2=CHD2+1
189 I (PPDAY>5)&(PPDAY<10)&(STATUS["PENDING") S PPDD2=PPDD2+1
190 I (PDAY>5)&(PDAY<10)&(PPD=1) S PPD2=PPD2+1
191 I HD2="" S HD2=0
192 I (PDAY>9)&(PDAY<30) S HD3=PDAY,DH6="YES"
193 I (PPDAY>9)&(PPDAY<30) S SD3=PPDAY
194 I (PDAY>9)&(PDAY<30)&(TYPE["MANUAL") S MHD3=MHD3+1
195 I (PDAY>9)&(PDAY<30)&(TYPE'["MANUAL") S CHD3=CHD3+1
196 I (PPDAY>9)&(PPDAY<30)&(STATUS["PENDING") S PPDD3=PPDD3+1
197 I (PDAY>9)&(PDAY<30)&(PPD=1) S PPD3=PPD3+1
198 I HD3="" S HD3=0
199 I (PDAY>29)&(PDAY<90) S HD4=PDAY,DH6="YES"
200 I (PPDAY>29)&(PPDAY<90) S SD4=PPDAY
201 I (PDAY>29)&(PDAY<90)&(TYPE["MANUAL") S MHD4=MHD4+1
202 I (PDAY>29)&(PDAY<90)&(TYPE'["MANUAL") S CHD4=CHD4+1
203 I (PPDAY>29)&(PPDAY<90)&(STATUS["PENDING") S PPDD4=PPDD4+1
204 I (PDAY>29)&(PDAY<90)&(PPD=1) S PPD4=PPD4+1
205 I HD4="" S HD4=0
206 I PDAY>89 S HD5=PDAY,DH6="YES"
207 I PPDAY>89 S SD5=PPDAY
208 I (PDAY>89)&(TYPE["MANUAL") S MHD5=MHD5+1
209 I (PDAY>89)&(TYPE'["MANUAL") S CHD5=CHD5+1
210 I (PPDAY>89)&(STATUS["PENDING") S PPDD5=PPDD5+1
211 I (PDAY>89)&(PPD=1) S PPD5=PPD5+1
212 I HD5="" S HD5=0
213 S (PPD,PPDAY)=0
214 I LINKED'=0&(TYPE["MANUAL") S MLNK=MLNK+1
215 I LINKED'=0&(TYPE'["MANUAL") S CLNK=CLNK+1
216 S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_STOPDT_U_DH6_U_HD1_U_HD2_U_HD3_U_HD4_U_HD5
217 S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_STATUS_U_RMPRA_U_STNX_U_LINKED
218 S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_U_SD1_U_SD2_U_SD3_U_SD4_U_SD5_U_DFN
219 S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_RMPR6641_U_RMPRWON_U_RMATECH
220 K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE
221 ;PUT RESULTS IN GLOBAL!!
222 Q
223 K CDAY,CHD1,CHD2,CHD3,CHD4,CHD5,CLNK,DA,DFN,DH6,HD1,HD2,HD3,HD4,HD5,LINE
224 K LINKED,MHD1,MHD2,MHD3,MHD4,MHD5,MLNK,PPD,PPD1,PPD2,PPD3,PPD4,PPD5
225 K PPDAY,PPDD1,PPDD2,PPDD3,PPDD4,PPDD5,PPDDAY,RMPR6641,RMPRDTC,RMPRDTM
226 K RMPRDYS,RMPRI,RMPRI1,RMPRSC,RMPRST,RMPRWON,RRX,SD1,SD2,SD3,SD4,SD5,STN,STN1,STNX,STS,VALMCNT,VISNX,WHAT,WRKDAY
227EXIT ;common exit point
228 S RESULT=$NA(^TMP($J))
229 Q
Note: See TracBrowser for help on using the repository browser.