source: WorldVistAEHR/trunk/r/PAID-PRS/PRSRL1.m@ 1720

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

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1PRSRL1 ;HISC/JH,WCIOFO/JAH,SAB-ONE OR ALL EMPLOYEE LEAVE USE REPORT. ;7-AUG-2000
2 ;;4.0;PAID;**2,5,17,19,35,39,61**;Sep 21, 1995
3EMP ; employee entry point
4 D DUZ^PRSRUTL G Q:'PRSRDUZ
5 S DIC="^PRSPC(",DIC(0)="NZ",X=PRSRDUZ D ^DIC G Q1:Y=-1
6 S SW=0,SW(4)=1,PRSR=3,PRSRY=Y,PRSRY1=$S($D(Y(0)):Y(0),1:"")
7 S D0=$P(PRSRY,U),NAM=$P(Y(0),U),TLE=$P(Y(0),U,8),PRSRSSN=$P(Y(0),U,9)
8 G EN2
9 ;
10SUP ;T&A supervisor entry point: select T&L unit & set up TLE array
11 S PRSTLV=3,PRSAI=1,PRSR=1 D TLESEL^PRSRUT0 G Q1:$G(TLE)=""
12 ;
13LKUPEMP ;user selects 1 employee or all. PRSRY and Y1 ="" if all selected.
14 W !
15 S DIC="^PRSPC(",DIC(0)="AEQZ",D="ATL"_$P(TLE(1),"^",1)
16 S DIC("A")="Enter employee name (Return for All): "
17 ;screen employees by T&L unit
18 S DIC("S")="I $$INXR^PRSRL1($P(TLE(1),U),Y)"
19 D IX^DIC G Q1:$D(DUOUT)!$D(DTOUT)
20 ;
21 S PRSR=0 S:X="" (PRSR,SW)=1,(PRSRY,PRSRY1)=""
22 G EN1
23 ;
24FIS D DUZ^PRSRUTL G Q:SSN="" S PRSR=2
25FIS1 W ! S DIC="^PRSPC(",DIC(0)="AEZM",DIC("A")="Enter employee name: "
26 D ^DIC G Q1:$D(DUOUT)!$D(DTOUT)!(Y=-1)
27 ;
28 ;If a single T&L unit member was selected
29EN1 I PRSR'=1 S PRSRY=Y,SW=0,D0=+Y,PRSRY1=$S($D(Y(0)):Y(0),1:""),NAM=$P(Y(0),"^"),TLE=$P(Y(0),"^",8),PRSRSSN=$P(Y(0),"^",9)
30 I (PRSR=1)&'SW D CHKTLE^PRSRUTL G FIS1:'STFSW
31 S SW(4)=1
32 ;
33EN2 W ! S X="T",%DT="" D ^%DT Q:Y<0 S DT=Y K %DT
34ASK S %DT("A")="Report Beginning Date ",%DT(0)=-DT,%DT("B")="T",%DT="AEX"
35 D ^%DT G Q1:$D(DTOUT)!(X="")!(X="^"),MSG2:Y=-1
36 S FR=Y,FRO=Y-1,BDT=9999999-Y D DD^%DT S XX=Y
37 S %DT("A")="Report Ending Date ",%DT("B")="T",%DT="AEX"
38 D ^%DT G Q1:$D(DTOUT)!(X="")!(X="^"),MSG2:Y=-1,Q1:Y["^"
39 S (TOP,TO)=Y,EDT=9999999-Y
40 G ASK:FR>TO
41 S D1=TO,DAT=X S Y=TO D DD^%DT S YY=Y
42 ;
43 I 'SW S COSORG=$P(PRSRY1,"^",49),COS=$S(COSORG'="":$E(COSORG,1,4),1:""),ORG=$S(COSORG'="":$E(COSORG,5,8),1:"") D
44 . I ORG'="" S ORG=$O(^PRSP(454,1,"ORG","B",COS_":"_ORG,"")) I ORG'="" S ORG=$P($G(^PRSP(454,1,"ORG",ORG,0)),"^",2),ORG=$S(ORG'="":$P($G(^PRSP(454.1,ORG,0)),"^"),1:COSORG)
45 ;
46 W ! I SW(4) S ZTRTN="START^PRSRL1",ZTDESC="EMPLOYEE LEAVE USAGE REPORT" D ST^PRSRUTL,LOOP,QUE1^PRSRUT0 G Q1:POP!($D(ZTSK))
47 ;
48START ; queued entry point
49 S LVT=";"_$P(^DD(458.1,6,0),"^",3) ; Type of Leave set of codes
50 S CNT=0
51 K ^TMP($J,"USE")
52 S ^TMP($J,"USE")="LEAVE USED SUMMARY"
53 ;
54 ;SW = true when all employees in t&l selected
55 ; false when individual employee selected
56 ;FRO = fileman date
57 ;D0 = employe ien in #450 (and #458)
58 ;DA(1) = ien in file 458 (pay period)
59 ;DA = day # within payperiod
60 ;DA(2) = pay period yyyy-nn
61 ;DATES = string of FM dates for current pay period
62 ;
63 ; set up employee variables when printing individual
64 I 'SW D
65 . N X
66 . S X=$G(^PRSPC(D0,0))
67 . S NAM=$P(X,U)
68 . S TLE=$P(X,U,8)
69 . S SSN=$P(X,U,9),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
70 ;
71 ;Loop thru Time & Attendance (458) file "day" x-ref
72 F S FRO=$O(^PRST(458,"AD",FRO)) Q:FRO'>0!(FRO>TOP) D
73 . S X=$G(^PRST(458,"AD",FRO)),DA(1)=$P(X,U),DA=$P(X,U,2)
74 . S DATES=$G(^PRST(458,DA(1),1))
75 . ; determine the 4 digit year pay period
76 . S D1=$P(DATES,U) D PP^PRSAPPU S DA(2)=PP4Y
77 . ; get/sort leave for the day
78 . D USE^PRSRLSOR
79 ;
80IND ; report results
81 U IO
82 I SW D ^PRSRL11 ; all empl report
83 I 'SW D ^PRSRL12 ; one empl report
84 D ^%ZISC
85 ;
86Q ;
87Q1 K %,%DT,%Y,INX,CODE,FOOT,K,LVT,PPI,USR,PRSR,PRSRI,PRSRY,PRSRY1
88 K PRSTLV,PRSV,TLE,TLI,TLUNIT,BDT,C,CNT,COS,COSORG,D0,DA,DAT,DAT2
89 K DATE,DATES,DFN,DTOUT,DUOUT,POP,D1,STFSW,X1,X2,DATT,DAY,DAYS,DIC,EDT
90 K FR,FRP,FRPP,P1,PP,PPE,PRSAI,SEL
91 K I,II,J,LEV,LEVHR,LOC,LOC1,MIS1,MIS2,MISC,MISC1,MISS,NAM,NQ,NUM
92 K ORG,POUT,POS,RG,SCEHR,SSN,SW,SW1,SW2,TC,TIM,TITLE,TL,TLEV,TO
93 K TODA,TOP,TOPP,TOUR,TYL,TYP,TYPE,X,XX,XFR,Y,YY,Z,Z1,ZTDESC,ZTRTN
94 K ZTSAVE,ZTSK,^TMP($J)
95 K D,FRO,PAGE,PP4Y,PRSRDUZ,PRSRSSN
96 I $D(ZTQUEUED) S ZTREQ="@"
97 Q
98 ;
99MSG1 W $C(7),!!,"*** Employee name not found." G EN1
100MSG2 W $C(7),!!,"The Date was invalid." G ASK
101MSG3 W $C(7),!!,"Date not found in file." G ASK
102LOOP F X="D0","FR","FRO","FRP","TLE*","TO","TOP","SW","LOC","POS","PRSRY","PRSRY1","COS","ORG","XX","YY","NAM","PRSDUZ","PRSRSSN" S ZTSAVE(X)=""
103 Q
104INXR(TLCODE,IEN450) ;check if IEN is in T&L cross reference of 450
105 Q $D(^PRSPC("ATL"_TLCODE,$P(^(0),U),+IEN450))
Note: See TracBrowser for help on using the repository browser.