Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSATP5

PRSATP5.m

Go to the documentation of this file.
  1. PRSATP5 ;HISC/MGD-Timekeeper Post Absence ;04/18/06
  1. ;;4.0;PAID;**102,108**;Sep 21, 1995
  1. ;
  1. CNV96(TDATA,NSEG,ARRAY,ZERO,DADRFM) ;
  1. ; Convert the external representation of the start/stop time to
  1. ; its 1 - 192 piece equivalent
  1. ;
  1. ; Input:
  1. ; TDATA - Time segments to operate on passed by reference
  1. ; NSEG - Number of Segments per start/stop time entry
  1. ; 3 for tours, 4 for exceptions
  1. ; ARRAY - Name of ordered array to create
  1. ; 1st char - P = Prior (to holiday)
  1. ; H = Holiday
  1. ; N = Next day after holiday
  1. ; 2nd char - T = Tour segments
  1. ; E = Exception segments, does not include segments
  1. ; that define periods of On-Call
  1. ; O = Segments that define periods of On-Call
  1. ; Could have come from Tour(s) or Exceptions
  1. ; C = Segments of work performed during periods
  1. ; of On-Call
  1. ; Format for all arrays
  1. ; ARRAY(START)=START^STOP^TOT
  1. ; Note: Exceptions arrays (PE, HE, NE) will contain the
  1. ; Remarks Code as the 4th piece of DATA
  1. ; Exceptions(START)=START^STOP^TOT^RC
  1. ;
  1. ; ZERO - 0 node of day being processed
  1. ;
  1. ; DADRFM - variable needed for tracking of tours that
  1. ; cross midnight. Passed by reference and may
  1. ; be changed.
  1. ;
  1. Q:TDATA=""
  1. N D,FLAG,K,LAST,K1,N,N1,N14,NDAY,QT,V,X,Y,Y1,Z
  1. S N=$S(NSEG=4:2,1:1)
  1. D CNV,COA
  1. Q
  1. ;
  1. ; The CNV code was copied from PRS8SU and modified to fit
  1. ; out needs
  1. ;
  1. ; loop thru data nodes for day
  1. CNV S D(0)=ZERO,Z=TDATA,N1=NSEG,(N14,NDAY,LAST,QT)=0
  1. ;
  1. ; process tour and work nodes by looping thru postings in the node
  1. F K=1:N1 S V=$P(Z,"^",K,K+1) Q:QT D
  1. .S X=$P(Z,U,K,999)
  1. .S:X?1"^"."^"!(X="")!(N14=1) QT=1
  1. .I QT!($P(Z,U,K)="") Q
  1. .;
  1. .S:K=1 (NDAY,LAST)=0
  1. .;
  1. .; process start time and stop time for posting in node
  1. .F K1=1,2 S X=$P(V,"^",K1),(Y,Y1)=K1-1 I X'="" D
  1. ..;
  1. ..; when a tour exception (N=2) start time (K1=1) is being processed
  1. ..; determine if LAST should be reset (FLAG). If LAST is reset then
  1. ..; the start time of the tour exception will initially be placed
  1. ..; in the current day (X'>96) instead of the following day (X>96)
  1. ..S FLAG=1
  1. ..I N=2&(K1=1)&("^HW^"[("^"_$P(Z,"^",K+2)_"^")) D
  1. ...S FLAG=$S(NDAY=1!(LAST>96)&("^HW^"[("^"_$P(Z,"^",K+2)_"^"))&((X["A")!(X["MID")):0,1:1),NDAY=0
  1. ..S:$P(D(0),"^",14)'=""&(X="MID")&(LAST=96)&(N=2)&(K1=1) FLAG=0
  1. ..S:N=2&(K1=1)&(FLAG=1) (NDAY,LAST)=0
  1. ..;
  1. ..S Y=K1-1 D 15^PRS8SU ; determine number (1-192) corresponding to time
  1. ..;
  1. ..; if some tour exceptions (such as leave) are not within a sched.
  1. ..; tour then they must be for the following day (i.e. 2-day tour)
  1. ..I N=2,"^RG^OT^CT^ON^SB^HW^"'[("^"_$P(Z,"^",K+2)_"^") D
  1. ...S Y=+$O(DADRFM("S",(-X-.01))),Y1=+$O(DADRFM("F",(X-.01)))
  1. ...I $G(DADRFM("S",Y))'=$G(DADRFM("F",Y1)) S X=X+96
  1. ...;
  1. ..S $P(Z,"^",K+(K1-1))=X ; replace time by number
  1. ..;
  1. ..; save scheduled tour start and stop times for later use when
  1. ..; placing some tour exceptions on correct day for 2-day tours
  1. ..I K1=1,N=1!(N=4) S DADRFM("S",-X)=DADRFM
  1. ..I K1=2,N=1!(N=4) S DADRFM("F",X)=DADRFM,DADRFM=DADRFM+1
  1. ..;
  1. ..; End of code copied from PRS8SU
  1. ..S $P(TDATA,U,K+(K1-1))=X
  1. Q
  1. ;
  1. ; Create ordered arrays
  1. COA N ARY,RC,SEG,STI,STOP,STRT,TOT
  1. S RC=""
  1. F SEG=0:1:6 D
  1. .S STRT=$P(TDATA,U,(SEG*NSEG)+1)
  1. .Q:STRT=""
  1. .S STOP=$P(TDATA,U,(SEG*NSEG)+2),TOT=$P(TDATA,U,(SEG*NSEG)+3)
  1. .; For Node1 & Node4 TOT will be numeric so we will need to get
  1. .; its external representation (2 character string)
  1. .; For Node2 TOT will be a 2 character string
  1. .I NSEG=4 S RC=$P(TDATA,U,(SEG*NSEG)+4)
  1. .S STI="" ; Special Tour Indicator
  1. .I NSEG=3,TOT S STI=$P($G(^PRST(457.2,TOT,0)),U,2)
  1. .;
  1. .; Don't set exceptions defining periods of On-Call into Exception array
  1. .I $E(ARRAY,2)="E",TOT'="ON" D
  1. ..S @ARRAY@(STRT)=STRT_U_STOP_U_TOT_U_RC
  1. .;
  1. .; Set only Reg segments of tour where the Special Tour Indicator
  1. .; is "" or RG into the Tour array
  1. .I $E(ARRAY,2)="T" D
  1. ..I TOT="" S @ARRAY@(STRT)=STRT_U_STOP_U_TOT
  1. ..I STI="RG" S @ARRAY@(STRT)=STRT_U_STOP_U_TOT
  1. .;
  1. .; Only set segments that define On-Call into On-Call array
  1. .I TOT="ON"!(STI="ON") D
  1. ..S TOT=$S(TOT'="":TOT,1:STI)
  1. ..S ARY=$E(ARRAY,1)_"O" S @ARY@(STRT)=STRT_U_STOP_U_TOT
  1. .;
  1. .; Only segments of work get in the Call-Back
  1. .I "^RG^OT^CT^"[("^"_TOT_"^") D
  1. .. S ARY=$E(ARRAY,1)_"C" S @ARY@(STRT)=STRT_U_STOP_U_TOT
  1. Q
  1. ;
  1. GETPPP(PPIP,DFN,WDAY,BACK,QUIT) ;
  1. ; Set appropriate variables for prior pay period
  1. ; Input:
  1. ; PPIP - Internal format of current pay period
  1. ; DFN - IEN of employee
  1. ; WDAY - Day currently being examined
  1. ; QUIT - Null
  1. ;
  1. ; Output:
  1. ; PPIP - IEN of Prior Pay Period
  1. ; WDAY - Set to last day of prior pay period
  1. ; BACK - Counter for number of pay period looked back
  1. ; QUIT - Will be set to 1 if there is no timecard for
  1. ; the employee in the prior pay period
  1. ;
  1. S PPIP=$O(^PRST(458,PPIP),-1) ; Get Prior PP
  1. I 'PPIP S QUIT=1 Q ; No prior pay period on file
  1. ; Check for employee timecard in this PP
  1. I '$D(^PRST(458,PPIP,"E",DFN,0)) S QUIT=1 Q
  1. S WDAY=14,BACK=BACK+1
  1. Q
  1. ;
  1. GETNPP(PPIN,DFN,WDAY,NEXT,QUIT) ;
  1. ; Set appropriate variables for next pay period
  1. ; Input:
  1. ; PPIN - Internal format of current pay period
  1. ; DFN - IEN of employee
  1. ; WDAY - Day currently being examined
  1. ; QUIT - Null
  1. ;
  1. ; Output:
  1. ; PPIN - IEN of Next Pay Period
  1. ; WDAY - Set to first day of next pay period
  1. ; BACK - Counter for number of pay period looked forward
  1. ; QUIT - Will be set to 1 if there is no timecard for
  1. ; the employee in the next pay period
  1. ;
  1. S PPIN=$O(^PRST(458,PPIN)) ; Get next PP
  1. I 'PPIN S QUIT=1 Q ; Next pay period not on file
  1. ; Check for employee timecard in this PP
  1. I '$D(^PRST(458,PPIN,"E",DFN,0)) S QUIT=1 Q
  1. S WDAY=1,NEXT=NEXT+1
  1. Q