source: WorldVistAEHR/trunk/r/PAID-PRS/PRSARC.m@ 1006

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

initial load of WorldVistAEHR

File size: 7.9 KB
Line 
1PRSARC ;WOIFO/JAH - Recess Tracking ListManger Inteface ;10/16/06
2 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5ENEDIT ; -- main entry point for PRSA RECESS TRACKING
6 S PRSOUT=0
7 ;
8 D SETUP(.PRSOUT)
9 I $G(PRSOUT)=1 D EXIT Q
10 ;
11 ; set global var to allow editing
12 S PRSVIEW=0
13 D EN^VALM("PRSA RECESS TRACKING MANAGER")
14 Q
15SUP ;
16TK ;
17 N PRSTLV,TLE,TLI
18 S PRSTLV=2 D ^PRSAUTL
19 Q:$G(TLE)=""
20 N DIC,Y,FYREC,PRSIEN,DUOUT,DTOUT
21 S DIC("S")="I $P(^PRSPC(+^PRST(458.8,+Y,0),0),U,8)=TLE"
22 S DIC(0)="AEMZQ"
23 S DIC("A")="Select 9-month AWS Nurse: "
24 S DIC="^PRST(458.8,"
25 D ^DIC
26 Q:$D(DUOUT)!$D(DTOUT)!($G(Y)'>0)
27 S PRSIEN=Y(0)
28 S FYREC=+Y
29 D ENVIEW
30 Q
31HR ;
32 N DIC,Y,FYREC,PRSIEN,DUOUT,DTOUT
33 S DIC(0)="AEMZQ"
34 S DIC("A")="Select 9-month AWS Nurse: "
35 S DIC="^PRST(458.8,"
36 D ^DIC
37 Q:$D(DUOUT)!$D(DTOUT)!($G(Y)'>0)
38 S PRSIEN=Y(0)
39 S FYREC=+Y
40 D ENVIEW
41 Q
42NURSE ;
43 N DIC,Y,FDEFAULT,SSN,FYREC,PRSIEN,DUOUT,DTOUT,ABORT
44 S PRSNURSE="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
45 I SSN'="" S PRSNURSE=$O(^PRSPC("SSN",SSN,0))
46 I 'PRSNURSE W !!!,*7,"Your SSN was not found in either the New Person file or the Employee file.",!! H 1 S ABORT=$$ASK^PRSLIB00(1) Q
47 S FDEFAULT=$O(^PRST(458.8,"AC",PRSNURSE,9999999),-1)
48 I 'FDEFAULT W !!,*7,"You have no recess schedules on file. Please contact your timekeeper.",!! H 1 S ABORT=$$ASK^PRSLIB00(1) Q
49 S FDEFAULT=$O(^PRST(458.8,"AC",PRSNURSE,FDEFAULT,0))
50 S FDEFAULT=+$G(^PRST(458.8,FDEFAULT,3))
51 S DIC("B")=FDEFAULT
52 S DIC(0)="AEMZQ"
53 S DIC("A")="Select a Recess Schedule: "
54 S DIC="^PRST(458.8,"
55 S DIC("S")="I +^PRST(458.8,+Y,0)=PRSNURSE"
56 D ^DIC
57 Q:$D(DUOUT)!$D(DTOUT)!($G(Y)'>0)
58 S PRSIEN=Y(0)
59 S FYREC=+Y
60 D ENVIEW
61 Q
62ENVIEW ; -- main entry point for PRSA RECESS VIEWER
63 ; ask user nurse then provide selection of available recess records
64 ; by fiscal year that may be viewed.
65 ;
66 N ZNODE,NAME,SSN,TLE
67 S ZNODE=$G(^PRSPC(+PRSIEN,0))
68 S NAME=$P(ZNODE,U)
69 ; set global var so action protocols will be unavailable (view only)
70 S PRSVIEW=1
71 S SSN=$P(ZNODE,U,9),SSN="XXX-XX-"_$E(SSN,6,9)
72 S TLE=$P(ZNODE,U,8)
73 S PRSNURSE=PRSIEN_U_NAME_U_U_TLE_U_SSN
74 S PRSFY=$$FYRDATA^PRSARC03(FYREC)
75 S PRSFYRNG=$P(PRSFY,U,5,6)
76 D FYWEEKS^PRSARC04(.FMWKS,PRSFY,0)
77 D FYWEEKS^PRSARC04(.WKSFM,PRSFY,1)
78 S PRSDT=$P(PRSFY,U,11)
79 S PRSFSCYR=$$GETFSCYR^PRSARC04(PRSDT)
80 S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
81 D EN^VALM("PRSA RECESS TRACKING VIEWER")
82 Q
83 ;
84SETUP(OUT) ; Setup for a new AWS schedule-prompt for year & start or bring
85 ; up an existing schedule
86 ;
87 ;
88 ; get NURSE IEN^NAME^(0 edit only, 1 add and edit)
89 ; if nurse is currently entitled to recess a new rec can be added,
90 ; otherwise only edit existing records curr, next, or last are allowed.
91 ; 2nd input param=2 for timekeepers T&L lookup
92 ;
93 D GETNURSE^PRSARC02(.PRSNURSE,2)
94 I +$G(PRSNURSE)'>0 S OUT=1 Q
95 L +^PRST(458.8,+PRSNURSE):$S($G(DILOCKTM)>0:DILOCKTM,1:5) I '$T W !,"Another user is editing this nurses recess records." S OUT=1 Q
96 ;
97 ; Set global variable to hold total of weeks that are selectable
98 ;
99 N ALLFY,FD,LD,RWREC
100 ;
101 ; Build schedule choice and ask which one to edit, current next last.
102 ; If schedule exists we get 458.8 Recess Tracking IEN.
103 ;
104 D CHOOSEFY^PRSARC02(.PRSFY,PRSNURSE)
105 ;
106 I $G(PRSFY)'>0 S OUT=1 Q
107 S RWREC=$P(PRSFY,U,9)
108 ;
109 ; get range of dates for PRSFY
110 ;
111 S PRSFYRNG=$P(PRSFY,U,5,6)
112 ;
113 S FD=$P(PRSFYRNG,U,1)
114 S LD=$P(PRSFYRNG,U,2)
115 ;
116 ; Build 2 indexes: (1) FMWKS with FMdate subscript = week number and
117 ; (2) WKSFM with week number subscript = FMdate (1st day of week)
118 ;
119 D FYWEEKS^PRSARC04(.FMWKS,PRSFY,0)
120 D FYWEEKS^PRSARC04(.WKSFM,PRSFY,1)
121 ;
122 ; use existing AWS Start Date if it exist otherwise
123 ; ask if AWS will cover entire fiscal year?
124 ;
125 ;code for setting continuous recess for new records
126 N NEWREC S NEWREC=0
127 ;
128 S PRSDT=$P(PRSFY,U,11)
129 I PRSDT'>0 D
130 . ;code for setting continuous recess for new records
131 . S NEWREC=1
132 .;
133 . S ALLFY=$$ALLFYAWS^PRSARC04()
134 . I ALLFY<0 D
135 .. S OUT=1 K PRSFY
136 . E D
137 .. I ALLFY=1 D
138 ... S PRSDT=FD
139 .. E D
140 ... S PRSDT=$$AWSTART^PRSARC03(FD,LD,"Enter Date 9 mo. AWS begins")
141 ... I PRSDT=0 S OUT=1 K PRSFY
142 . I 'OUT D
143 ..; convert start to 1st day of pp and
144 ..; update the PRSFY var with new start date info
145 .. N D1,DAY,PPI,PPE S D1=PRSDT D PP^PRSAPPU
146 .. I DAY'=1 N X1,X2,X,%H S X1=D1,X2=-(DAY-1) D C^%DTC S PRSDT=X
147 .. S $P(PRSFY,U,12)=PPE
148 .. S $P(PRSFY,U,10)=$E(PRSDT,4,5)_"/"_$E(PRSDT,6,7)_"/"_$E(PRSDT,2,3)
149 .. S $P(PRSFY,U,11)=PRSDT
150 Q:OUT
151 ;
152 S PRSFSCYR=$$GETFSCYR^PRSARC04(PRSDT)
153 ;
154 ;GET total available hours based on fiscal year and start date.
155 ;
156 S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
157 ;code for setting continuous recess for new records
158 I NEWREC S PRSAUTOR=$$AUTOREC^PRSARC09(PRSDT,LD)
159 ;
160 Q
161 ;
162HDR ; -- header code
163 N NAME,SSN,TLE,PAD
164 S NAME=$E($P(PRSNURSE,U,2),1,30)
165 S SSN=$P(PRSNURSE,U,5)
166 S TLE=$P(PRSNURSE,U,4)
167 S VALMHDR(1)=$P(PRSFSCYR,U,2)_" Recess Week "_$S($G(PRSVIEW):"Viewer",1:"Editor")_" for 9 month AWS with start date "_$P(PRSFY,U,10)_" (pp "_$P(PRSFY,U,12)_")"
168 S PAD=$E(" ",1,31-$L(NAME))
169 S VALMHDR(2)=NAME_PAD_SSN_" T&L Unit: "_TLE
170 Q
171 ;
172INIT ; -- init variables and list array
173 ;
174 ; PRSLSTRT = what week the list starts with. So if the schedule
175 ; begins in the 13th week of the fiscal year, this var
176 ; would be 13 and the first selectable item in the list.
177 ; PRSWKLST = increment counter for items in the list that are #ed
178 ; and thus selectable. when init is done calling main this
179 ; should be set to week # of the last week in the FY.
180 ; LINE = counter of all items in list, incl. non selectable items
181 ; such as month headings.
182 ;
183 Q:$G(PRSOUT)=1
184 N LISTI,LINE,FIRSTRW
185 S (LISTI,LINE)=0
186 K ^TMP("PRSARC",$J) ; array-all items in list, incl. non selectable
187 ; items such as month headings.
188 K ^TMP("PRSLI",$J) ; index of all selectable items in the list.
189 K ^TMP("PRSSW",$J) ; index of items selected as recess weeks.
190 K ^TMP("PRSRW",$J) ; index of recess weeks with hours.
191 D MAIN^PRSARC06(.PRSLSTRT,.LISTI,.LINE,PRSDT,PRSFYRNG)
192 S PRSWKLST=LISTI-1
193 S VALMCNT=LINE
194 ;
195 ; add recess hours to screen and PRSRW array if they exist
196 ;
197 S RWREC=$P(PRSFY,U,9)
198 I RWREC>0 D GETFLWKS^PRSARC03(RWREC,PRSDT)
199 ;
200 ; add recess hours if user elected to auto populated recess and start
201 ; list display at that week
202 ;
203 I +$G(PRSAUTOR)>0 D ADDAUTOR^PRSARC09(PRSAUTOR)
204 S FIRSTRW=$O(^TMP("PRSRW",$J,0))
205 I $G(FIRSTRW)>0 S FIRSTRW=+^TMP("PRSRW",$J,FIRSTRW) I $G(FIRSTRW)>3 S VALMBG=FIRSTRW-1
206 ;
207 ; get timecard posted recess that's certified
208 D RPOSTED^PRSARC03
209 Q
210 ;
211HELP ; -- help code
212 N DIR
213 I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
214 D FULL^VALM1
215 W !!,"The following actions are available:"
216 W !," GH Recess Hours Summary - recess weeks and hours summary with totals."
217 I $G(PRSVIEW)'=1 D
218 .W !," SE Select Recess Weeks - select weeks and add/edit recess hours."
219 .W !," EH Edit Recess Hours - edit recess hours for each selected week."
220 .W !," CR Cancel Recess Weeks - remove recess hours from selected weeks."
221 .W !," NS Change AWS Start - change pay period when the AWS becomes effective."
222 .W !," HE Help - Get more detailed help about the available actions."
223 .W !," SV Save Recess Schedule - save any edits and continue editing."
224 .W !," QU Quit without Saving - exit without saving changes."
225 .W !," EX Exit and Save Recess - file changes to recess schedule and exit."
226 I $D(DIR("A")) D ^DIR
227 S VALMBCK="R"
228 Q
229 ;
230EXIT ; -- exit code
231 D FULL^VALM1
232 I +$G(PRSFY) D VALIDRS^PRSARCS
233 I '$G(PRSVIEW) D
234 . L -^PRST(458.8,+$G(PRSNURSE))
235 . I +$G(PRSFY) D ALLOKEY^PRSARC04(+$G(PRSNURSE))
236 ;
237 K ^TMP("PRSARC",$J),^TMP("PRSLI",$J),^TMP("PRSRW",$J),^TMP("PRSSW",$J)
238 K PRSFYRNG,PRSFSCYR,PRSWKLST,PRSLSTRT,PRSFY,PRSNURSE
239 K PRSVIEW,PRSOUT,PRSRWHRS,PRSDT,PRSVONLY,PRSAUTOR
240 K FMWKS,WKSFM,RWREC
241 ; clean up vars from PRS calls outside of Recess Tracking
242 K C0,FLX,A1,DAY,AC,DAY,PP,PMP,STOP,T1,T2,Z1,TESTINPP
243 Q
244 ;
245EXPND ; -- expand code
246 Q
247 ;
Note: See TracBrowser for help on using the repository browser.