source: WorldVistAEHR/trunk/r/PAID-PRS/PRSARC02.m@ 738

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

initial load of WorldVistAEHR
File size: 5.7 KB
Line 
1PRSARC02 ;WOIFO/JAH - Recess Tracking Library Functions ;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
5GETNURSE(NURSE,PRSTLV) ; procedure prompts and screens only 9-month AWS nurses
6 ;
7 ;
8 ; INPUT: PRSTLV - flag to indicate T&L access, 2 for timekeeper
9 ; 3 for
10 ; OUTPUT: NURSE (3 ^ pieces)
11 ; 1) - Nurse IEN from 450 lookup which is screened for
12 ; (DB part-time + NH 80 + pp M) or (recess rec exists)
13 ; 2) Nurse name
14 ; 3) 0 edit only, 1 add and edit
15 ;
16 ; use full screen for initial prompts
17 D FULL^VALM1
18 W @IOF,!!!
19 ;
20 ;Ask T&L unit
21 ;
22 N TLI,TLE,SSN,DUMMY
23 I $G(PRSTLV)'>0 Q -1
24 D ^PRSAUTL
25 I $G(TLE)="" Q -1
26 ;
27 ;Lookup employees screening on t&l, normal hours, duty basis, pay plan
28 ;
29 N DIC,D
30 S DIC("A")="Select AWS NURSE: "
31 S DIC(0)="AEQM"
32 S DIC="^PRSPC("
33 S D="ATL"_TLE
34 S DIC("S")="I $P(^(0),U,8)=TLE,(($P(^(0),U,16)=80)&($P(^(0),U,10)=2)&($P(^(0),U,21)=""M""))!($O(^PRST(458.8,""B"",+Y,0)))"
35 D IX^DIC
36 S NURSE=Y
37 I +NURSE'>0 Q -1
38 ;
39 ; ensure entitlement string returns recess periods set to 1
40 ;
41 N DFN,ENT,ZENT
42 S DFN=+NURSE
43 D ^PRSAENT S ZENT=$S($E(ENT,5):"Recess Periods",1:"")
44 I ZENT="" D
45 . W !!?5,"This nurse is not currently entitled to Recess Periods."
46 . W !?5,"A new FY Recess Record cannot be added, but existing FY"
47 . W !?5,"Recess records may be edited."
48 . W ! S DUMMY=$$ASK^PRSLIB00(1)
49 . S NURSE=NURSE_U_0
50 E D
51 . S NURSE=NURSE_U_1
52 S SSN=$P(^PRSPC(+NURSE,0),U,9),SSN="XXX-XX-"_$E(SSN,6,9)
53 S NURSE=NURSE_U_TLE_U_SSN
54 Q
55 ;
56CHOOSEFY(SELFY,NURSE) ; Build List of FY choices--Last, Current, Next--include
57 ; whether a record exists for that fiscal year already or not
58 ;
59 ; INPUT: NURSE- IEN^NAME^(0 edit only, 1 add and edit)
60 ; if nurse entitled to recess, new rec can be added, else
61 ; only edit existing records allowed.
62 ; OUTPUT: SELFY-selected fiscal year data (11 ^ piece string)
63 ; 1) 4 digit yr 2) ex.FY06-07 3) external 1st day
64 ; 4) external last day 5) FM 1st day 6) FM last day
65 ; 7) first pp 8) last pp 9) 458.8 IEN if exists
66 ; 10) ext AWS start date 11) FM date AWS start
67 ; 12) AWS start pay period
68 ;
69 ; example:
70 ; 2007^FY06-07^10/01/06^10/13/07^3061001^3071013^06-20^07-20^1
71 ; ^11/12/06^3061112^06-23
72 ;
73 ; entitled to Recess
74 N RENT,FYA,FYSA
75 S RENT=$P(NURSE,U,3)
76 ;
77 ; check to see if any Schedules are on file for this Nurse
78 ;
79 D FIND^DIC(458.8,,".01;1;1.1","Q",+NURSE,"AC",,,,"FYA")
80 ;
81 ; get current next and last
82 ;
83 D PRMPTARY
84 ;
85 ; if there are no editable records in the range and the Nurse
86 ; isn't entitled then the gig is up.
87 ;
88 I 'RENT&($P(FYSA(1),U,9)=""&($P(FYSA(2),U,9)="")&($P(FYSA(3),U,9)="")) D Q
89 . W !,$P(NURSE,U,2)," has no AWS schedules in the current, next or last fiscal years."
90 ;
91 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,CHOICE,CH,DIRUT
92 S DIR(0)=$$BLDDIR(.FYSA,.CHOICE,RENT)
93 S CH=CHOICE
94 I $L(CHOICE)=3 S CH=$E(CHOICE,1)_", "_$E(CHOICE,2)_" or "_$E(CHOICE,3)
95 E I $L(CHOICE)=2 S CH=$E(CHOICE,1)_" or "_$E(CHOICE,2)
96 S DIR("?")=" Enter "_CH_" to "_$S(RENT:"add or edit",1:"edit")_" the recess schedule for that fiscal year."
97 S DIR("?",1)=" Edit a fiscal year by entering the code on the left."
98 S DIR("?",2)=" The available choices for editing a 9 month AWS"
99 S DIR("?",3)=" recess record are limited to the current, next and last"
100 S DIR("?",4)=" fiscal years. If the nurse has an AWS record on file"
101 S DIR("?",5)=" for the current, next or last fiscal year then the"
102 S DIR("?",6)=" record may be edited. To add a new schedule the nurse"
103 S DIR("?",7)=" must have a pay plan of M, a duty basis of part-time"
104 S DIR("?",8)=" and normal Hours equal to 80."
105 S DIR("A")="Select fiscal year"
106 S DIR("B")=$E(CHOICE,1)
107 D ^DIR
108 I $D(DIRUT) S SELFY=0
109 E S SELFY=FYSA($S(Y="C":1,Y="N":2,1:3))
110 Q
111 ;
112PRMPTARY ; Build array w/fiscal year selections to edit
113 N FY,CNT,REC,FOUND,ST,EN,RANGE,RWIEN,CUR,CUR4Y,EXTRANGE,PPE,STDT
114 N X,TMPDT,EXTSTDT,LAS,LAS4Y,NEX,NEX4Y
115 S CUR=$$GETFSCYR^PRSARC04(DT)
116 S CUR4Y=+$E(CUR,1,3)
117 S TMPDT=CUR4Y+1_"0101"
118 S NEX=$$GETFSCYR^PRSARC04(TMPDT)
119 S NEX4Y=+$E(NEX,1,3)
120 S TMPDT=NEX4Y-2_"0101"
121 S LAS=$$GETFSCYR^PRSARC04(TMPDT)
122 S LAS4Y=+$E(LAS,1,3)
123 S CUR4Y=CUR4Y+1700
124 S NEX4Y=NEX4Y+1700
125 S LAS4Y=LAS4Y+1700
126 ;
127 S CNT=0
128 F FY=CUR4Y,NEX4Y,LAS4Y D
129 . S CNT=CNT+1
130 . S (REC,FOUND)=0
131 . F S REC=$O(FYA("DILIST","ID",REC)) Q:REC'>0!(FOUND) D
132 .. I FYA("DILIST","ID",REC,1)=FY S FOUND=REC,RWIEN=FYA("DILIST",2,REC)
133 . S RANGE=$$FYDAYS^PRSARC04(FY)
134 . S ST=$P(RANGE,U)
135 . S EN=$P(RANGE,U,2)
136 . S ST=$E(ST,4,5)_"/"_$E(ST,6,7)_"/"_$E(ST,2,3)
137 . S EN=$E(EN,4,5)_"/"_$E(EN,6,7)_"/"_$E(EN,2,3)
138 . S EXTRANGE=ST_U_EN
139 . S FYSA(CNT)=$S(CNT=2:NEX4Y,CNT=1:CUR4Y,1:LAS4Y)
140 . S FYSA(CNT)=FYSA(CNT)_U_$P($S(CNT=2:NEX,CNT=1:CUR,1:LAS),U,3)_U_EXTRANGE_U_RANGE
141 . I FOUND D
142 .. ;convert start date to mm/dd/yy
143 .. S X=$G(FYA("DILIST","ID",FOUND,1.1))
144 .. D ^%DT
145 .. S STDT=Y
146 .. N D1 S D1=STDT D PP^PRSAPPU
147 .. S EXTSTDT=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
148 .. S FYSA(CNT)=FYSA(CNT)_U_RWIEN_U_EXTSTDT_U_STDT_U_PPE
149 . E D
150 .. S FYSA(CNT)=FYSA(CNT)_U_U_U
151 ;
152 Q
153BLDDIR(FYSA,CHOICES,RENT) ; Put Set of Codes for DIR into DIR(0) format
154 I '$D(FYSA) W !,"Error: no fiscal year data!",!! Q
155 ;
156 N CNT,CI,SOC,AW,SELI,NR
157 S CNT=0
158 S NR="-has no existing record."
159 S AW="-has AWS start date "
160 ;
161 ; SOC -set of codes
162 ;
163 N SOC S SOC="",CHOICES=""
164 F SELI="Current","Next","Last" D
165 . S CNT=CNT+1
166 . S CI=$G(FYSA(CNT))
167 . Q:RENT=0&($P(CI,U,9)="")
168 . S CHOICES=CHOICES_$S(CNT=1:"C",CNT=2:"N",1:"L")
169 . I SOC="" D
170 .. S SOC="S^"_$S(CNT=1:"C:",CNT=2:"N:",1:"L:")
171 . E D
172 .. S SOC=SOC_$S(CNT=2:";N:",1:";L:")
173 . S SOC=SOC_SELI_" FY"_$P(CI,U,1)_" begins "_$P(CI,U,3)_$S($P(CI,U,9)'="":AW_$P(CI,U,10),1:NR)
174 Q SOC
Note: See TracBrowser for help on using the repository browser.