source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPEAU.m@ 823

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

initial load of WorldVistAEHR
File size: 6.2 KB
Line 
1PRSPEAU ;WOIFO/SAB - EXTENDED ABSENCE UTILITIES ;10/19/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 ;
6 ;
7CONFLICT(PRSIEN,NFDT,NTDT,XEAIEN) ; check for conflict with existing EAs
8 ; input
9 ; PRSIEN - employee ien (file 450)
10 ; NFDT - new from date in fileman format
11 ; NTDT - (optional) new to date in fileman format
12 ; XEAIEN - (optional) existing extended absense ien, passed if dates
13 ; for an existing record are being checked so that entry does
14 ; not conflict with itself.
15 ; returns string with value =
16 ; list of Extended Absence iens (delimited by ^) that conflict OR
17 ; null when no conflict found
18 ;
19 ; A conflict exists if the date range (New From-New To) overlaps the
20 ; date range of a different, active (does not include cancelled)
21 ; extended absence. If the To Date is not passed, then the software
22 ; will just check the From Date to issue that it does not conflict with
23 ; another extended absence.
24 ;
25 N EAIEN,EAY0,PRSRET,PRSY,TDT
26 S PRSRET=""
27 S NTDT=$G(NTDT,NFDT) ; if To Date not passed then set equal to From Date
28 ;
29 ; loop thru extended absences for employee by reverse To Date until
30 ; the To Date is before the New From Date or no more To Dates
31 S TDT=9999999 ; initial To Date for loop
32 F S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT),-1) Q:'TDT!(TDT<NFDT) D
33 . ; loop thru extended absences with To Date
34 . S EAIEN=0
35 . S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN D
36 . . Q:EAIEN=$G(XEAIEN) ; skip if entry is the one being checked
37 . . S EAY0=$G(^PRST(458.4,EAIEN,0)) ; extended absense 0 node
38 . . Q:$P(EAY0,U)=""!($P(EAY0,U,2)="") ; dates missing - invalid
39 . . Q:$P(EAY0,U)>NTDT ; skip if From Date after New To Date
40 . . Q:$P(EAY0,U,6)'="A" ; skip if Status not active
41 . . ;
42 . . ; extended absence overlaps the pay period
43 . . S PRSRET=PRSRET_EAIEN_U ; conflict
44 ;
45 Q PRSRET
46 ;
47RCON(LIST,WRITE,PRSARRN) ; Report Conflicts
48 ; input
49 ; LIST - string of conflicting Ext Absence IENs delimited by ^
50 ; WRITE - (optional) true (=1) if text should be written (default)
51 ; false (=0) if array should be returned instead
52 ; PRSARRN - (optional) array name, default value is "PRSARR"
53 ; output
54 ; If WRITE is True, the input array name (or "PRSARR" if not
55 ; specified) will be killed.
56 ; If WRITE is False, the input array name will contain the text
57 ;
58 Q:$G(LIST)=""
59 ;
60 N EAIEN,LN,PC
61 ;
62 S PRSARRN=$G(PRSARRN,"PRSARR")
63 S WRITE=$G(WRITE,1)
64 ;
65 S @PRSARRN@(1)="The specified dates conflict with other extended absence(s)."
66 S @PRSARRN@(2)="Please specify different dates for this extended absence or"
67 S @PRSARRN@(3)="remove the conflict by first editing the other extended absence(s)."
68 S LN=3
69 F PC=1:1 S EAIEN=$P(LIST,U,PC) Q:EAIEN="" D
70 . S LN=LN+1
71 . S @PRSARRN@(LN)=" Conflicts with Absence: "_$$GET1^DIQ(458.4,EAIEN_",",.01)_" to "_$$GET1^DIQ(458.4,EAIEN_",",1)
72 ;
73 ; if not WRITE then quit (return text in array to caller)
74 Q:'WRITE
75 ;
76 ; otherwise write text to current device and then kill array of text
77 S LN=0 F S LN=$O(@PRSARRN@(LN)) Q:'LN D
78 . W !,@PRSARRN@(LN)
79 K @PRSARRN
80 ;
81 Q
82 ;
83CHKRG(PRSIEN) ; Check for RG Posted to Today's ESR
84 ; Input
85 ; PRSIEN - Employee IEN (file 450)
86 ; Returns
87 ; boolean value, true (=1) if RG already posted on ESR for Today
88 ;
89 N D1,DAY,PP4Y,PPE,PPI,PRSRET
90 ;
91 S PRSRET=0 ; init return value
92 ;
93 I $G(PRSIEN) D
94 . S D1=DT
95 . D PP^PRSAPPU
96 . Q:'$G(PPI)
97 . Q:'$G(DAY)
98 . I $G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))["RG" S PRSRET=1
99 ;
100 Q PRSRET
101 ;
102DISEA(EAIEN,IC) ; Display EA
103 ; input
104 ; EAIEN - Extended Absence IEN (file 458.4)
105 ; IC - (optional) item count, number to be included in display
106 ; result
107 ; Writes information to current device (2-4 lines)
108 Q:'$G(EAIEN) ; IEN required
109 S IC=$G(IC)
110 ;
111 N PRSE,PRSIENS,PRSV
112 S PRSIENS=EAIEN_","
113 ;
114 D GETS^DIQ(458.4,PRSIENS,".01;1;3;4;5;6","","PRSV","PRSE")
115 ;
116 ; display info if no error
117 I '$D(PRSE) D
118 . W !
119 . I IC W $$RJ^XLFSTR(IC_") ",4)
120 . W PRSV(458.4,PRSIENS,.01)_" to "_PRSV(458.4,PRSIENS,1)
121 . W ?33,"Status: ",PRSV(458.4,PRSIENS,5)
122 . I PRSV(458.4,PRSIENS,6)]"" W !,?4,PRSV(458.4,PRSIENS,6) ; remarks
123 . W !,?33,"Entered: ",PRSV(458.4,PRSIENS,3)
124 . I PRSV(458.4,PRSIENS,4)]"" W !,?33,"Updated: ",PRSV(458.4,PRSIENS,4)
125 ;
126 I $D(PRSE) D MSG^DIALOG(,,,,"PRSE") ; display error
127 ;
128 Q
129 ;
130BLDLST(PRSIEN,MINTDT,OKSTAT) ; Build List of Extended Absence Entries
131 ; input
132 ; PRSIEN - Employee IEN (file 450)
133 ; MINTDT - Minumum To Date (FileMan Internal)
134 ; OKSTAT - String of acceptable EA status values to place in list
135 ; delimited by ^ (e.g. "A" or "^A^" or "A^X"...)
136 ; ARRN - (optional) name of an array that will contain the list
137 ; default value is "EALIST"
138 ; output
139 ; local array EALIST with format
140 ; EALIST(0)=count of items in list
141 ; EALIST(1)=1st extended absence IEN in list
142 ; EALIST(n)=nth extended absence IEN in list
143 ;
144 ; initialize the list
145 K EALIST
146 ;
147 Q:'$G(PRSIEN)
148 Q:$G(MINTDT)'?7N
149 Q:$G(OKSTAT)=""
150 ;
151 I $E(OKSTAT)'="^" S OKSTAT="^"_OKSTAT
152 I $E(OKSTAT,$L(OKSTAT))'="^" S OKSTAT=OKSTAT_"^"
153 ;
154 ;
155 N CNT,EAIEN,PRSX,TDT
156 ;
157 ; loop thru extended absences by to date - build sorted temp list
158 S TDT=MINTDT-.01
159 F S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT)) Q:'TDT D
160 . S EAIEN=0
161 . F S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN D
162 . . Q:OKSTAT'[(U_$P($G(^PRST(458.4,EAIEN,0)),U,6)_U)
163 . . S EALIST("T",TDT_"^"_EAIEN)=""
164 ;
165 ; build output list by number based on order in temp list
166 S CNT=0,PRSX=""
167 F S PRSX=$O(EALIST("T",PRSX)) Q:PRSX="" D
168 . S CNT=CNT+1
169 . S EALIST(CNT)=$P(PRSX,U,2)
170 S EALIST(0)=CNT ; set header node with count
171 ;
172 K EALIST("T") ; delete temp list
173 ;
174 Q
175 ;
176DISLST() ; Display List of Extended Absences
177 ; input
178 ; local array EALIST with format
179 ; EALIST(0)=count of items in list
180 ; EALIST(1)=1st extended absence IEN in list
181 ; EALIST(n)=nth extended absence IEN in list
182 ; returns 1 if user entered an up-arrow or time-out
183 ;
184 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,PRSI,PRSRET,X,Y
185 ;
186 S PRSRET=0
187 ;
188 I EALIST(0)=0 W !,"No extended absences were found."
189 ;
190 S PRSI=0 F S PRSI=$O(EALIST(PRSI)) Q:'PRSI D Q:PRSRET
191 . I $Y+6>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y PRSRET=1 Q:'Y W @IOF
192 . S EAIEN=EALIST(PRSI)
193 . D DISEA(EAIEN,PRSI)
194 ;
195 Q PRSRET
196 ;
197 ;PRSPEAU
Note: See TracBrowser for help on using the repository browser.