source: FOIAVistA/trunk/r/PAID-PRS/PRSPESR2.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: 7.5 KB
Line 
1PRSPESR2 ;WOIFO/JAH - PTP ESR Edit-Calls from ScreenMan Form ;07/28/05
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5ELAPSE(MEAL,START,STOP) ; CALCULATE THE HOURS BETWEEN 2 TIMES
6 ;this function is called from ScreenMan Form Computed fields
7 ; file 458 PRSA ESR EDIT form.
8 N ELAPSE
9 S ELAPSE=0
10 Q:($G(START)="")!($G(STOP)="") ELAPSE
11 S START=$$TWENTY4(START)
12 ;
13 S STOP=$$TWENTY4(STOP)
14 ; if stop time is next day add a day
15 I STOP<START!(STOP=START) D
16 . S STOP=$$FMADD^XLFDT(DT,1,0,0,0)_"."_STOP
17 E D
18 . S STOP=DT_"."_STOP
19 S START=DT_"."_START
20 S ELAPSE=$$FMDIFF^XLFDT(STOP,START,3)
21 ;for special case of a 24 hour segment
22 I ELAPSE="1" S ELAPSE="24:00"
23 ;
24 ;Remove any blanks
25 S ELAPSE=$TR(ELAPSE," ","")
26 I $G(MEAL)>0 S ELAPSE=$$MEALESS(ELAPSE,MEAL)
27 S ELAPSE=$$FIVE(ELAPSE)
28 Q ELAPSE
29FIVE(TIME) ;ENSURE ELAPSE IS A FIVE CHAR STRING--04:15 OR 02:00
30 N FIVE,HH,MM
31 I $E(TIME,1,1)="-" Q "-00:00"
32 S HH="00"_$P(TIME,":"),MM="00"_$P(TIME,":",2)
33 S HH=$E(HH,$L(HH)-1,$L(HH))
34 S MM=$E(MM,$L(MM)-1,$L(MM))
35 S MM=$P(TIME,":",2)_"0"
36 S MM=$E(MM,1,2)
37 S FIVE=HH_":"_MM
38 Q FIVE
39TWENTY4(TIME) ;CONVERT TIME TO TWENTY FOUR HOUR TIME
40 ;
41 ; TIME Y: 0=Mid=0,1=Mid=2400 Output: Y=time in 2400
42 S Y=0
43 I TIME="MID"!(TIME="NOON") D
44 . S Y=$S(TIME="NOON":1200,TIME="MID":2400,1:0)
45 E D
46 . S Y=$P(TIME,":",1)_$P(TIME,":",2),Y=+Y
47 I TIME["P" D
48 . S:Y<1200 Y=Y+1200
49 ;
50 ; pad time with leading zeros so we always have 4 digits
51 ; for cases like start times of 15 past midnight 0015
52 ;
53 S Y="000"_Y
54 S Y=$E(Y,$L(Y)-3,$L(Y))
55 Q Y
56MEALESS(HHMM,MEAL) ;Remove meal time from hours total
57 ; (subtract a 15 minute increment from length of time
58 ; in hh:mm format, i.e. hh:mm - mm
59 ;
60 N X,Y,DECR,OBJ,I
61 S MM=$P(HHMM,":",2) ; get minutes
62 ; quit minutes or meal not quarter hours
63 Q:(MM#15'=0&(+MM)!((MEAL#15)'=0&(+MEAL))) HHMM
64 ; get hours
65 S HH=$P(HHMM,":")
66 ;
67 ; convert segment minutes and meal to a digit.
68 ;
69 S X=MM D MEALIN S OBJ=X
70 S X=$G(MEAL) D MEALIN S DECR=X
71 I OBJ=0 S OBJ=4
72 F I=1:1:DECR D
73 . I OBJ=4 S HH="0"_(+HH-1) S HH=$E(HH,$L(HH)-1,$L(HH))
74 . S OBJ=$S(OBJ=4:3,OBJ=3:2,OBJ=2:1,OBJ=1:4)
75 S MM=$S(OBJ=1:15,OBJ=2:30,OBJ=3:45,1:"00")
76 Q $$FIVE(HH_":"_MM)
77 ;
78MEALIN ;convert 15 minute meal to a digit
79 I +X#15=0 S X=X\15 Q
80 I "^0^00^15^30^45^60^75^90^105^120^"[("^"_$G(X)_"^") D
81 . S X=$S(+X=0:0,X=60:4,X=30:2,X=15:1,X=45:3,1:0)
82 E D
83 . K X
84 Q
85MEALOUT ; convert meal digit to minutes
86 S Y=$S(Y=1:15,Y=2:30,Y=3:45,Y=4:60,1:"00")
87 Q
88 ;
89VALIDTT ; Set DDSERROR if not a valid type of time.
90 ;This procedure is called from ScreenMan form PRSA ESR EDIT (file 458)
91 ;with the validate field of the Type Of Time.
92 ; set DDSERROR to reject user input, then ring bell and
93 ; display a message reject explanation
94 Q:X=""!($G(PPI)'>0)!($G(PRSIEN)'>0)!($G(PRSD)'>0)
95 I "^RG^AL^AA^DL^ML^RL^CP^SL^HX^CB^AD^WP^TR^TV^"'[(U_X_U) D
96 . S DDSERROR=1
97 . D HLP^DDSUTL("Invalid type of time.")
98 I "^HX^"[(U_X_U) D
99 . I $P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",12)'>0 S DDSERROR=1 D HLP^DDSUTL("Holiday Excused is only allowed on a Holiday Benefit Day. See Payroll to set this day as a holiday.")
100 I $G(PPI),$G(PRSD),$P(^PRST(458,PPI,1),U,PRSD)>$G(DT) D
101 . I "^AL^AA^DL^ML^RL^CP^SL^HX^CB^AD^WP^TR^TV^"'[(U_X_U) D
102 .. S DDSERROR=1
103 .. D HLP^DDSUTL("Invalid type of time. Only leave may be entered on future days")
104 Q
105VALIDLV(SSCH,SPST) ; Set DDSERROR if any posting is outside the
106 ; tour time segements inappropriately
107 ;
108 ;INPUT:
109 ; SSCH : tour segments as scheduled from node 1 of the day multiple
110 ; SPST : tour segments as posted by ptp in T array format
111 N OK,P1,P2,S1,S2,LV,I,I2,J,MSA,VALIDLV
112 S (LV,OK,I)=0
113 S VALIDLV=""
114 ; put tour in similar format as posting
115 D MARRAY(.MSA,SSCH)
116 F S I=$O(SPST(I)) Q:I'>0!(LV&'OK) D
117 . S P1=I,I2=$O(SPST(I,0)),P2=$P(SPST(I,I2),U)
118 . Q:"^AL^AA^DL^CU^ML^RL^HX^SL^CB^AD^WP^TV^TR^"'[$P(SPST(I,I2),U,4)
119 . S LV=1,OK=0
120 . S J=0
121 . F S J=$O(MSA(J)) Q:J'>0!OK D
122 .. S S1=J,S2=$O(MSA(J,0)),S2=$P(MSA(J,S2),U)
123 .. I P1=S1!(P1>S1)&((P2=S2)!(P2<S2)) S OK=1
124 ;
125 I LV,('OK) S VALIDLV=1
126 Q VALIDLV
127 ;
128MARRAY(MARRAY,SEGS) ; BUILD MINUTE ARRAY
129 ; INPUT : SEGS--tour of duty segments in global format
130 ; OUTPUT: MARRAY--array by reference of tour segments in minutes
131 ; from midnight format
132 ; EXAMPLE:
133 ; 2 segment tour will look like the following:
134 ; MARRAY(945,1)=1140^03:45P^07:00P
135 ; MARRAY(1140,6)=1305^07:00P^09:45P
136 ; MARRAY(1320,11)=1380^10:00P^11:00P
137 ;loop thru the 5 columns of the 7 time segments on ESR
138 ; quit if we encounter an error
139 ;
140 N I,ANY,Z1,Z2,X,Y
141 S ANY=1
142 F I=1:3:21 Q:('ANY) D
143 . ;
144 . ;if absolutely nothing on the segment then we're done
145 . S ANY=$L($P(SEGS,U,I)_$P(SEGS,U,I+1)_$P(SEGS,U,I+2))
146 . Q:'ANY
147 . S X=$P(SEGS,U,I)_U_$P(SEGS,U,I+1)
148 . D CNV^PRSATIM S Z1=$P(Y,U,1),Z2=$P(Y,U,2)
149 . D V0^PRSATP1
150 . S MARRAY(Z1,I)=Z2_U_$P(SEGS,U,I,I+2)
151 Q
152PSTML(ROW) ; AUTO POST MEAL TIME
153 ; if the time segment row that we are on in a form covers
154 ; the tour then post a meal.
155 ; ROW - is passed as the
156 ; Z is in the form of NODE 5 in the 458.02 day mult
157 ; it changes with edits on the form
158 ; like Z=09:00A^NOON^RG^^30^NOON^08:00P^RG^^^08:00P^MID^CU^15
159 ;
160 N RNG,ST2SP,FLDNUM,BASE
161 Q:$G(PRSML)=""!($G(PRSML)=0)
162 ;
163 S BASE=ROW-1*5
164 ; quit if something is already in mealtime on the form
165 Q:$P(Z,U,BASE+5)'=""
166 ; compute the field number of the meal time for this row
167 S FLDNUM=BASE+114
168 ; get the start TO stop segments for this row of the form
169 ; if it's an exact match then auto post the meal
170 S ST2SP=$P(Z,U,BASE+1,BASE+2)
171 I ST2SP=$P($G(PRSN1),U,1,2) D Q
172 . D PUT^DDSVAL(DIE,.DA,FLDNUM,PRSML)
173 . D REFRESH^DDSUTL
174 ; get the start TO stop segments for this row of the form
175 ; if it covers the meal and then some autopost the meal
176 N DY2,TWO,SCHED,POST,SCH,P1,P2,S1,S2
177 ; TOD is a global set up in form start up in ESRFRM^PRSPESR1
178 S ST2SP=$P(Z,U,BASE+1,BASE+3)
179 S SCHED=$P($G(PRSN1),U,1,3)
180 ; is this a two day tour? need to check before calling the
181 ; code to set up the minutes array in MARRAY
182 S TWO=$P($G(^PRST(457.1,+TOD,0)),U,5)
183 S DY2=TWO="Y"
184 D MARRAY(.POST,ST2SP)
185 D MARRAY(.SCH,$P($G(PRSN1),U,1,3))
186 ;get start and stop time minutes form midnight for both
187 ; schedule and posting to determine if meal should be autoposted
188 S P1=$O(POST(0))
189 Q:P1'>0
190 S P2=$P(POST(P1,1),U)
191 Q:P2'>0
192 S S1=$O(SCH(0))
193 Q:S1'>0
194 S S2=$P(SCH(S1,1),U)
195 Q:22'>0
196 I P1'>S1&(P2'<S2) D
197 . D PUT^DDSVAL(DIE,.DA,FLDNUM,PRSML)
198 . D REFRESH^DDSUTL
199 . S $P(Z,U,BASE+5)=PRSML
200 Q
201 ;
202OVEREAT(ROW) ; Display warning on POST ACTION ON CHANGE for the
203 ; meal field on the form if lunch more than allotted for tour
204 N MTOT,K,BASE,WORK,STR,PRSZ
205 ; When X is null they are trying to delete and that's always ok
206 Q:$G(Z)=""!($G(ROW)'>0)!($G(X)="")
207 S BASE=ROW-1*5
208 ;
209 S WORK=$$ELAPSE^PRSPESR2(X,$P(Z,U,BASE+1),$P(Z,U,BASE+2))
210 I $E(WORK,1,1)="-"!(WORK="00:00")!(WORK=0) D Q
211 . S DDSERROR=1
212 . S STR="Meal time greater than or equal to time segment."
213 . I X=0 S STR=STR_" Type @ to remove meal time."
214 . D HLP^DDSUTL(STR)
215 S MTOT=0
216 S PRSZ=Z S $P(PRSZ,U,BASE+5)=X
217 F K=1:5:31 S MTOT=MTOT+$P(PRSZ,U,K+4)
218 I MTOT>($G(PRSML)+$G(PRSML2)) D
219 . S STR="Warning: More meal time than allotted with tour."
220 . D HLP^DDSUTL(.STR)
221 Q
222BURP(PRSN5) ; return ESR WORK NODE with no blank pieces
223 ; PRSN5--esr work node $G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)
224 ; if there's only a meal with a zero then skip that too.
225 ;^^^^^NOON^08:00P^RG^^^08:00P^MID^CU^15
226 ;
227 N SN,I,TSEG
228 S SN=""
229 F I=1:5:31 D
230 . S TSEG=$P(PRSN5,U,I,I+4)
231 .; W !,I,": ",TSEG
232 . Q:TSEG="^^^^"!(TSEG="")!(TSEG="^^^^0")
233 . S SN=SN_TSEG_"^"
234 Q SN
Note: See TracBrowser for help on using the repository browser.