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

PRSARC08.m

Go to the documentation of this file. 
  1. PRSARC08 ;WOIFO/JAH - Tour hours procedure calls ;12/19/06
  1.  ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ;
  1. TRSHFTS(TOURIEN) ; return two piece ^ string with EARLIEST shift special
  1.  ; indicator for a tour 
  1.  ;
  1.  N TOUR,TODSHFT,TOMSHFT,TSEGS,TWODAYTR,I
  1.  N DONE,CROSS,BEG,END,SPIND,BEG24,END24
  1.  Q:$G(TOURIEN)'>0 "^"
  1.  S (TODSHFT,TOMSHFT)="4"
  1.  S TOUR=$G(^PRST(457.1,TOURIEN,0))
  1.  S TSEGS=$G(^PRST(457.1,TOURIEN,1))
  1.  S TWODAYTR=$P(TOUR,U,5)="Y"
  1.  S (DONE,CROSS)=0
  1.  F I=1:3:18 D  Q:DONE
  1.  .  S BEG=$P(TSEGS,U,I)
  1.  .  I BEG="" S DONE=1 Q
  1.  .  S END=$P(TSEGS,U,I+1)
  1.  .  S SPIND=$P(TSEGS,U,I+2) I SPIND="" S SPIND=1
  1.  .  S SPIND=$TR(SPIND,"67","23")
  1.  .  Q:"^1^2^3^"'[("^"_SPIND_"^")
  1.  . ; convert beg and end to twenty four hr to determine if one is
  1.  . ; less than other and hence crosses midnight. You've also
  1.  . ;  crossed midnight if a segment other than first starts at
  1.  . ;  midnight.
  1.  . ; Set CROSS to true so any remaining segments get recorded to
  1.  . ; tomorrow.
  1.  .    S BEG24=$$TWENTY4^PRSPESR2(BEG)
  1.  .    S END24=$$TWENTY4^PRSPESR2(END)
  1.  .    I 'CROSS&((BEG24'<END24)!((I>1)&(BEG24=2400))) D
  1.  ..     S CROSS=1
  1.  ..     I SPIND<TODSHFT S TODSHFT=SPIND
  1.  ..     I SPIND<TOMSHFT S TOMSHFT=SPIND
  1.  .    E  D
  1.  ..     I CROSS D
  1.  ...       I SPIND<TOMSHFT S TOMSHFT=SPIND
  1.  ..     E  D
  1.  ...       I SPIND<TODSHFT S TODSHFT=SPIND
  1.  I TODSHFT=4 S TODSHFT=""
  1.  I TOMSHFT=4 S TOMSHFT=""
  1.  Q TODSHFT_"^"_TOMSHFT
  1.  ;
  1. PLACEML(S1,S2,M) ; Remove meal from hrs on 2 day tour.  Put meal in middle and
  1.  ; remove from today S1 or tomorrow S2.  Function considers only amount
  1.  ; of hrs worked, to indicate in which hr of total hrs meal
  1.  ; would begin.  It doesn't consider where hrs are placed in day.
  1.  ; INPUT:
  1.  ;  S1 = HRS ON DAY 1 (DECIMAL 8.0, 8.5, ETC)
  1.  ;  S2 = HRS ON DAY 2
  1.  ;  M = LENGTH OF MEAL IN DECIMAL FORM .25 HRS, .5 HRS ETC
  1.  ;
  1.  ; ETA deals with quarter hrs so (\.25*.25) will round
  1.  ; down result to quarter hr.
  1.  ;
  1.  I (M>60)!(M<15)!((M#15)'=0) Q S1_"^"_S2
  1.  ; Convert minutes meal to decimal
  1.  N X S X=M D MEALIN^PRSPESR2 S M=.25*X
  1.  N MEALHR,NS1,NS2
  1.  S MEALHR=(S1+S2)/2-(M/2)\.25*.25
  1.  Q:MEALHR'>0 S1_"^"_S2
  1.  ;
  1.  ;  pull meal from S1, S2 or both
  1.  I MEALHR<S1 D
  1.  .  I (MEALHR+M)'>S1 D
  1.  ..   S NS2=S2
  1.  ..   S NS1=S1-M
  1.  .  E  D
  1.  ..   S NS1=S1-(S1-MEALHR)
  1.  ..   S NS2=S2-(M-(S1-MEALHR))
  1.  E  D
  1.  .   S NS1=S1
  1.  .   S NS2=S2-M
  1.  Q NS1_"^"_NS2
  1.  ;
  1. EARLYSH(TH,WAGER) ; LOOP THROUGH ARRAY TO FIND EARLIEST SHIFT
  1.  ;
  1.  N EARLIEST,HRS,SHIFT,TOURDAY
  1.  I WAGER D
  1.  .  S EARLIEST=0
  1.  E  D
  1.  .  S EARLIEST=4
  1.  .  S TOURDAY=0
  1.  .  F  S TOURDAY=$O(TH(TOURDAY)) Q:TOURDAY'>0  D
  1.  ..    S HRS=$P($G(TH(TOURDAY)),U,2)
  1.  ..    Q:HRS'>0
  1.  ..    S SHIFT=$P($G(TH(TOURDAY)),U)
  1.  ..    I SHIFT<EARLIEST S EARLIEST=SHIFT
  1.  I EARLIEST=4 S EARLIEST=""
  1.  Q EARLIEST
  1.  ;
  1. ISWAGE(PRSIEN) ; return true for wage grade 
  1.  I $G(PRSIEN)'>0 Q "0^undefined employee"
  1.  N PAYPLAN,ISWAGE
  1.  S ISWAGE=1
  1.  I '$D(^PRSPC(PRSIEN,0)) Q "0^undefined employee"
  1.  S PAYPLAN=$P($G(^PRSPC(PRSIEN,0)),U,21)
  1.  I "0123456789GU"'[PAYPLAN S ISWAGE=0
  1.  Q ISWAGE
  1.  ;
  1. ISCMPTR(PPI,PRSIEN) ; return true for compressed tours
  1.  ;
  1.  N ISCT S ISCT=0 I $P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,6)="C" S ISCT=1
  1.  Q ISCT
  1.  ;
  1. TOTAL(TH,WKS) ; array loop tallis hrs
  1.  ; INPUT : WKS (optional) 1 for week one total, 2 for week 2 total,
  1.  ;                        otherwise full pay period total.
  1.  N LASTDAY,TOURDAY,TOTAL S TOTAL=0
  1.  S TOURDAY=$S($G(WKS)=2:7,1:0)
  1.  S LASTDAY=$S($G(WKS)=1:7,1:14)
  1.  F  S TOURDAY=$O(TH(TOURDAY)) Q:TOURDAY>LASTDAY!(TOURDAY'>0)  D
  1.  .  S TOTAL=TOTAL+$P($G(TH(TOURDAY)),U,2)
  1.  Q TOTAL
  1.  ;
  1. PARSE(VALMNOD,BEG,END) ; -- Copy from VALM2 split out pre-answers from user
  1.  N Y,J,L,X
  1.  S Y=$TR($P($P(VALMNOD,U,4),"=",2),"/\; .",",,,,,")
  1.  I Y["-" S X=Y,Y="" F I=1:1 S J=$P(X,",",I) Q:J']""  I +J>(BEG-1),+J<(END+1) S:J'["-" Y=Y_J_"," I J["-",+J,+J<+$P(J,"-",2) F L=+J:1:+$P(J,"-",2) I L>(BEG-1),L<(END+1) S Y=Y_L_","
  1.  Q Y