source: WorldVistAEHR/trunk/r/PAID-PRS/PRSATP5.m@ 1427

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

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1PRSATP5 ;HISC/MGD-Timekeeper Post Absence ;04/18/06
2 ;;4.0;PAID;**102,108**;Sep 21, 1995
3 ;
4CNV96(TDATA,NSEG,ARRAY,ZERO,DADRFM) ;
5 ; Convert the external representation of the start/stop time to
6 ; its 1 - 192 piece equivalent
7 ;
8 ; Input:
9 ; TDATA - Time segments to operate on passed by reference
10 ; NSEG - Number of Segments per start/stop time entry
11 ; 3 for tours, 4 for exceptions
12 ; ARRAY - Name of ordered array to create
13 ; 1st char - P = Prior (to holiday)
14 ; H = Holiday
15 ; N = Next day after holiday
16 ; 2nd char - T = Tour segments
17 ; E = Exception segments, does not include segments
18 ; that define periods of On-Call
19 ; O = Segments that define periods of On-Call
20 ; Could have come from Tour(s) or Exceptions
21 ; C = Segments of work performed during periods
22 ; of On-Call
23 ; Format for all arrays
24 ; ARRAY(START)=START^STOP^TOT
25 ; Note: Exceptions arrays (PE, HE, NE) will contain the
26 ; Remarks Code as the 4th piece of DATA
27 ; Exceptions(START)=START^STOP^TOT^RC
28 ;
29 ; ZERO - 0 node of day being processed
30 ;
31 ; DADRFM - variable needed for tracking of tours that
32 ; cross midnight. Passed by reference and may
33 ; be changed.
34 ;
35 Q:TDATA=""
36 N D,FLAG,K,LAST,K1,N,N1,N14,NDAY,QT,V,X,Y,Y1,Z
37 S N=$S(NSEG=4:2,1:1)
38 D CNV,COA
39 Q
40 ;
41 ; The CNV code was copied from PRS8SU and modified to fit
42 ; out needs
43 ;
44 ; loop thru data nodes for day
45CNV S D(0)=ZERO,Z=TDATA,N1=NSEG,(N14,NDAY,LAST,QT)=0
46 ;
47 ; process tour and work nodes by looping thru postings in the node
48 F K=1:N1 S V=$P(Z,"^",K,K+1) Q:QT D
49 .S X=$P(Z,U,K,999)
50 .S:X?1"^"."^"!(X="")!(N14=1) QT=1
51 .I QT!($P(Z,U,K)="") Q
52 .;
53 .S:K=1 (NDAY,LAST)=0
54 .;
55 .; process start time and stop time for posting in node
56 .F K1=1,2 S X=$P(V,"^",K1),(Y,Y1)=K1-1 I X'="" D
57 ..;
58 ..; when a tour exception (N=2) start time (K1=1) is being processed
59 ..; determine if LAST should be reset (FLAG). If LAST is reset then
60 ..; the start time of the tour exception will initially be placed
61 ..; in the current day (X'>96) instead of the following day (X>96)
62 ..S FLAG=1
63 ..I N=2&(K1=1)&("^HW^"[("^"_$P(Z,"^",K+2)_"^")) D
64 ...S FLAG=$S(NDAY=1!(LAST>96)&("^HW^"[("^"_$P(Z,"^",K+2)_"^"))&((X["A")!(X["MID")):0,1:1),NDAY=0
65 ..S:$P(D(0),"^",14)'=""&(X="MID")&(LAST=96)&(N=2)&(K1=1) FLAG=0
66 ..S:N=2&(K1=1)&(FLAG=1) (NDAY,LAST)=0
67 ..;
68 ..S Y=K1-1 D 15^PRS8SU ; determine number (1-192) corresponding to time
69 ..;
70 ..; if some tour exceptions (such as leave) are not within a sched.
71 ..; tour then they must be for the following day (i.e. 2-day tour)
72 ..I N=2,"^RG^OT^CT^ON^SB^HW^"'[("^"_$P(Z,"^",K+2)_"^") D
73 ...S Y=+$O(DADRFM("S",(-X-.01))),Y1=+$O(DADRFM("F",(X-.01)))
74 ...I $G(DADRFM("S",Y))'=$G(DADRFM("F",Y1)) S X=X+96
75 ...;
76 ..S $P(Z,"^",K+(K1-1))=X ; replace time by number
77 ..;
78 ..; save scheduled tour start and stop times for later use when
79 ..; placing some tour exceptions on correct day for 2-day tours
80 ..I K1=1,N=1!(N=4) S DADRFM("S",-X)=DADRFM
81 ..I K1=2,N=1!(N=4) S DADRFM("F",X)=DADRFM,DADRFM=DADRFM+1
82 ..;
83 ..; End of code copied from PRS8SU
84 ..S $P(TDATA,U,K+(K1-1))=X
85 Q
86 ;
87 ; Create ordered arrays
88COA N ARY,RC,SEG,STI,STOP,STRT,TOT
89 S RC=""
90 F SEG=0:1:6 D
91 .S STRT=$P(TDATA,U,(SEG*NSEG)+1)
92 .Q:STRT=""
93 .S STOP=$P(TDATA,U,(SEG*NSEG)+2),TOT=$P(TDATA,U,(SEG*NSEG)+3)
94 .; For Node1 & Node4 TOT will be numeric so we will need to get
95 .; its external representation (2 character string)
96 .; For Node2 TOT will be a 2 character string
97 .I NSEG=4 S RC=$P(TDATA,U,(SEG*NSEG)+4)
98 .S STI="" ; Special Tour Indicator
99 .I NSEG=3,TOT S STI=$P($G(^PRST(457.2,TOT,0)),U,2)
100 .;
101 .; Don't set exceptions defining periods of On-Call into Exception array
102 .I $E(ARRAY,2)="E",TOT'="ON" D
103 ..S @ARRAY@(STRT)=STRT_U_STOP_U_TOT_U_RC
104 .;
105 .; Set only Reg segments of tour where the Special Tour Indicator
106 .; is "" or RG into the Tour array
107 .I $E(ARRAY,2)="T" D
108 ..I TOT="" S @ARRAY@(STRT)=STRT_U_STOP_U_TOT
109 ..I STI="RG" S @ARRAY@(STRT)=STRT_U_STOP_U_TOT
110 .;
111 .; Only set segments that define On-Call into On-Call array
112 .I TOT="ON"!(STI="ON") D
113 ..S TOT=$S(TOT'="":TOT,1:STI)
114 ..S ARY=$E(ARRAY,1)_"O" S @ARY@(STRT)=STRT_U_STOP_U_TOT
115 .;
116 .; Only segments of work get in the Call-Back
117 .I "^RG^OT^CT^"[("^"_TOT_"^") D
118 .. S ARY=$E(ARRAY,1)_"C" S @ARY@(STRT)=STRT_U_STOP_U_TOT
119 Q
120 ;
121GETPPP(PPIP,DFN,WDAY,BACK,QUIT) ;
122 ; Set appropriate variables for prior pay period
123 ; Input:
124 ; PPIP - Internal format of current pay period
125 ; DFN - IEN of employee
126 ; WDAY - Day currently being examined
127 ; QUIT - Null
128 ;
129 ; Output:
130 ; PPIP - IEN of Prior Pay Period
131 ; WDAY - Set to last day of prior pay period
132 ; BACK - Counter for number of pay period looked back
133 ; QUIT - Will be set to 1 if there is no timecard for
134 ; the employee in the prior pay period
135 ;
136 S PPIP=$O(^PRST(458,PPIP),-1) ; Get Prior PP
137 I 'PPIP S QUIT=1 Q ; No prior pay period on file
138 ; Check for employee timecard in this PP
139 I '$D(^PRST(458,PPIP,"E",DFN,0)) S QUIT=1 Q
140 S WDAY=14,BACK=BACK+1
141 Q
142 ;
143GETNPP(PPIN,DFN,WDAY,NEXT,QUIT) ;
144 ; Set appropriate variables for next pay period
145 ; Input:
146 ; PPIN - Internal format of current pay period
147 ; DFN - IEN of employee
148 ; WDAY - Day currently being examined
149 ; QUIT - Null
150 ;
151 ; Output:
152 ; PPIN - IEN of Next Pay Period
153 ; WDAY - Set to first day of next pay period
154 ; BACK - Counter for number of pay period looked forward
155 ; QUIT - Will be set to 1 if there is no timecard for
156 ; the employee in the next pay period
157 ;
158 S PPIN=$O(^PRST(458,PPIN)) ; Get next PP
159 I 'PPIN S QUIT=1 Q ; Next pay period not on file
160 ; Check for employee timecard in this PP
161 I '$D(^PRST(458,PPIN,"E",DFN,0)) S QUIT=1 Q
162 S WDAY=1,NEXT=NEXT+1
163 Q
Note: See TracBrowser for help on using the repository browser.