- 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 Jan 18, 2025@03:24:57 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