Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRSATE.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSATE.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSATE.m
r613 r623 1 PRSATE ;WCIOFO/JAH - Enter/Edit Employee (emp) Tour of Duty (ToD) ;03/15/2005 2 ;;4.0;PAID;**8,11,27,45,55,93,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 N PPI,PPE,PRSTLV,TLI,TLE,DFN 5 ; 6 ; PPI = pay period (pp) internal #. 7 ; PPE = pp external form (99-06). 8 ; PRSTLV = flag indicates timekeeper (TK) in T&L lookup ^PRSAUTL. 9 ; TLI = T&L unit internal #. 10 ; TLU = T&L unit # 3-digit 11 ; 12 ; -Get current pp-internal & external. -Ask user for T&L. 13 ; -Loop to ask for emp until TK is done. 14 ; --Emp lookup screens emps not in T&L returned by PRSAUTL call. 15 ; 16 S PRSTLV=2 D ^PRSAUTL Q:TLI<1 17 F S DFN=$$GETEMP^PRSATE6(TLE) Q:DFN<1 D 18 . S PPI=$P(^PRST(458,0),"^",3),PPE=$P($G(^PRST(458,PPI,0)),"^",1) 19 . D TOUREDIT(DFN,PPI,PPE,TLI,TLE,PRSTLV) 20 Q 21 ;======================= 22 ; 23 TOUREDIT(DFN,PPI,PPE,TLI,TLE,PRSTLV) ; 24 ; 25 N C0,NH,FLX,PMP,PP,PB,ENT,SRT,WTL,TYP,Z,TD,ERROR,NOERROR 26 ; 27 ; Entitlement lookup leaks many variables. Following R used in 28 ; this routine but may be looked up again despite the fact they R 29 ; leaked by ^PRSAENT. See PRSAENT for further doc. 30 ; 31 ; C0=emps 0 node in file 450 NH= emps 8B normal hrs 32 ; FLX= compressed/flextime code (0=none,C=compressed,F=flextime) 33 ; PMP= premium pay indicator 34 ; ( D=entitled Sun., F=entitled Sat./Sun., 35 ; E=entitled variable Sat./Sun. premium pay, 36 ; G=entitled variable Sun. prem pay, X=title 5 emps 37 ; R,C,O=different types of firefighters) 38 ; * PP= emps pay plan 39 ; DB = pay basis-1:full,2:part,3:intermit 40 ; ENT= 39 char entitlement string 41 ; 42 ; Entitlement lookup. 43 ; 44 D ^PRSAENT I ENT="" D ERROR(1) S OUT=1 Q 45 ; 46 ; Display header/Ask pp (NOL^PRSATE2 returns SRT = Current, Next, Last) 47 ; 48 D NOW^%DTC S NOW=% K % 49 W:$E(IOST,1,2)="C-" @IOF 50 W !?26,"VA TIME & ATTENDANCE SYSTEM" 51 W !?29,"EMPLOYEE TOUR OF DUTY" 52 D HDR^PRSADP1,NOL^PRSATE2 53 Q:SRT="^" 54 I SRT="L" S PPI=PPI-1,PPE=$P($G(^PRST(458,PPI,0)),"^",1) 55 ; 56 ; Get emp's flexitime code 57 ; 58 S FLX=$$FLEXIND^PRSATE6(PPI,DFN,SRT) 59 ; 60 ; Is emp entitled reg. shed. hrs.? 61 ; 62 I $E(ENT,1)="0" D 63 . S Z=$E(ENT,2),TD=$S(Z="D":3,1:4) D NONE 64 E D 65 .; 66 .; initialize t&l for this ToD 67 .; 68 . S WTL=TLI 69 . I "NL"[SRT D 70 .. S TYP=0 71 . E D 72 .. S TYP=$$ISTEMPTR() 73 ..; 74 ..; For temp ToDs--ask user for T&L ToD will be worked 75 ..; Quit if we don't get a valid T&L unit. 76 ..; 77 .. I TYP S WTL=$$ASKTLWRK^PRSATE6(TLE) 78 .; 79 .; Save current ToD in case user aborts with an unacceptable ToD. 80 .; 81 . D SAVETOUR^PRSATE6(PPI,DFN) 82 .; 83 . I WTL'<1,TYP'["^" D 84 .. D A1 85 ..; 86 ..; verify firefighter ToD after compressed ind. edit. Don't accept 87 ..; ToD until its within guidlines. If TK force exits, restore old ToD. 88 ..; 89 .. S NOERROR=0 90 .. F D Q:NOERROR 91 ... N ERROR D FFTOUR^PRSATE6(PPI,DFN,SRT,.ERROR) 92 ... I $$ISERRORS^PRSATE6(.ERROR) D 93 .... I $$ASKTOFIX^PRSATE6() D 94 ..... D A1 95 .... E D 96 ..... D RESTORE^PRSATE6(PPI,DFN) S NOERROR=1 97 ... E D 98 .... S NOERROR=1 99 K NOW Q 100 ;======================= 101 ; 102 ISTEMPTR() ; IS TEMPORARY ToD ? 103 ; Ask user if ToD is temp or perm & convert TYP to true false flag 104 ; Permanent set TYP=0, Temporary set TYP=true (1) 105 ; 106 S TYP=$$ASKTEMP^PRSATE6() I TYP'["^" S TYP=$E(TYP,1)="T",WTL=TLI 107 Q TYP 108 ;======================= 109 ; 110 A1 ; Set up for emps ToD look up. Screen allows Daily ToDs & days off 111 ; for daily emps. Everyone else gets days off & all other ToDs. 112 ; Screen further ensures ToD is available either to all t&ls 113 ; or to t&l that this emp is working in. 114 ; 115 N DIC,X 116 S DIC="^PRST(457.1,",DIC(0)="AEQMN" 117 S DIC("S")="I "_$S($E(ENT,1)="D":"Y<3",1:"Y>5!(Y=1)")_",$P(^PRST(457.1,+Y,0),U,4)!($D(^PRST(457.1,+Y,""T"",""B"",WTL)))" 118 ; 119 ; Setup a fixed or varying ToD. Compressed ToDs must be varying; 120 ; ask TK about all others. 121 ; 122 S DB=$P(C0,U,10) I FLX="C"!("KM"[PP&(DB=1)&(NH=72)) D 123 . D VAR 124 E D 125 . S X=$$ASKFIXED() 126 . Q:X="^" 127 . I X="N" D 128 .. D VAR 129 . E D FX 130 K DB Q 131 ;======================= 132 ; 133 FX ; Fixed ToD 134 S DIC("A")="Select TOUR OF DUTY: " 135 W ! D ^DIC 136 Q:Y'>0 137 S TD=+Y,Y=$G(^PRST(457.1,TD,1)),TDH=$P(^(0),"^",6),HRS=TDH*10 138 S (ZENT,STR)="" 139 D OT^PRSATP,VS^PRSATE0 140 I STR'="" W *7,!!,STR G FX 141 I '$D(^PRST(458,PPI,"E",DFN,"D",0)) S ^(0)="^458.02^14^14" 142 I SRT="N" D 143 . D F1 144 E D 145 . F DAY=2:1:6,9:1:13 D SET 146 . S TD=1,(Y,TDH)="" F DAY=1,7,8,14 D SET 147 . W " ... done" D:HRS'=NH ERROR(2,NH,HRS) 148 . D T2,^PRSATE5 149 D HOL,RS K HRS,STR 150 Q 151 ;======================= 152 ; 153 F1 F DAY=2:1:6,9:1:13 D NX 154 S TD=1 F DAY=1,7,8,14 D NX 155 W " ... done" 156 D:HRS'=NH ERROR(2,NH,HRS) 157 Q 158 ;======================= 159 ; 160 VAR ; Variable ToD 161 D ^PRSATE0 162 I SRT'="N" D T2,^PRSATE5 163 D HOL,RS 164 Q 165 ;======================= 166 ; 167 NONE ; No ToD 168 N TYP2,UPDT,Y,TDH 169 W !!,"This is an intermittent employee with no specified tour." 170 W !!,"Time records will now be updated to indicate this." 171 I '$D(^PRST(458,PPI,"E",DFN,"D",0)) S ^(0)="^458.02^14^14" 172 I '$$PERM^PRSALIB(PPI,DFN) D 173 . W !!,"Not all tour days are assigned a permanent status." 174 . I $$UPDTQ^PRSALIB(),$$TMPST^PRSALIB(.TYP2) D UPDSTAT^PRSALIB(PPI,DFN,TYP2) 175 S (Y,TDH)="",TYP=0,WTL=TLI 176 I SRT="N" D 177 . F DAY=1:1:14 D NX 178 E D 179 . F DAY=1:1:14 D SET 180 W " ... done" 181 D HOL,RS 182 Q 183 ;======================= 184 ; 185 RS ; Get Comp Ind 186 S Y=$G(^PRST(458,PPI,"E",DFN,0)) 187 S FLX=$S((SRT="N")&($P(Y,U,7)]""):$P(Y,U,7),1:$P(Y,U,6)) 188 S DIR(0)="SAM^C:Compressed;F:Flexitime;0:None" 189 S DIR("A")="Compressed Tour Indicator: " 190 S DIR("B")=$S(FLX="C":"Compressed",FLX="F":"Flexitime",1:"None") 191 D ^DIR K DIR I "^C^F^0^"'[(U_Y_U) S Y=FLX 192 ; 193 ; Intermittent employee cannot have compressed tour. 194 ; 195 I $P(C0,U,10)=3,Y="C" D G RS 196 . W *7,!?5,"Compressed tour not valid for this employee." 197 ; 198 I Y="F" S Z=0 D I Z G RS 199 .S PAY=$P(C0,U,21),PB=$P(C0,U,20) 200 .I "0123456789GU"'[PAY S Z=1 201 .I PAY="G",PB'=2 S Z=1 202 .I PAY="U","27EXT"'[PB S Z=1 203 .I Z W *7,!?5,"Flexitime not valid for this employee." 204 .Q 205 S $P(^PRST(458,PPI,"E",DFN,0),U,$S(SRT="N":7,1:6))=Y 206 I $D(^PRST(458,"ATC",DFN)) D UPD^PRSASAL 207 K PAY,ZENT Q 208 ;======================= 209 ; 210 NX ; Set Next ToD 211 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)) 212 Q:$P(Z,"^",2)=TD&('$P(Z,"^",3)) 213 ; 214 S $P(Z,"^",3,4)="2^"_TD,$P(Z,"^",10,11)=DUZ_"^"_NOW 215 S ^PRST(458,PPI,"E",DFN,"D",DAY,0)=Z,^PRST(458,"ATC",DFN,PPI,DAY)="" 216 Q 217 ;======================= 218 ; 219 SET ; Set ToD 220 N ZLASTPP 221 S U="^" 222 ; 223 ; Get Zero node of emp pp rec, Old ToD, & Prior scheduled ToD. 224 ; ZLASTPP is true if a ToD present on this day last pp. 225 ; 226 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)) 227 S ZLASTPP=$P($G(^PRST(458,PPI-1,"E",DFN,"D",DAY,0)),U,2)'="" 228 S OLD=$P(Z,U,2),SCH=$P(Z,U,4) 229 ; 230 ; Quit if old ToD=this ToD & emp rec start/stop=ToD file start/stop. 231 ; 232 Q:(OLD=TD)&($G(^PRST(458,PPI,"E",DFN,"D",DAY,1))=Y) 233 ; 234 ; Z is updated with new ToD info & replaces the emp ToD record. 235 ; 236 S $P(Z,U,8)=TDH 237 S $P(Z,U,10,11)=DUZ_U_NOW 238 I $P(Z,U,12) S $P(Z,U,12)="" ; remove holiday flag 239 ; 240 ; Temp ToD, store T&L ToD will be worked if it's not emp's usual t&l. 241 ; 242 I TYP S:TLI'=WTL $P(Z,U,9)=WTL 243 ; 244 ; No existing ToD on this day. 245 ; 246 I OLD="" D 247 . S $P(Z,U,1,3)=DAY_U_TD_U_TYP 248 . I ZLASTPP D S0 249 E D 250 .; 251 .; clean out postings and other ToD info since ToD is changing 252 .; 253 . D CLEANTOD(PPI,DFN,DAY,TD) 254 .; 255 .; 256 .; 257 . S:SCH $P(Z,U,5,7)="^^" 258 . I SCH="" D 259 .. S $P(Z,U,2,4)=TD_U_TYP_U_OLD 260 .. D S0 261 . E D 262 .. I SCH=TD D 263 ... S $P(Z,U,2,4)=TD_"^^" 264 ... K ^PRST(458,"ATC",DFN,PPI,DAY) 265 .. E D 266 ... S $P(Z,U,2,3)=TD_U_TYP 267 ... D S0 268 ; 269 D S1 270 K OLD,SCH Q 271 ;======================= 272 ; 273 ; Set up x-ref for supervisor approval of ToD change 274 ; 275 S0 S ^PRST(458,"ATC",DFN,PPI,DAY)="" 276 Q 277 ;======================= 278 ; 279 S1 ; 280 S ^PRST(458,PPI,"E",DFN,"D",DAY,0)=Z S:Y'="" ^(1)=Y 281 Q 282 ;======================= 283 ; 284 T2 ; Ask if second ToD 285 N X 286 ; 287 ; Don't ask for Daily ToDs 288 ; 289 Q:$E(ENT,1)="D" 290 ; 291 S X=$$ASK2NDTR() 292 Q:X'="Y" G ^PRSATE4 293 ;======================= 294 ; 295 HOL ; Determine if Holiday within ToD 296 N DAY 297 D ^PRSAPPH 298 Q:'$D(HOL) 299 S TT="HX",DUP=1 300 D E^PRSAPPH K DUP,HOL,TT 301 Q 302 ;======================= 303 ; 304 CLEANTOD(PPI,DFN,DAY,TD) ; CLEAN OUT TOUR 305 N PRSDT,MIEN 306 K ^PRST(458,PPI,"E",DFN,"D",DAY,1),^(2),^(3),^(10) I TD<5 K ^(4) S $P(Z,U,13,15)="^^" 307 ; if employee is PTP with active memo then reset the ESR day 308 S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY) 309 S MIEN=$$MIEN^PRSPUT1(DFN,PRSDT) 310 I MIEN D 311 . N PRSFDA 312 . S PRSFDA(458.02,DAY_","_DFN_","_PPI_",",146)="3" ; status = resubmit 313 . S PRSFDA(458.02,DAY_","_DFN_","_PPI_",",148)="Tour Changed" ; remarks 314 . D FILE^DIE("","PRSFDA"),MSG^DIALOG() 315 Q 316 ;======================= 317 ; 318 ERROR(NUM,VAR1,VAR2) ; 319 W *7,!! 320 I NUM=1 W "Employee has no Pay Entitlement table entry." 321 I NUM=2 D 322 . Q:$G(NH)=112 323 . W "Warning: Normal Hours are ",$G(VAR1),"; Tour Hours are ",$G(VAR2) 324 Q 325 ;======================= 326 ; 327 ASKFIXED() ;GET USER'S YES OR NO RESPONSE TO FIXED ToD QUESTION 328 N DIR,DIRUT,Y 329 S DIR("A")="Do you wish to enter a fixed Mon-Fri Tour" 330 S DIR(0)="Y" 331 S DIR("?")="Answer NO to create any other type of tour." 332 S DIR("?",1)="Fixed tours are Monday - Friday with the same hours." 333 D ^DIR 334 Q $S(Y=1:"Y",Y=0:"N",1:"^") 335 ;======================= 336 ; 337 ASK2NDTR() ;GET USER'S YES OR NO RESPONSE TO 2nd ToD QUESTION 338 N DIR,DIRUT,Y 339 S DIR("A")="Do you wish to enter a Second Tour for any Day" 340 S DIR(0)="Y" 341 S DIR("B")="N" 342 S DIR("?",1)="Answer Yes to add a second tour. No to continue." 343 S DIR("?")="Enter ^ to escape and cancel this tour change." 344 D ^DIR 345 Q $S(Y=1:"Y",Y=0:"N",1:"^") 346 ;======================= 347 ; 1 PRSATE ;WCIOFO/JAH - Enter/Edit Employee (emp) Tour of Duty (ToD) ;03/15/2005 2 ;;4.0;PAID;**8,11,27,45,55,93**;Sep 21, 1995;Build 7 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 N PPI,PPE,PRSTLV,TLI,TLE,DFN 5 ; 6 ; PPI = pay period (pp) internal #. 7 ; PPE = pp external form (99-06). 8 ; PRSTLV = flag indicates timekeeper (TK) in T&L lookup ^PRSAUTL. 9 ; TLI = T&L unit internal #. 10 ; TLU = T&L unit # 3-digit 11 ; 12 ; -Get current pp-internal & external. -Ask user for T&L. 13 ; -Loop to ask for emp until TK is done. 14 ; --Emp lookup screens emps not in T&L returned by PRSAUTL call. 15 ; 16 S PRSTLV=2 D ^PRSAUTL Q:TLI<1 17 F S DFN=$$GETEMP^PRSATE6(TLE) Q:DFN<1 D 18 . S PPI=$P(^PRST(458,0),"^",3),PPE=$P($G(^PRST(458,PPI,0)),"^",1) 19 . D TOUREDIT(DFN,PPI,PPE,TLI,TLE,PRSTLV) 20 Q 21 ;======================= 22 ; 23 TOUREDIT(DFN,PPI,PPE,TLI,TLE,PRSTLV) ; 24 ; 25 N C0,NH,FLX,PMP,PP,PB,ENT,SRT,WTL,TYP,Z,TD,ERROR,NOERROR 26 ; 27 ; Entitlement lookup leaks many variables. Following R used in 28 ; this routine but may be looked up again despite the fact they R 29 ; leaked by ^PRSAENT. See PRSAENT for further doc. 30 ; 31 ; C0=emps 0 node in file 450 NH= emps 8B normal hrs 32 ; FLX= compressed/flextime code (0=none,C=compressed,F=flextime) 33 ; PMP= premium pay indicator 34 ; ( D=entitled Sun., F=entitled Sat./Sun., 35 ; E=entitled variable Sat./Sun. premium pay, 36 ; G=entitled variable Sun. prem pay, X=title 5 emps 37 ; R,C,O=different types of firefighters) 38 ; * PP= emps pay plan 39 ; DB = pay basis-1:full,2:part,3:intermit 40 ; ENT= 39 char entitlement string 41 ; 42 ; Entitlement lookup. 43 ; 44 D ^PRSAENT I ENT="" D ERROR(1) S OUT=1 Q 45 ; 46 ; Display header/Ask pp (NOL^PRSATE2 returns SRT = Current, Next, Last) 47 ; 48 D NOW^%DTC S NOW=% 49 W:$E(IOST,1,2)="C-" @IOF 50 W !?26,"VA TIME & ATTENDANCE SYSTEM" 51 W !?29,"EMPLOYEE TOUR OF DUTY" 52 D HDR^PRSADP1,NOL^PRSATE2 53 Q:SRT="^" 54 I SRT="L" S PPI=PPI-1,PPE=$P($G(^PRST(458,PPI,0)),"^",1) 55 ; 56 ; Get emp's flexitime code 57 ; 58 S FLX=$$FLEXIND^PRSATE6(PPI,DFN,SRT) 59 ; 60 ; Is emp entitled reg. shed. hrs.? 61 ; 62 I $E(ENT,1)="0" D 63 . S Z=$E(ENT,2),TD=$S(Z="D":3,1:4) D NONE 64 E D 65 .; 66 .; initialize t&l for this ToD 67 .; 68 . S WTL=TLI 69 . I "NL"[SRT D 70 .. S TYP=0 71 . E D 72 .. S TYP=$$ISTEMPTR() 73 ..; 74 ..; For temp ToDs--ask user for T&L ToD will be worked 75 ..; Quit if we don't get a valid T&L unit. 76 ..; 77 .. I TYP S WTL=$$ASKTLWRK^PRSATE6(TLE) 78 .; 79 .; Save current ToD in case user aborts with an unacceptable ToD. 80 .; 81 . D SAVETOUR^PRSATE6(PPI,DFN) 82 .; 83 . I WTL'<1,TYP'["^" D 84 .. D A1 85 ..; 86 ..; verify firefighter ToD after compressed ind. edit. Don't accept 87 ..; ToD until its within guidlines. If TK force exits, restore old ToD. 88 ..; 89 .. S NOERROR=0 90 .. F D Q:NOERROR 91 ... N ERROR D FFTOUR^PRSATE6(PPI,DFN,SRT,.ERROR) 92 ... I $$ISERRORS^PRSATE6(.ERROR) D 93 .... I $$ASKTOFIX^PRSATE6() D 94 ..... D A1 95 .... E D 96 ..... D RESTORE^PRSATE6(PPI,DFN) S NOERROR=1 97 ... E D 98 .... S NOERROR=1 99 Q 100 ;======================= 101 ; 102 ISTEMPTR() ; IS TEMPORARY ToD ? 103 ; Ask user if ToD is temp or perm & convert TYP to true false flag 104 ; Permanent set TYP=0, Temporary set TYP=true (1) 105 ; 106 S TYP=$$ASKTEMP^PRSATE6() I TYP'["^" S TYP=$E(TYP,1)="T",WTL=TLI 107 Q TYP 108 ;======================= 109 ; 110 A1 ; Set up for emps ToD look up. Screen allows Daily ToDs & days off 111 ; for daily emps. Everyone else gets days off & all other ToDs. 112 ; Screen further ensures ToD is available either to all t&ls 113 ; or to t&l that this emp is working in. 114 ; 115 N DIC,X 116 S DIC="^PRST(457.1,",DIC(0)="AEQMN" 117 S DIC("S")="I "_$S($E(ENT,1)="D":"Y<3",1:"Y>5!(Y=1)")_",$P(^PRST(457.1,+Y,0),U,4)!($D(^PRST(457.1,+Y,""T"",""B"",WTL)))" 118 ; 119 ; Setup a fixed or varying ToD. Compressed ToDs must be varying; 120 ; ask TK about all others. 121 ; 122 I FLX="C" D 123 . D VAR 124 E D 125 . S X=$$ASKFIXED() 126 . Q:X="^" 127 . I X="N" D 128 .. D VAR 129 . E D FX 130 Q 131 ;======================= 132 ; 133 FX ; Fixed ToD 134 S DIC("A")="Select TOUR OF DUTY: " 135 W ! D ^DIC 136 Q:Y'>0 137 S TD=+Y,Y=$G(^PRST(457.1,TD,1)),TDH=$P(^(0),"^",6),HRS=TDH*10 138 S (ZENT,STR)="" 139 D OT^PRSATP,VS^PRSATE0 140 I STR'="" W *7,!!,STR G FX 141 I '$D(^PRST(458,PPI,"E",DFN,"D",0)) S ^(0)="^458.02^14^14" 142 I SRT="N" D 143 . D F1 144 E D 145 . F DAY=2:1:6,9:1:13 D SET 146 . S TD=1,(Y,TDH)="" F DAY=1,7,8,14 D SET 147 . W " ... done" D:HRS'=NH ERROR(2,NH,HRS) 148 . D T2,^PRSATE5 149 D HOL,RS 150 Q 151 ;======================= 152 ; 153 F1 F DAY=2:1:6,9:1:13 D NX 154 S TD=1 F DAY=1,7,8,14 D NX 155 W " ... done" 156 D:HRS'=NH ERROR(2,NH,HRS) 157 Q 158 ;======================= 159 ; 160 VAR ; Variable ToD 161 D ^PRSATE0 162 I SRT'="N" D T2,^PRSATE5 163 D HOL,RS 164 Q 165 ;======================= 166 ; 167 NONE ; No ToD 168 N TYP2,UPDT,Y,TDH 169 W !!,"This is an intermittent employee with no specified tour." 170 W !!,"Time records will now be updated to indicate this." 171 I '$D(^PRST(458,PPI,"E",DFN,"D",0)) S ^(0)="^458.02^14^14" 172 I '$$PERM^PRSALIB(PPI,DFN) D 173 . W !!,"Not all tour days are assigned a permanent status." 174 . I $$UPDTQ^PRSALIB(),$$TMPST^PRSALIB(.TYP2) D UPDSTAT^PRSALIB(PPI,DFN,TYP2) 175 S (Y,TDH)="",TYP=0,WTL=TLI 176 I SRT="N" D 177 . F DAY=1:1:14 D NX 178 E D 179 . F DAY=1:1:14 D SET 180 W " ... done" 181 D HOL,RS 182 Q 183 ;======================= 184 ; 185 RS ; Get Comp Ind 186 S Y=$G(^PRST(458,PPI,"E",DFN,0)) 187 S FLX=$S((SRT="N")&($P(Y,U,7)]""):$P(Y,U,7),1:$P(Y,U,6)) 188 S DIR(0)="SAM^C:Compressed;F:Flexitime;0:None" 189 S DIR("A")="Compressed Tour Indicator: " 190 S DIR("B")=$S(FLX="C":"Compressed",FLX="F":"Flexitime",1:"None") 191 D ^DIR K DIR I "^C^F^0^"'[(U_Y_U) S Y=FLX 192 ; 193 ; Intermittent employee cannot have compressed tour. 194 ; 195 I $P(C0,U,10)=3,Y="C" D G RS 196 . W *7,!?5,"Compressed tour not valid for this employee." 197 ; 198 I Y="F" S Z=0 D I Z G RS 199 .S PAY=$P(C0,U,21),PB=$P(C0,U,20) 200 .I "0123456789GU"'[PAY S Z=1 201 .I PAY="G",PB'=2 S Z=1 202 .I PAY="U","27EXT"'[PB S Z=1 203 .I Z W *7,!?5,"Flexitime not valid for this employee." 204 .Q 205 S $P(^PRST(458,PPI,"E",DFN,0),U,$S(SRT="N":7,1:6))=Y 206 I $D(^PRST(458,"ATC",DFN)) D UPD^PRSASAL 207 Q 208 ;======================= 209 ; 210 NX ; Set Next ToD 211 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)) 212 Q:$P(Z,"^",2)=TD&('$P(Z,"^",3)) 213 ; 214 S $P(Z,"^",3,4)="2^"_TD,$P(Z,"^",10,11)=DUZ_"^"_NOW 215 S ^PRST(458,PPI,"E",DFN,"D",DAY,0)=Z,^PRST(458,"ATC",DFN,PPI,DAY)="" 216 Q 217 ;======================= 218 ; 219 SET ; Set ToD 220 N ZLASTPP 221 S U="^" 222 ; 223 ; Get Zero node of emp pp rec, Old ToD, & Prior scheduled ToD. 224 ; ZLASTPP is true if a ToD present on this day last pp. 225 ; 226 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)) 227 S ZLASTPP=$P($G(^PRST(458,PPI-1,"E",DFN,"D",DAY,0)),U,2)'="" 228 S OLD=$P(Z,U,2),SCH=$P(Z,U,4) 229 ; 230 ; Quit if old ToD=this ToD & emp rec start/stop=ToD file start/stop. 231 ; 232 Q:(OLD=TD)&($G(^PRST(458,PPI,"E",DFN,"D",DAY,1))=Y) 233 ; 234 ; Z is updated with new ToD info & replaces the emp ToD record. 235 ; 236 S $P(Z,U,8)=TDH 237 S $P(Z,U,10,11)=DUZ_U_NOW 238 I $P(Z,U,12) S $P(Z,U,12)="" ; remove holiday flag 239 ; 240 ; Temp ToD, store T&L ToD will be worked if it's not emp's usual t&l. 241 ; 242 I TYP S:TLI'=WTL $P(Z,U,9)=WTL 243 ; 244 ; No existing ToD on this day. 245 ; 246 I OLD="" D 247 . S $P(Z,U,1,3)=DAY_U_TD_U_TYP 248 . I ZLASTPP D S0 249 E D 250 .; 251 .; clean out postings and other ToD info since ToD is changing 252 .; 253 . D CLEANTOD(PPI,DFN,DAY,TD) 254 .; 255 .; 256 .; 257 . S:SCH $P(Z,U,5,7)="^^" 258 . I SCH="" D 259 .. S $P(Z,U,2,4)=TD_U_TYP_U_OLD 260 .. D S0 261 . E D 262 .. I SCH=TD D 263 ... S $P(Z,U,2,4)=TD_"^^" 264 ... K ^PRST(458,"ATC",DFN,PPI,DAY) 265 .. E D 266 ... S $P(Z,U,2,3)=TD_U_TYP 267 ... D S0 268 ; 269 D S1 270 Q 271 ;======================= 272 ; 273 ; Set up x-ref for supervisor approval of ToD change 274 ; 275 S0 S ^PRST(458,"ATC",DFN,PPI,DAY)="" 276 Q 277 ;======================= 278 ; 279 S1 ; 280 S ^PRST(458,PPI,"E",DFN,"D",DAY,0)=Z S:Y'="" ^(1)=Y 281 Q 282 ;======================= 283 ; 284 T2 ; Ask if second ToD 285 N X 286 ; 287 ; Don't ask for Daily ToDs 288 ; 289 Q:$E(ENT,1)="D" 290 ; 291 S X=$$ASK2NDTR() 292 Q:X'="Y" G ^PRSATE4 293 ;======================= 294 ; 295 HOL ; Determine if Holiday within ToD 296 N DAY 297 D ^PRSAPPH 298 Q:'$D(HOL) 299 S TT="HX",DUP=1 300 D E^PRSAPPH 301 Q 302 ;======================= 303 ; 304 CLEANTOD(PPI,DFN,DAY,TD) ; CLEAN OUT TOUR 305 N PRSDT,MIEN 306 K ^PRST(458,PPI,"E",DFN,"D",DAY,1),^(2),^(3),^(10) I TD<5 K ^(4) S $P(Z,U,13,15)="^^" 307 ; if employee is PTP with active memo then reset the ESR day 308 S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY) 309 S MIEN=$$MIEN^PRSPUT1(DFN,PRSDT) 310 I MIEN D 311 . N PRSFDA 312 . S PRSFDA(458.02,DAY_","_DFN_","_PPI_",",146)="3" ; status = resubmit 313 . S PRSFDA(458.02,DAY_","_DFN_","_PPI_",",148)="Tour Changed" ; remarks 314 . D FILE^DIE("","PRSFDA"),MSG^DIALOG() 315 Q 316 ;======================= 317 ; 318 ERROR(NUM,VAR1,VAR2) ; 319 W *7,!! 320 I NUM=1 W "Employee has no Pay Entitlement table entry." 321 I NUM=2 D 322 . Q:$G(NH)=112 323 . W "Warning: Normal Hours are ",$G(VAR1),"; Tour Hours are ",$G(VAR2) 324 Q 325 ;======================= 326 ; 327 ASKFIXED() ;GET USER'S YES OR NO RESPONSE TO FIXED ToD QUESTION 328 N DIR,DIRUT,Y 329 S DIR("A")="Do you wish to enter a fixed Mon-Fri Tour" 330 S DIR(0)="Y" 331 S DIR("?")="Answer NO to create any other type of tour." 332 S DIR("?",1)="Fixed tours are Monday - Friday with the same hours." 333 D ^DIR 334 S RESP=$S(Y=1:"Y",Y=0:"N",1:"^") 335 Q RESP 336 ;======================= 337 ; 338 ASK2NDTR() ;GET USER'S YES OR NO RESPONSE TO 2nd ToD QUESTION 339 N DIR,DIRUT,Y 340 S DIR("A")="Do you wish to enter a Second Tour for any Day" 341 S DIR(0)="Y" 342 S DIR("B")="N" 343 S DIR("?",1)="Answer Yes to add a second tour. No to continue." 344 S DIR("?")="Enter ^ to escape and cancel this tour change." 345 D ^DIR 346 S RESP=$S(Y=1:"Y",Y=0:"N",1:"^") 347 Q RESP 348 ;======================= 349 ;
Note:
See TracChangeset
for help on using the changeset viewer.
