source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPAPU.m@ 836

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

initial load of WorldVistAEHR

File size: 5.9 KB
RevLine 
[613]1PRSPAPU ;WOIFO/SAB-WOIFO/SAB - AUTO POST UTILITIES FOR EA & LV ;10/30/2004
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 ;
6TCLCK(PRSIEN,S1,E1,S2,E2,PPLCK,PPLCKE) ; Time Card Lock for Date Range Change
7 ; This API attempts to lock employee timecards for pay periods that
8 ; are impacted by a change to a date range. Only existing pay periods
9 ; that are covered by a PTP memo will be locked.
10 ;
11 ; Input
12 ; PRSIEN - Employee IEN (file 450)
13 ; S1 - Old Start Date (FileMan internal)
14 ; E1 - Old End Date (Fileman internal)
15 ; S2 - New Start Date (FileMan internal)
16 ; E2 - New End Date (Fileman internal)
17 ; PPLCK() - Array of Locked Pay Periods passed by reference
18 ; PPLCKE() - Array of Pay Periods with Lock Error passed by reference
19 ; Note that both these arrays are initialized by this API.
20 ; Output
21 ; PPLCK() - Array of Locked Pay Periods may be updated
22 ; format PPLCK(pay period IEN file 458)=""
23 ; PPLCKE() - Array of Pay Periods with Lock Error may be updated
24 ; format PPLCKE(pay period IEN file 458)=""
25 ;
26 K PPLCK,PPLCKE
27 ;
28 ;if S1 and E1 have values and S2 and E2 are null then lock from S1 to E1
29 I S1,E1,'S2,'E2 D LCK(PRSIEN,S1,E1,.PPLCK,.PPLCKE)
30 ;
31 ;if S1 and E1 are null and S2 and E2 have values then lock from S2 to E2
32 I 'S1,'E1,S2,E2 D LCK(PRSIEN,S2,E2,.PPLCK,.PPLCKE)
33 ;
34 ;if S1, E1, S2, and E2 have values then lock impacted ranges
35 I S1,E1,S2,E2 D
36 . N X1,X2
37 . ; if new start is less than old start then days from new start to
38 . ; lesser of new end and old start-1 were changed from not covered to
39 . ; covered.
40 . I S2<S1 D
41 . . S X1=S2
42 . . S X2=$S(E2<(S1-1):E2,1:S1-1)
43 . . D LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
44 . ;
45 . ; if new start is greater than old start then days from old start to
46 . ; lesser of old end and new start-1 were changed from covered to not
47 . ; covered.
48 . I S2>S1 D
49 . . S X1=S1
50 . . S X2=$S(E1<(S2-1):E1,1:S2-1)
51 . . D LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
52 . ;
53 . ; if new end is greater than old end then days from greater of old
54 . ; end+1 and new start to new end were changed from not covered to
55 . ; covered.
56 . I E2>E1 D
57 . . S X1=$S(E1+1>S2:E1+1,1:S2)
58 . . S X2=E2
59 . . D LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
60 . ;
61 . ; if new end is less than old end then days from greater of new end+1
62 . ; and old start to old end were changed from covered to not covered.
63 . I E2<E1 D
64 . . S X1=$S(E2+1>S1:E2+1,1:S1)
65 . . S X2=E1
66 . . D LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
67 ;
68 Q
69 ;
70LCK(PRSIEN,PERSTR,PEREND,PPLCK,PPLCKE) ; Lock Time Cards for a Date Range
71 ; This API attempts to lock the employee timecards for a date range.
72 ; Only existing pay periods that are covered by a PTP memo are locked.
73 ;
74 ; Input
75 ; PRSIEN - Employee IEN (file 450)
76 ; PERSTR - Period Start (FileMan internal)
77 ; PEREND - Period End (Fileman internal)
78 ; PPLCK() - Array of Locked Pay Periods passed by reference
79 ; format PPLCK(pay period IEN file 458)=""
80 ; PPLCKE() - Array of Pay Periods with Lock Error passed by reference
81 ; format PPLCKE(pay period IEN file 458)=""
82 ; Note that these arrays are not initialized by this API and may
83 ; contain information about already locked timecards.
84 ; Output
85 ; PPLCK() - Array of Locked Pay Periods may be updated
86 ; PPLCKE() - Array of Pay Periods with Lock Error may be updated
87 ;
88 Q:('$G(PRSIEN))!($G(PERSTR)'?7N)!($G(PEREND)'?7N) ; required inputs
89 ;
90 N D1,DAY,EPP4Y,PP4Y,PPE,PPI,SPP4Y,Y
91 ;
92 ; determine starting and ending pay periods
93 S D1=PERSTR D PP^PRSAPPU S SPP4Y=PP4Y
94 S D1=PEREND D PP^PRSAPPU S EPP4Y=PP4Y
95 Q:SPP4Y=""
96 Q:EPP4Y=""
97 ;
98 ; loop thru pay periods
99 S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
100 F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
101 . S PPI=$O(^PRST(458,"AB",PP4Y,0))
102 . ; quit if pay period not covered by memo
103 . S D1=$P($G(^PRST(458,PPI,1)),U)
104 . Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0
105 . ;
106 . Q:$D(PPLCK(PPI)) ; already in lock array
107 . Q:$D(PPLCKE(PPI)) ; already in lock error array
108 . ;
109 . ; lock timecard
110 . L +^PRST(458,PPI,"E",PRSIEN):2
111 . S:'$T PPLCKE(PPI)=""
112 . S:$T PPLCK(PPI)=""
113 ;
114 Q
115 ;
116 ;
117TCULCK(PRSIEN,PPLCK) ; Time Card Unlock
118 ; This API unlocks a list of employee timecards.
119 ;
120 ; Input
121 ; PRSIEN - Employee IEN (file 450)
122 ; PPLCK( - Array of Locked Pay Periods passed by reference
123 ; format PPLCK(pay period IEN file 458)=""
124 ; Output
125 ; PPLCK( - Input array is killed since pay periods are unlocked
126 ;
127 Q:'$G(PRSIEN) ; required input
128 ;
129 N PPI
130 ;
131 ; loop thru pay periods and unlock time card
132 S PPI="" F S PPI=$O(PPLCK(PPI)) Q:'PPI L -^PRST(458,PPI,"E",PRSIEN)
133 ;
134 ; init lock array
135 K PPLCK
136 ;
137 Q
138 ;
139RLCKE(PPLCKE,WRITE,PRSARRN) ; Report Lock Errors
140 ; This API writes a list of timecards that could not be locked.
141 ;
142 ; Input
143 ; PPLCKE( - Array of Pay Periods with Lock Error passed by reference
144 ; format PPLCKE(pay period IEN file 458)=""
145 ; WRITE - (optional) true (=1) if text should be written (default)
146 ; false (=0) if array should be returned instead
147 ; PRSARRN - (optional) array name, default value is "PRSARR"
148 ; output
149 ; If WRITE is True, the input array name (or "PRSARR" if not
150 ; specified) will be killed.
151 ; If WRITE is False, the input array name will contain the text
152 ;
153 N LN,PPI
154 ;
155 S PRSARRN=$G(PRSARRN,"PRSARR")
156 S WRITE=$G(WRITE,1)
157 ;
158 S @PRSARRN@(1)="Unable to make changes because the time card for the following"
159 S @PRSARRN@(2)="pay period(s) are being edited by another user!"
160 S LN=2
161 ; loop thru pay periods
162 S PPI="" F S PPI=$O(PPLCKE(PPI)) Q:'PPI D
163 . S LN=LN+1
164 . S @PRSARRN@(LN)=" Pay Period: "_$P($G(^PRST(458,PPI,0)),U)
165 ;
166 ; if not WRITE then quit (returns text in array to caller)
167 Q:'WRITE
168 ;
169 ; otherwise write text to current device and then kill array of text
170 S LN=0 F S LN=$O(@PRSARRN@(LN)) Q:'LN D
171 . W !,@PRSARRN@(LN)
172 K @PRSARRN
173 ;
174 Q
175 ;
176 ;PRSPAPU
Note: See TracBrowser for help on using the repository browser.