| 1 | PRSARC ;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
|
|---|
| 5 | ENEDIT ; -- 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
|
|---|
| 15 | SUP ;
|
|---|
| 16 | TK ;
|
|---|
| 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
|
|---|
| 31 | HR ;
|
|---|
| 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
|
|---|
| 42 | NURSE ;
|
|---|
| 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
|
|---|
| 62 | ENVIEW ; -- 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 | ;
|
|---|
| 84 | SETUP(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 | ;
|
|---|
| 162 | HDR ; -- 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 | ;
|
|---|
| 172 | INIT ; -- 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 | ;
|
|---|
| 211 | HELP ; -- 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 | ;
|
|---|
| 230 | EXIT ; -- 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 | ;
|
|---|
| 245 | EXPND ; -- expand code
|
|---|
| 246 | Q
|
|---|
| 247 | ;
|
|---|
