source: FOIAVistA/trunk/r/PAID-PRS/PRSXP43.m@ 1683

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1PRSXP43 ;WCIOFO/JAH-POST INIT FOR PATCH 43 OT WARNINGS--8/18/98
2 ;;4.0;PAID;**43**;Sep 21, 1995
3 ;PAID
4 ; Post install loops thru the pay period (pp) file (458) & looks for
5 ; situations where an overtime warning should appear on the Pay Period
6 ; Exceptions report. If such condition occurs, warning is filed in the
7 ; file 458.6 (OVERTIME WARNINGS)--new with patch 43 & used to maintain
8 ; status of overtime warnings. Payroll may later clear warnings
9 ; thru the new option Overtime Warnings.
10 Q
11 ;
12SERCH4OT ;
13 N PPSTART,XPDIDTOT,PPI,PPE,PRSDIV,PRSPCT,DFN,OTFLCNT
14 S PPSTART="1998-11",OTFLCNT=0
15 ;quit if patch installed already
16 I $$PATCH^XPDUTL("PRS*4.0*43") D MES^XPDUTL(" OT Warning search skipped. Checked on earlier PRS*4*43 install") Q
17 ;
18 ; update installer of patch with messages about post-install.
19 ;
20 S PPSTART=$O(^PRST(458,"AB",PPSTART))
21 Q:$G(PPSTART)'>0
22 S PPI=$O(^PRST(458,"AB",PPSTART,0))
23 Q:$G(PPI)'>0
24 ;
25 D MES^XPDUTL(" This process may take several minutes.")
26 D MES^XPDUTL(" Estimating # of records to check for overtime (OT) warnings.")
27 S XPDIDTOT=$$TOTAL(PPSTART)
28 S PRSDIV=XPDIDTOT\50 I 'PRSDIV S PRSDIV=1
29 S PRSPCT=0
30 ;
31 D MES^XPDUTL(" OT check--TT8B string vs. request--pay period "_PPSTART_" to present.")
32 ;
33 ; back up PPI to include records from current PPI in loop
34 S PPI=PPI-.1
35 F S PPI=$O(^PRST(458,PPI)) Q:PPI'>0 D
36 .S PPE=$P($G(^PRST(458,PPI,0)),"^")
37 .S DFN=0
38 .F S DFN=$O(^PRST(458,PPI,"E",DFN)) Q:DFN'>0 D
39 .. S PRSPCT=PRSPCT+1 ; # records processed
40 ..; call to KIDS to update %complete bar at bottom of install screen.
41 .. I '(PRSPCT#PRSDIV),(PRSPCT<XPDIDTOT) D UPDATE^XPDID(PRSPCT)
42 ..;
43 .. Q:'$D(^PRST(458,PPI,"E",DFN,"D",0))
44 ..;
45 ..; If timecard does not have a status of (T)imekeeper.
46 ..; and there is a TT8b string on file.
47 ..; Compare OT that's been calculated in the
48 ..; TT8B to that which is approved in the request file.
49 ..;
50 .. N TT8B,STATUS,WEEK,OT8B,OTAPP
51 .. S TT8B=$G(^PRST(458,PPI,"E",DFN,5)),STATUS=$P($G(^(0)),"^",2)
52 .. Q:(STATUS="T")!(TT8B="")
53 .. F WEEK=1:1:2 D
54 ... D GETOTS^PRSAOTT(PPE,DFN,TT8B,WEEK,.OT8B,.OTAPP)
55 ... I OTAPP<OT8B D
56 .... D FILEOTW^PRSAOTTF(PPI,DFN,WEEK,OT8B,OTAPP)
57 .... S OTFLCNT=OTFLCNT+1
58 D UPDATE^XPDID(XPDIDTOT)
59 D MES^XPDUTL(" "_OTFLCNT_" overtime warnings filed in 458.6")
60 D MES^XPDUTL(" Please delete routine PRSXP43 when installation is complete.")
61 Q
62TOTAL(PPE4Y) ;ESTIMATE TOTAL RECORDS TO EXAM DURING POST INIT
63 ; Get # of records for 1 pay period (pp) & multiply by # of pps on
64 ; file from pp passed in. This total estimates records to
65 ; process during post-install & is used to update KIDS % complete bar.
66 ; INPUT: pp in 4 digit year format
67 ; LOCAL: PPS = # pps from PPE4Y to present
68 ; PPE = pp external. PPI = pp ien. DFN = timecard ien
69 ; OUTPUT: TOT = estimated timecards from pp passed (PPE4Y)- present
70 ;
71 S TOT=0
72 N PPS,PPE,PPI,DFN
73 S PPS=1,PPE=PPE4Y
74 F S PPE=$O(^PRST(458,"AB",PPE)) Q:PPE'>0 S PPS=PPS+1
75 S PPI=$O(^PRST(458,"AB",PPE4Y,0))
76 ;
77 Q:$G(PPI)'>0 TOT
78 S TOT=$P($G(^PRST(458,PPI,"E",0)),"^",4)
79 I TOT'>0 D
80 . S DFN=0 F S DFN=$O(^PRST(458,PPI,"E",DFN)) Q:DFN'>0 S TOT=TOT+1
81 S TOT=TOT*PPS
82 Q TOT
83 ;
Note: See TracBrowser for help on using the repository browser.