source: FOIAVistA/trunk/r/PAID-PRS/PRSAOTTF.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1PRSAOTTF ;WCIOFO/JAH-OVERTIME WARNINGS FILER--8/18/98
2 ;;4.0;PAID;**43**;Sep 21, 1995
3 ; = = = = = = = = = = = = = = = = =
4 ;
5FILEOTW(PPI,DFN,WK,O8,OA) ;Add an overtime warning (OTW) to 458.6
6 ; Input: PPI--pay period (pp) ien from 458
7 ; DFN--employee ien in 450 who has more calc ot than approved
8 ; WK--week 1 or 2 of pp
9 ; O8--overtime (OT) in 8b string
10 ; OA--ot in requests file w/ approved status
11 ; (O8 and OA are totals for the range covered by PPI and WK)
12 ;
13 N IEN,DA,X,DIC,DLAYGO
14 Q:(PPI'>0)!(DFN'>0)!(WK<1)!(WK>2)!(O8<0)!(O8>99)!(OA<0)!(OA>99)
15 ;
16 ;Overwrite existing warning.
17 ;
18 S IEN=$$WRNEXIST(PPI,DFN,WK)
19 I IEN D
20 . S DIE="^PRST(458.6,",DA=IEN,DR="7///^S X=O8;8///^S X=OA"
21 . L +^PRST(458.6,IEN):5 D ^DIE L -^PRST(458.6,IEN)
22 Q:IEN
23 ;
24 ;For new warnings, use next available entry.
25 ;Lock header node so that 2 supervisors approving records
26 ;with warnings will not get the same ien to use for the warning.
27 ;
28 L +^PRST(458.6,0):10 I $T S IEN=$$NEXTWRN()
29 Q:'IEN
30 ;
31 ; unlock header and quit if can't lock record
32 L +^PRST(458.6,IEN):0
33 I '$T L -^PRST(458.6,0) Q
34 ;
35 S DIC="^PRST(458.6,",DIC(0)="L",DLAYGO=458.6,(DA,X)=IEN
36 S DIC("DR")="1///^S X=DFN;2///^S X=PPI;3///^S X=WK;7///^S X=O8;8///^S X=OA"
37 K DD,DO D FILE^DICN
38 L -^PRST(458.6,IEN)
39 L -^PRST(458.6,0)
40 Q
41 ;
42 ; = = = = = = = = = = = = = = = = =
43 ;
44WRNEXIST(PPI,DFN,WK) ;
45 ;return ien from 458.6 if OTW exists 4 this employ, PP and week
46 ;otherwise return false.
47 ;
48 N REC,TMPIEN,IEN
49 S U="^"
50 S (TMPIEN,IEN)=0
51 F S TMPIEN=$O(^PRST(458.6,"C",PPI,TMPIEN)) Q:TMPIEN'>0!(IEN) D
52 . S REC=$G(^PRST(458.6,TMPIEN,0))
53 . I $P(REC,U,2)=DFN,$P(REC,U,4)=WK S IEN=TMPIEN
54 Q IEN
55 ;
56 ; = = = = = = = = = = = = = = = = =
57 ;
58NEXTWRN() ;
59 ;find last entry in file and increment. if no entries start at 1.
60 N IEN S IEN=+$P(^PRST(458.6,0),"^",3)+1
61 ;
62 ;ensure entry is valid. if not loop increments and checks until an
63 ;available spot is found.
64 F Q:'$D(^PRST(458.6,IEN,0)) S IEN=IEN+1
65 Q IEN
66 ;
67 ; = = = = = = = = = = = = = = = = =
68 ;
69STATCHNG(IEN,STAT) ;OTW STATUS CHANGE BOOLEAN FUNCTION
70 ; WARNING: called from Mumps x-ref (AC) on STATUS field in 458.6
71 ; Extrinsic function checks if status currently being set is different
72 ; from existing status.
73 ; INPUT: IEN - record # in OTW file.
74 ; STAT - value that the STATUS field is being set to. (i.e
75 ; X is defined in the calling x-ref. code.)
76 ; OUTPUT: returns true if new and existing STATUS is different, false
77 ; otherwise.
78 ;
79 N ACT,CLR,OLDSTAT
80 S (RET,ACT,CLR)=0
81 ;ensure we have a record # and a new status of active or cleared.
82 Q:$G(IEN)'>0!(($G(STAT)'="A")&($G(STAT)'="C")) RET
83 ;
84 ; look at "E" x-ref of status field to determine if the OT warning is
85 ; active or inactive.
86 ;
87 S ACT=$D(^PRST(458.6,"E","A",IEN))
88 S CLR=$D(^PRST(458.6,"E","C",IEN))
89 S OLDSTAT=$S(ACT:"A",CLR:"C",1:"")
90 S RET=$S(OLDSTAT'=STAT:1,1:0)
91 ;
92 Q RET
93 ;
94 ; = = = = = = = = = = = = = = = = =
95 ;
96CLRXREF(IEN) ;
97 ; set LAST UPDATED BY field in file 458.6 when the status field is
98 ; changed. Use global set since this function is being called from
99 ; X-ref and potentially via DIE call in CLEAR^PRSAOTTF.
100 ;
101 ; ensure current users DUZ is defined and we have an OT warning.
102 Q:($G(DUZ)'>0)!('$D(^PRST(458.6,$G(IEN),0)))
103 ;
104 S $P(^PRST(458.6,IEN,0),"^",6)=DUZ
105 ;
106 Q
107 ;
108 ; = = = = = = = = = = = = = = = = =
109 ;
110EXIT ; -- exit code
111 D CLEAR^VALM1 K ^TMP("PRSOTW",$J),^TMP("PRSOTR",$J)
112 K PRSIEN,PRSOUT,PRSWPP,PRSWPPI,PRSWSTAT,PRSWSTAT
113 K PRSRREC,PRSRPPI,PRSRPPE,PRSREMP,PRSRWK,PRSRNM
114 K PRSCREC
115 Q
Note: See TracBrowser for help on using the repository browser.