source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPEAX.m@ 1724

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

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1PRSPEAX ;WOIFO/SAB - CANCEL EXTENDED ABSENCE ;1/4/2005
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; Cancel Existing Extended Absence
6 ;
7 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,EAIEN,EALIST,EAY0,ESRU
8 N PERSTR,PEREND,PRSFDA,PRSIEN,PRSLCK,PRSLCKE,X,X1,Y
9 ;
10 ; determine Employee IEN
11 S PRSIEN=$$PRSIEN^PRSPUT2(1)
12 I 'PRSIEN G EXIT
13 ;
14 ; verify that user has electronic signature code
15 I '$$ESIGC^PRSPUT2(1) G EXIT
16 ;
17SEL ; select extended absence
18 W @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
19 W !?28,"CANCEL EXTENDED ABSENCE",!
20 ;
21 ; build list in EALIST( array
22 D BLDLST^PRSPEAU(PRSIEN,DT,"^A^")
23 ;
24 ; display list (exit if ^ or time-out during list display)
25 G:$$DISLST^PRSPEAU() EXIT
26 ;
27 I EALIST(0)=0 G EXIT ; nothing to select
28 ;
29 ; select item from list
30 W !
31 S DIR(0)="NO^1:"_EALIST(0)
32 S DIR("A")="Cancel which extended absence #?"
33 D ^DIR K DIR G:Y'>0!$D(DIRUT) EXIT
34 S EAIEN=EALIST(+Y)
35 S EAY0=$G(^PRST(458.4,EAIEN,0))
36 ;
37 ; Lock EA
38 L +^PRST(458.4,EAIEN):2
39 I '$T D G AGAIN
40 . W $C(7),!,"Another user is editing this extended absence!"
41 ;
42 ; Display EA
43 W @IOF D DISEA^PRSPEAU(EAIEN) W !
44 ;
45 ; set ESRU to indicate any restruction for ESR updates upon EA cancel.
46 ; if absence includes prior days then they will not be updated on ESR
47 ; if absence includes Today and RG posted then Today can't be updated
48 ; restruction: 0 = none, 1 = prior to Today, 2 = Today and prior
49 S ESRU=0 ; init with no restriction
50 ; check if EA includes Today and if RG already posted to Today
51 I $P(EAY0,U)'>DT,$$CHKRG^PRSPEAU(PRSIEN) S ESRU=2
52 ; if Today OK then check if EA includes any prior days
53 I 'ESRU,$P(EAY0,U)<DT S ESRU=1
54 ;
55 ; Determine ESR period to update
56 S PERSTR=$S(ESRU=2:$$FMADD^XLFDT(DT,1),ESRU=1:DT,1:$P(EAY0,U))
57 S PEREND=$P(EAY0,U,2)
58 ;
59 ; Warn User if any restrictions
60 I ESRU D
61 . W !!,"This extended absence includes some ESR days that can't be"
62 . W !,"automatically updated if the absence is cancelled. Note that"
63 . W !,"ESR days before "_$$FMTE^XLFDT(PERSTR)_" won't be automatically modified."
64 . W !,"If appropriate, please manually update those earlier ESR days.",!
65 ;
66 ; Confirm Cancel
67 S DIR(0)="Y",DIR("A")="Do you want to cancel this extended absence" D ^DIR K DIR I 'Y L -^PRST(458.4,EAIEN) G:$D(DIRUT) EXIT G:'Y SEL
68 ;
69 ; e-sig
70 D SIG^XUSESIG
71 I X1="" L -^PRST(458.4,EAIEN) G AGAIN
72 ;
73 ; lock timecards for applicable opened pay periods
74 D LCK^PRSPAPU(PRSIEN,PERSTR,PEREND,.PRSLCK,.PRSLCKE)
75 ;
76 ; if some time cards couldn't be locked then report error and quit
77 I $D(PRSLCKE) D G AGAIN
78 . D TCULCK^PRSPAPU(PRSIEN,.PRSLCK) ; remove any TC locks
79 . D RLCKE^PRSPAPU(.PRSLCKE,1) ; report failed locks
80 . K PRSLCKE
81 ;
82 ; Update EA
83 S PRSFDA(458.4,EAIEN_",",4)=$$NOW^XLFDT() ; d/t updated
84 S PRSFDA(458.4,EAIEN_",",5)="X" ; status = cancelled
85 D FILE^DIE("","PRSFDA") D MSG^DIALOG()
86 ;
87 ; Update ESRs
88 D UEA^PRSPEAA(PRSIEN,PERSTR,PEREND)
89 ;
90 W !,"The extended absence has been cancelled."
91 ;
92 ; Unlock time cards
93 D TCULCK^PRSPAPU(PRSIEN,.PRSLCK)
94 ;
95 ; unlock EA
96 L -^PRST(458.4,EAIEN)
97 ;
98 ; Pause and repeat
99AGAIN S DIR(0)="E" D ^DIR K DIR G:$D(DIRUT) EXIT
100 G SEL
101 ;
102EXIT ; exit point
103 Q
104 ;
105 ;PRSPEAX
Note: See TracBrowser for help on using the repository browser.