| 1 | PRSPESR2 ;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
|
|---|
| 5 | ELAPSE(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
|
|---|
| 29 | FIVE(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
|
|---|
| 39 | TWENTY4(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
|
|---|
| 56 | MEALESS(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 | ;
|
|---|
| 78 | MEALIN ;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
|
|---|
| 85 | MEALOUT ; 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 | ;
|
|---|
| 89 | VALIDTT ; 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
|
|---|
| 105 | VALIDLV(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 | ;
|
|---|
| 128 | MARRAY(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
|
|---|
| 152 | PSTML(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 | ;
|
|---|
| 202 | OVEREAT(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
|
|---|
| 222 | BURP(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
|
|---|
