source: FOIAVistA/tag/r/PAID-PRS/PRSLIB00.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1PRSLIB00 ;WOIFO/JAH - PAID LIBRARY - ROUTINES & FUNCTIONS ;01/22/2005
2 ;;4.0;PAID;**25,35,49,57,93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6 ;=====================================================================
7AVAILREC(WHO,GLOBREF,OUT) ;IS RECORD AVAILABLE
8 ;parameters
9 ; WHO indicates type of option attempting the lock (TK or SUP)
10 ; GLOBREF passed by reference - used to return a global name
11 ; OUT passed by reference - used to return results of call to
12 ; $$ASK. Equals 1 if user entered '^' at the prompt.
13 ; Is only defined when employee record could not be locked.
14 ;make sure there is a pay period record for employee & that
15 ;record is not being edited by timekeeper or supervisor.
16 ;
17 ;If record is available, then lock it and store pointer to
18 ;locked record in ^TMP($J,"LOCK" so we can unlock all
19 ;records in ^TMP "queue" upon exit of certification option.
20 ;
21 N MESSAGE,M1,M2,M3,EMPNAME
22 ;
23 ;create message depending on which option is being used to attempt
24 ;to edit record: Supervisory Certification or TimeKeeper posting.
25 ;
26 S M1="-Employee's pay period record locked. "
27 S M2=$S(WHO="SUP":"Timekeeper",WHO="TK":"Supervisor",1:"Another user")
28 S M3=" may be editing or reviewing."
29 S MESSAGE=M1_M2_M3
30 ;
31 ;
32 S GLOBREF="^PRST(458,"_PPI_","_"""E"""_","_DFN_",0)"
33 K OUT
34 S AVAIL=0
35 I $D(^PRST(458,PPI,"E",DFN,0)) D
36 . S EMPNAME=$P($G(^PRSPC(DFN,0)),"^")_" "
37 . I '$$LOCK(GLOBREF) W !!,EMPNAME,!,MESSAGE S OUT=$$ASK^PRSLIB00()
38 . E D
39 .. S ^TMP($J,"LOCK",DFN)=""
40 .. S AVAIL=1
41 Q AVAIL
42 ;====================================================================
43 ;
44 ;===================================================================
45LOCK(GLOBREF) ;INCREMENTALLY LOCK A RECORD
46 ;
47 ;RETURN FALSE IF RECORD ALREADY HAS A LOCK
48 L +@GLOBREF:2 S SUCCESS=$T
49 Q SUCCESS
50 ;
51 ;===================================================================
52 ;
53 ;====================================================================
54 ;
55UNLOCK(GLOBREF) ;INCREMENTALLY UNLOCK A RECORD
56 L -@GLOBREF
57 Q
58 ;
59 ;===================================================================
60 ;
61 ;===================================================================
62ASK(HOLD) ;ask user 2 continue function
63 ;return true (1) if user want's 2 stop, false (0) 2 continue.
64 ;If HOLD defined, use prompt 2 hold display until user hits return.
65 ;If not terminal then, do nothing, return FALSE.
66 ;
67 S STOP=0
68 I $E(IOST,1,2)="C-" D
69 .;
70 .N RESP,DIR S RESP=0
71 .I $G(HOLD) S DIR(0)="EA",DIR("A")="Enter return to continue. "
72 .E S DIR(0)="E"
73 .D ^DIR I Y="" S STOP=0
74 .I $D(DIRUT) S STOP=1
75 Q STOP
76 ;=====================================================================
77BLDYR(NEXT) ;Build year with last digit of year.
78 ;pivot back 2 years and forward 7.
79 ;NEXT is a single digit (0-9). Single digit is assummed 2 b last
80 ;digit in a year. This function takes that digit & finds
81 ;1st yr. including current year that has passed digit in it's
82 ;last position. 4 digit year returned.
83 ;
84 N CNT,CURR,I,ADDYRS,YR,X1,X2,Y,X,RTN
85 S CNT=0
86 S YR=$E(DT,1,3)-2
87 S CURR=$E(YR,3)
88 F I=1:1:10 Q:CURR=NEXT D
89 . S CURR=CURR+1
90 . S CURR=$E(CURR,$L(CURR))
91 . S CNT=CNT+1
92 S ADDYRS=CNT*365
93 S YR=YR_"0601" S X1=YR,X2=ADDYRS D C^%DTC
94 S Y=X D DD^%DT S RTN=$P(Y," ",3)
95 Q RTN
96 ;==================================================================
97LEAPYR(Y) ;boolean function determines if year is leap year.
98 ;INPUT: Y = year in standard 4 digit format.
99 ;OUTPUT: LEAPFLAG = return 1 for leap year, otherwise 0.
100 ;
101 N LEAPFLAG
102 S LEAPFLAG='(Y#4)
103 I '(Y#100) S LEAPFLAG='(Y#400)
104 Q LEAPFLAG
105 ;==================================================================
106MONOGRPH(MSG) ;DISPLAY A MESSAGE (MSG)
107 ;
108 N HAIR,FORHEAD,NOSE,LINE,TOE,TAB1,TAB2,LEN
109 S LEN=$L(MSG)
110 S TAB1=(47-LEN\2)
111 S TAB2=48
112 S HAIR=" /////"
113 S TOE="|_______________________________________________|"
114 S NOSE="| (_) |"
115 S LINE="| |"
116 S FORHEAD=" __________________oOO_(O-O)__OOo_______________"
117 W !!,HAIR,!,FORHEAD,!,NOSE,!,LINE
118 W !,"| ",?TAB1,MSG,?TAB2,"|",!,LINE,!,TOE,!
119 Q
120 ;===================================================================
121 ;=====================================================================
122HUMDRUM(ZZ,INC) ;A SORT OF CLOCK THAT SPINS WHILE LONG PROCESSING IS OCCURRING
123 S ZZ=ZZ+INC I ZZ#1=0 S ZZT=ZZ#9 W $C(13),$S(ZZT=1:"|",ZZT=2:"/",ZZT=3:"-",ZZT=4:"\",ZZT=5:"|",ZZT=6:"/",ZZT=7:"-",ZZT=8:"\",1:"") I ZZ=8 S ZZ=0
124 Q ZZ
125 ;=====================================================================
126 ;
127 Q
128MSSG(MSG) ;Randomly pick a heart warming message
129 ; MSGS = The # of messages in this routine. If u add a message, update
130 N MSGS,CNT
131 S MSGS=8
132 S CNT=$R(MSGS)+1,MSG=$P($TEXT(MSG+CNT),";",2)
133MSG ;
134 ;All Work & No Training, Makes Me a Dull Dude!
135 ;Well Trained Employees, Put Veterans First!
136 ;You Bet, Train a Vet!
137 ;By failing to prepare we prepare to fail.
138 ;Ideas won't work unless you do.
139 ;The future is purchased by the present.
140 ;A smooth sea never made a skillful sailor.
141 ;Don't learn safety rules simply by accident.
142 ;
143 Q
144 ;
145CVTDATE(X,PRSDATE) ;
146 ; Called by the input transform of File 458.1 (LEAVE REQUEST) field
147 ; # 2 From Date and field # 4 To Date.
148 ;
149 ; INPUT: X - is set to the external representation of the date
150 ; selected by the user.
151 ;
152 ; PRSDATE - The variable Z1 is created by Form PRSA LV REQ and
153 ; is passed by the input transform to CVTDATE. This variable
154 ; may not be defined if this field is edited by another
155 ; method. If defined PRSDATE will be the internal FileMan
156 ; representation of the date entered by the user for the
157 ; From Date field. During the To Date field validation,
158 ; PRSDATE will represent the earliest date allowed.
159 ;
160 ; OUTPUT: X - is returned by the function. X will contain either the
161 ; internal FileMan format for the valid date selected by
162 ; the user or the value -1 if an invalid date was selected.
163 ;
164 N FUTYR,PASYR,%DT,BEGINDT,X1,X2,Y
165 ;
166 ; Set %DT to not allow TODATE earlier than FROMDATE. Z1 contains
167 ; the date stored in FROMDATE in the FileMan internal date format.
168 ;
169 I +$P($G(PRSDATE),"^")?7N S %DT(0)=$P(PRSDATE,"^")
170 ;
171 ; Convert user input based on assumed past date lookup.
172 ; Y will contain the user selected date in internal FileMan format.
173 ;
174 S %DT="XP" D ^%DT
175 S PASYR=Y
176 ;
177 ; Convert user input based on assumed future date lookup
178 ; Y will contain the user selected date in internal FileMan format.
179 ;
180 S %DT="XF" D ^%DT
181 S FUTYR=Y
182 ;
183 ; If these two lookups match the user specified a four digit
184 ; year and no extra processing is necessary.
185 ;
186 I PASYR=FUTYR S X=PASYR
187 ;
188 ; If these two lookups don't match then the user did not
189 ; enter a four digit year. That's o.k. but we need to assume that
190 ; they meant either 60 days ago or in the future.
191 ;
192 ; Subtract 60 days from today and test to see if the date the user
193 ; entered falls within this range.
194 ;
195 I PASYR'=FUTYR D
196 .S X1=DT,X2=-60
197 .D C^%DTC
198 .S BEGINDT=X
199 .; Default the date to the past year lookup and begin testing
200 .S X=PASYR
201 .; Perform two checks:
202 .; #1 Does the user entered date fall within that last 60 days?
203 .; If it doesn't execute check #2.
204 .; #2 Does the date falls within the standard +20 year
205 .; time window? If so then default to a future year.
206 .I BEGINDT>PASYR,($E(DT,1,3)+20'<$E(FUTYR,1,3)) S X=FUTYR
207 ;
208 Q X ; Return the user selected date in the FileMan internal date format.
Note: See TracBrowser for help on using the repository browser.