PRSAOTTF ;WCIOFO/JAH-OVERTIME WARNINGS FILER--8/18/98
;;4.0;PAID;**43**;Sep 21, 1995
; = = = = = = = = = = = = = = = = =
;
FILEOTW(PPI,DFN,WK,O8,OA) ;Add an overtime warning (OTW) to 458.6
; Input: PPI--pay period (pp) ien from 458
; DFN--employee ien in 450 who has more calc ot than approved
; WK--week 1 or 2 of pp
; O8--overtime (OT) in 8b string
; OA--ot in requests file w/ approved status
; (O8 and OA are totals for the range covered by PPI and WK)
;
N IEN,DA,X,DIC,DLAYGO
Q:(PPI'>0)!(DFN'>0)!(WK<1)!(WK>2)!(O8<0)!(O8>99)!(OA<0)!(OA>99)
;
;Overwrite existing warning.
;
S IEN=$$WRNEXIST(PPI,DFN,WK)
I IEN D
. S DIE="^PRST(458.6,",DA=IEN,DR="7///^S X=O8;8///^S X=OA"
. L +^PRST(458.6,IEN):5 D ^DIE L -^PRST(458.6,IEN)
Q:IEN
;
;For new warnings, use next available entry.
;Lock header node so that 2 supervisors approving records
;with warnings will not get the same ien to use for the warning.
;
L +^PRST(458.6,0):10 I $T S IEN=$$NEXTWRN()
Q:'IEN
;
; unlock header and quit if can't lock record
L +^PRST(458.6,IEN):0
I '$T L -^PRST(458.6,0) Q
;
S DIC="^PRST(458.6,",DIC(0)="L",DLAYGO=458.6,(DA,X)=IEN
S DIC("DR")="1///^S X=DFN;2///^S X=PPI;3///^S X=WK;7///^S X=O8;8///^S X=OA"
K DD,DO D FILE^DICN
L -^PRST(458.6,IEN)
L -^PRST(458.6,0)
Q
;
; = = = = = = = = = = = = = = = = =
;
WRNEXIST(PPI,DFN,WK) ;
;return ien from 458.6 if OTW exists 4 this employ, PP and week
;otherwise return false.
;
N REC,TMPIEN,IEN
S U="^"
S (TMPIEN,IEN)=0
F S TMPIEN=$O(^PRST(458.6,"C",PPI,TMPIEN)) Q:TMPIEN'>0!(IEN) D
. S REC=$G(^PRST(458.6,TMPIEN,0))
. I $P(REC,U,2)=DFN,$P(REC,U,4)=WK S IEN=TMPIEN
Q IEN
;
; = = = = = = = = = = = = = = = = =
;
NEXTWRN() ;
;find last entry in file and increment. if no entries start at 1.
N IEN S IEN=+$P(^PRST(458.6,0),"^",3)+1
;
;ensure entry is valid. if not loop increments and checks until an
;available spot is found.
F Q:'$D(^PRST(458.6,IEN,0)) S IEN=IEN+1
Q IEN
;
; = = = = = = = = = = = = = = = = =
;
STATCHNG(IEN,STAT) ;OTW STATUS CHANGE BOOLEAN FUNCTION
; WARNING: called from Mumps x-ref (AC) on STATUS field in 458.6
; Extrinsic function checks if status currently being set is different
; from existing status.
; INPUT: IEN - record # in OTW file.
; STAT - value that the STATUS field is being set to. (i.e
; X is defined in the calling x-ref. code.)
; OUTPUT: returns true if new and existing STATUS is different, false
; otherwise.
;
N ACT,CLR,OLDSTAT
S (RET,ACT,CLR)=0
;ensure we have a record # and a new status of active or cleared.
Q:$G(IEN)'>0!(($G(STAT)'="A")&($G(STAT)'="C")) RET
;
; look at "E" x-ref of status field to determine if the OT warning is
; active or inactive.
;
S ACT=$D(^PRST(458.6,"E","A",IEN))
S CLR=$D(^PRST(458.6,"E","C",IEN))
S OLDSTAT=$S(ACT:"A",CLR:"C",1:"")
S RET=$S(OLDSTAT'=STAT:1,1:0)
;
Q RET
;
; = = = = = = = = = = = = = = = = =
;
CLRXREF(IEN) ;
; set LAST UPDATED BY field in file 458.6 when the status field is
; changed. Use global set since this function is being called from
; X-ref and potentially via DIE call in CLEAR^PRSAOTTF.
;
; ensure current users DUZ is defined and we have an OT warning.
Q:($G(DUZ)'>0)!('$D(^PRST(458.6,$G(IEN),0)))
;
S $P(^PRST(458.6,IEN,0),"^",6)=DUZ
;
Q
;
; = = = = = = = = = = = = = = = = =
;
EXIT ; -- exit code
D CLEAR^VALM1 K ^TMP("PRSOTW",$J),^TMP("PRSOTR",$J)
K PRSIEN,PRSOUT,PRSWPP,PRSWPPI,PRSWSTAT,PRSWSTAT
K PRSRREC,PRSRPPI,PRSRPPE,PRSREMP,PRSRWK,PRSRNM
K PRSCREC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAOTTF 3701 printed Oct 16, 2024@18:24:32 Page 2
PRSAOTTF ;WCIOFO/JAH-OVERTIME WARNINGS FILER--8/18/98
+1 ;;4.0;PAID;**43**;Sep 21, 1995
+2 ; = = = = = = = = = = = = = = = = =
+3 ;
FILEOTW(PPI,DFN,WK,O8,OA) ;Add an overtime warning (OTW) to 458.6
+1 ; Input: PPI--pay period (pp) ien from 458
+2 ; DFN--employee ien in 450 who has more calc ot than approved
+3 ; WK--week 1 or 2 of pp
+4 ; O8--overtime (OT) in 8b string
+5 ; OA--ot in requests file w/ approved status
+6 ; (O8 and OA are totals for the range covered by PPI and WK)
+7 ;
+8 NEW IEN,DA,X,DIC,DLAYGO
+9 if (PPI'>0)!(DFN'>0)!(WK<1)!(WK>2)!(O8<0)!(O8>99)!(OA<0)!(OA>99)
QUIT
+10 ;
+11 ;Overwrite existing warning.
+12 ;
+13 SET IEN=$$WRNEXIST(PPI,DFN,WK)
+14 IF IEN
Begin DoDot:1
+15 SET DIE="^PRST(458.6,"
SET DA=IEN
SET DR="7///^S X=O8;8///^S X=OA"
+16 LOCK +^PRST(458.6,IEN):5
DO ^DIE
LOCK -^PRST(458.6,IEN)
End DoDot:1
+17 if IEN
QUIT
+18 ;
+19 ;For new warnings, use next available entry.
+20 ;Lock header node so that 2 supervisors approving records
+21 ;with warnings will not get the same ien to use for the warning.
+22 ;
+23 LOCK +^PRST(458.6,0):10
IF $TEST
SET IEN=$$NEXTWRN()
+24 if 'IEN
QUIT
+25 ;
+26 ; unlock header and quit if can't lock record
+27 LOCK +^PRST(458.6,IEN):0
+28 IF '$TEST
LOCK -^PRST(458.6,0)
QUIT
+29 ;
+30 SET DIC="^PRST(458.6,"
SET DIC(0)="L"
SET DLAYGO=458.6
SET (DA,X)=IEN
+31 SET DIC("DR")="1///^S X=DFN;2///^S X=PPI;3///^S X=WK;7///^S X=O8;8///^S X=OA"
+32 KILL DD,DO
DO FILE^DICN
+33 LOCK -^PRST(458.6,IEN)
+34 LOCK -^PRST(458.6,0)
+35 QUIT
+36 ;
+37 ; = = = = = = = = = = = = = = = = =
+38 ;
WRNEXIST(PPI,DFN,WK) ;
+1 ;return ien from 458.6 if OTW exists 4 this employ, PP and week
+2 ;otherwise return false.
+3 ;
+4 NEW REC,TMPIEN,IEN
+5 SET U="^"
+6 SET (TMPIEN,IEN)=0
+7 FOR
SET TMPIEN=$ORDER(^PRST(458.6,"C",PPI,TMPIEN))
if TMPIEN'>0!(IEN)
QUIT
Begin DoDot:1
+8 SET REC=$GET(^PRST(458.6,TMPIEN,0))
+9 IF $PIECE(REC,U,2)=DFN
IF $PIECE(REC,U,4)=WK
SET IEN=TMPIEN
End DoDot:1
+10 QUIT IEN
+11 ;
+12 ; = = = = = = = = = = = = = = = = =
+13 ;
NEXTWRN() ;
+1 ;find last entry in file and increment. if no entries start at 1.
+2 NEW IEN
SET IEN=+$PIECE(^PRST(458.6,0),"^",3)+1
+3 ;
+4 ;ensure entry is valid. if not loop increments and checks until an
+5 ;available spot is found.
+6 FOR
if '$DATA(^PRST(458.6,IEN,0))
QUIT
SET IEN=IEN+1
+7 QUIT IEN
+8 ;
+9 ; = = = = = = = = = = = = = = = = =
+10 ;
STATCHNG(IEN,STAT) ;OTW STATUS CHANGE BOOLEAN FUNCTION
+1 ; WARNING: called from Mumps x-ref (AC) on STATUS field in 458.6
+2 ; Extrinsic function checks if status currently being set is different
+3 ; from existing status.
+4 ; INPUT: IEN - record # in OTW file.
+5 ; STAT - value that the STATUS field is being set to. (i.e
+6 ; X is defined in the calling x-ref. code.)
+7 ; OUTPUT: returns true if new and existing STATUS is different, false
+8 ; otherwise.
+9 ;
+10 NEW ACT,CLR,OLDSTAT
+11 SET (RET,ACT,CLR)=0
+12 ;ensure we have a record # and a new status of active or cleared.
+13 if $GET(IEN)'>0!(($GET(STAT)'="A")&($GET(STAT)'="C"))
QUIT RET
+14 ;
+15 ; look at "E" x-ref of status field to determine if the OT warning is
+16 ; active or inactive.
+17 ;
+18 SET ACT=$DATA(^PRST(458.6,"E","A",IEN))
+19 SET CLR=$DATA(^PRST(458.6,"E","C",IEN))
+20 SET OLDSTAT=$SELECT(ACT:"A",CLR:"C",1:"")
+21 SET RET=$SELECT(OLDSTAT'=STAT:1,1:0)
+22 ;
+23 QUIT RET
+24 ;
+25 ; = = = = = = = = = = = = = = = = =
+26 ;
CLRXREF(IEN) ;
+1 ; set LAST UPDATED BY field in file 458.6 when the status field is
+2 ; changed. Use global set since this function is being called from
+3 ; X-ref and potentially via DIE call in CLEAR^PRSAOTTF.
+4 ;
+5 ; ensure current users DUZ is defined and we have an OT warning.
+6 if ($GET(DUZ)'>0)!('$DATA(^PRST(458.6,$GET(IEN),0)))
QUIT
+7 ;
+8 SET $PIECE(^PRST(458.6,IEN,0),"^",6)=DUZ
+9 ;
+10 QUIT
+11 ;
+12 ; = = = = = = = = = = = = = = = = =
+13 ;
EXIT ; -- exit code
+1 DO CLEAR^VALM1
KILL ^TMP("PRSOTW",$JOB),^TMP("PRSOTR",$JOB)
+2 KILL PRSIEN,PRSOUT,PRSWPP,PRSWPPI,PRSWSTAT,PRSWSTAT
+3 KILL PRSRREC,PRSRPPI,PRSRPPE,PRSREMP,PRSRWK,PRSRNM
+4 KILL PRSCREC
+5 QUIT
