PRSRL1.m

PRSRL1 ;HISC/JH,WCIOFO/JAH,SAB-ONE OR ALL EMPLOYEE LEAVE USE REPORT. ;7-AUG-2000

 ;;4.0;PAID;**2,5,17,19,35,39,61**;Sep 21, 1995

EMP ; employee entry point

 D DUZ^PRSRUTL G Q:'PRSRDUZ

 S DIC="^PRSPC(",DIC(0)="NZ",X=PRSRDUZ D ^DIC G Q1:Y=-1

 S SW=0,SW(4)=1,PRSR=3,PRSRY=Y,PRSRY1=$S($D(Y(0)):Y(0),1:"")

 S D0=$P(PRSRY,U),NAM=$P(Y(0),U),TLE=$P(Y(0),U,8),PRSRSSN=$P(Y(0),U,9)

 G EN2

 ;

SUP ;T&A supervisor entry point: select T&L unit & set up TLE array

 S PRSTLV=3,PRSAI=1,PRSR=1 D TLESEL^PRSRUT0 G Q1:$G(TLE)=""

 ;

LKUPEMP ;user selects 1 employee or all.  PRSRY and Y1 ="" if all selected.

 W !

 S DIC="^PRSPC(",DIC(0)="AEQZ",D="ATL"_$P(TLE(1),"^",1)

 S DIC("A")="Enter employee name (Return for All): "

 ;screen employees by T&L unit

 S DIC("S")="I $$INXR^PRSRL1($P(TLE(1),U),Y)"

 D IX^DIC G Q1:$D(DUOUT)!$D(DTOUT)

 ;

 S PRSR=0 S:X="" (PRSR,SW)=1,(PRSRY,PRSRY1)=""

 G EN1

 ;

FIS D DUZ^PRSRUTL G Q:SSN="" S PRSR=2

FIS1 W ! S DIC="^PRSPC(",DIC(0)="AEZM",DIC("A")="Enter employee name: "

 D ^DIC G Q1:$D(DUOUT)!$D(DTOUT)!(Y=-1)

 ;

 ;If a single T&L unit member was selected

EN1 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)

 I (PRSR=1)&'SW D CHKTLE^PRSRUTL G FIS1:'STFSW

 S SW(4)=1

 ;

EN2 W ! S X="T",%DT="" D ^%DT Q:Y<0  S DT=Y K %DT

ASK S %DT("A")="Report Beginning Date ",%DT(0)=-DT,%DT("B")="T",%DT="AEX"

 D ^%DT G Q1:$D(DTOUT)!(X="")!(X="^"),MSG2:Y=-1

 S FR=Y,FRO=Y-1,BDT=9999999-Y D DD^%DT S XX=Y

 S %DT("A")="Report Ending Date ",%DT("B")="T",%DT="AEX"

 D ^%DT G Q1:$D(DTOUT)!(X="")!(X="^"),MSG2:Y=-1,Q1:Y["^"

 S (TOP,TO)=Y,EDT=9999999-Y

 G ASK:FR>TO

 S D1=TO,DAT=X S Y=TO D DD^%DT S YY=Y

 ;

 I 'SW S COSORG=$P(PRSRY1,"^",49),COS=$S(COSORG'="":$E(COSORG,1,4),1:""),ORG=$S(COSORG'="":$E(COSORG,5,8),1:"") D

 .  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)

 ;

 W ! I SW(4) S ZTRTN="START^PRSRL1",ZTDESC="EMPLOYEE LEAVE USAGE REPORT" D ST^PRSRUTL,LOOP,QUE1^PRSRUT0 G Q1:POP!($D(ZTSK))

 ;

START ; queued entry point

 S LVT=";"_$P(^DD(458.1,6,0),"^",3) ; Type of Leave set of codes

 S CNT=0

 K ^TMP($J,"USE")

 S ^TMP($J,"USE")="LEAVE USED SUMMARY"

 ;

 ;SW    = true when all employees in t&l selected

 ;        false when individual employee selected

 ;FRO   = fileman date

 ;D0    = employe ien in #450 (and #458)

 ;DA(1) = ien in file 458 (pay period)

 ;DA    = day # within payperiod

 ;DA(2) = pay period yyyy-nn

 ;DATES = string of FM dates for current pay period

 ;

 ; set up employee variables when printing individual

 I 'SW D

 . N X

 . S X=$G(^PRSPC(D0,0))

 . S NAM=$P(X,U)

 . S TLE=$P(X,U,8)

 . S SSN=$P(X,U,9),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)

 ;

 ;Loop thru Time & Attendance (458) file "day" x-ref

 F  S FRO=$O(^PRST(458,"AD",FRO)) Q:FRO'>0!(FRO>TOP)  D

 . S X=$G(^PRST(458,"AD",FRO)),DA(1)=$P(X,U),DA=$P(X,U,2)

 . S DATES=$G(^PRST(458,DA(1),1))

 . ; determine the 4 digit year pay period

 . S D1=$P(DATES,U) D PP^PRSAPPU S DA(2)=PP4Y

 . ; get/sort leave for the day

 . D USE^PRSRLSOR

 ;

IND ; report results

 U IO

 I SW D ^PRSRL11 ; all empl report

 I 'SW D ^PRSRL12 ; one empl report

 D ^%ZISC

 ;

Q ;

Q1 K %,%DT,%Y,INX,CODE,FOOT,K,LVT,PPI,USR,PRSR,PRSRI,PRSRY,PRSRY1

 K PRSTLV,PRSV,TLE,TLI,TLUNIT,BDT,C,CNT,COS,COSORG,D0,DA,DAT,DAT2

 K DATE,DATES,DFN,DTOUT,DUOUT,POP,D1,STFSW,X1,X2,DATT,DAY,DAYS,DIC,EDT

 K FR,FRP,FRPP,P1,PP,PPE,PRSAI,SEL

 K I,II,J,LEV,LEVHR,LOC,LOC1,MIS1,MIS2,MISC,MISC1,MISS,NAM,NQ,NUM

 K ORG,POUT,POS,RG,SCEHR,SSN,SW,SW1,SW2,TC,TIM,TITLE,TL,TLEV,TO

 K TODA,TOP,TOPP,TOUR,TYL,TYP,TYPE,X,XX,XFR,Y,YY,Z,Z1,ZTDESC,ZTRTN

 K ZTSAVE,ZTSK,^TMP($J)

 K D,FRO,PAGE,PP4Y,PRSRDUZ,PRSRSSN

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

 ;

MSG1 W $C(7),!!,"*** Employee name not found." G EN1

MSG2 W $C(7),!!,"The Date was invalid." G ASK

MSG3 W $C(7),!!,"Date not found in file." G ASK

LOOP F X="D0","FR","FRO","FRP","TLE*","TO","TOP","SW","LOC","POS","PRSRY","PRSRY1","COS","ORG","XX","YY","NAM","PRSDUZ","PRSRSSN" S ZTSAVE(X)=""

 Q

INXR(TLCODE,IEN450) ;check if IEN is in T&L cross reference of 450

 Q $D(^PRSPC("ATL"_TLCODE,$P(^(0),U),+IEN450))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRSRL1   4268     printed  Mar 13, 2025@21:33:30                                                                                                                                                                                                      Page 2

PRSRL1    ;HISC/JH,WCIOFO/JAH,SAB-ONE OR ALL EMPLOYEE LEAVE USE REPORT. ;7-AUG-2000

 +1       ;;4.0;PAID;**2,5,17,19,35,39,61**;Sep 21, 1995

EMP       ; employee entry point

 +1        DO DUZ^PRSRUTL

           if 'PRSRDUZ

               GOTO Q

 +2        SET DIC="^PRSPC("

           SET DIC(0)="NZ"

           SET X=PRSRDUZ

           DO ^DIC

           if Y=-1

               GOTO Q1

 +3        SET SW=0

           SET SW(4)=1

           SET PRSR=3

           SET PRSRY=Y

           SET PRSRY1=$SELECT($DATA(Y(0)):Y(0),1:"")

 +4        SET D0=$PIECE(PRSRY,U)

           SET NAM=$PIECE(Y(0),U)

           SET TLE=$PIECE(Y(0),U,8)

           SET PRSRSSN=$PIECE(Y(0),U,9)

 +5        GOTO EN2

 +6       ;

SUP       ;T&A supervisor entry point: select T&L unit & set up TLE array

 +1        SET PRSTLV=3

           SET PRSAI=1

           SET PRSR=1

           DO TLESEL^PRSRUT0

           if $GET(TLE)=""

               GOTO Q1

 +2       ;

LKUPEMP   ;user selects 1 employee or all.  PRSRY and Y1 ="" if all selected.

 +1        WRITE !

 +2        SET DIC="^PRSPC("

           SET DIC(0)="AEQZ"

           SET D="ATL"_$PIECE(TLE(1),"^",1)

 +3        SET DIC("A")="Enter employee name (Return for All): "

 +4       ;screen employees by T&L unit

 +5        SET DIC("S")="I $$INXR^PRSRL1($P(TLE(1),U),Y)"

 +6        DO IX^DIC

           if $DATA(DUOUT)!$DATA(DTOUT)

               GOTO Q1

 +7       ;

 +8        SET PRSR=0

           if X=""

               SET (PRSR,SW)=1

               SET (PRSRY,PRSRY1)=""

 +9        GOTO EN1

 +10      ;

FIS        DO DUZ^PRSRUTL

           if SSN=""

               GOTO Q

           SET PRSR=2

FIS1       WRITE !

           SET DIC="^PRSPC("

           SET DIC(0)="AEZM"

           SET DIC("A")="Enter employee name: "

 +1        DO ^DIC

           if $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)

               GOTO Q1

 +2       ;

 +3       ;If a single T&L unit member was selected

EN1        IF PRSR'=1

               SET PRSRY=Y

               SET SW=0

               SET D0=+Y

               SET PRSRY1=$SELECT($DATA(Y(0)):Y(0),1:"")

               SET NAM=$PIECE(Y(0),"^")

               SET TLE=$PIECE(Y(0),"^",8)

               SET PRSRSSN=$PIECE(Y(0),"^",9)

 +1        IF (PRSR=1)&'SW

               DO CHKTLE^PRSRUTL

               if 'STFSW

                   GOTO FIS1

 +2        SET SW(4)=1

 +3       ;

EN2        WRITE !

           SET X="T"

           SET %DT=""

           DO ^%DT

           if Y<0

               QUIT 

           SET DT=Y

           KILL %DT

ASK        SET %DT("A")="Report Beginning Date "

           SET %DT(0)=-DT

           SET %DT("B")="T"

           SET %DT="AEX"

 +1        DO ^%DT

           if $DATA(DTOUT)!(X="")!(X="^")

               GOTO Q1

           if Y=-1

               GOTO MSG2

 +2        SET FR=Y

           SET FRO=Y-1

           SET BDT=9999999-Y

           DO DD^%DT

           SET XX=Y

 +3        SET %DT("A")="Report Ending Date "

           SET %DT("B")="T"

           SET %DT="AEX"

 +4        DO ^%DT

           if $DATA(DTOUT)!(X="")!(X="^")

               GOTO Q1

           if Y=-1

               GOTO MSG2

           if Y["^"

               GOTO Q1

 +5        SET (TOP,TO)=Y

           SET EDT=9999999-Y

 +6        if FR>TO

               GOTO ASK

 +7        SET D1=TO

           SET DAT=X

           SET Y=TO

           DO DD^%DT

           SET YY=Y

 +8       ;

 +9        IF 'SW

               SET COSORG=$PIECE(PRSRY1,"^",49)

               SET COS=$SELECT(COSORG'="":$EXTRACT(COSORG,1,4),1:"")

               SET ORG=$SELECT(COSORG'="":$EXTRACT(COSORG,5,8),1:"")

               Begin DoDot:1

 +10               IF ORG'=""

                       SET ORG=$ORDER(^PRSP(454,1,"ORG","B",COS_":"_ORG,""))

                       IF ORG'=""

                           SET ORG=$PIECE($GET(^PRSP(454,1,"ORG",ORG,0)),"^",2)

                           SET ORG=$SELECT(ORG'="":$PIECE($GET(^PRSP(454.1,ORG,0)),"^"),1:COSORG)

               End DoDot:1

 +11      ;

 +12       WRITE !

           IF SW(4)

               SET ZTRTN="START^PRSRL1"

               SET ZTDESC="EMPLOYEE LEAVE USAGE REPORT"

               DO ST^PRSRUTL

               DO LOOP

               DO QUE1^PRSRUT0

               if POP!($DATA(ZTSK))

                   GOTO Q1

 +13      ;

START     ; queued entry point

 +1       ; Type of Leave set of codes

           SET LVT=";"_$PIECE(^DD(458.1,6,0),"^",3)

 +2        SET CNT=0

 +3        KILL ^TMP($JOB,"USE")

 +4        SET ^TMP($JOB,"USE")="LEAVE USED SUMMARY"

 +5       ;

 +6       ;SW    = true when all employees in t&l selected

 +7       ;        false when individual employee selected

 +8       ;FRO   = fileman date

 +9       ;D0    = employe ien in #450 (and #458)

 +10      ;DA(1) = ien in file 458 (pay period)

 +11      ;DA    = day # within payperiod

 +12      ;DA(2) = pay period yyyy-nn

 +13      ;DATES = string of FM dates for current pay period

 +14      ;

 +15      ; set up employee variables when printing individual

 +16       IF 'SW

               Begin DoDot:1

 +17               NEW X

 +18               SET X=$GET(^PRSPC(D0,0))

 +19               SET NAM=$PIECE(X,U)

 +20               SET TLE=$PIECE(X,U,8)

 +21               SET SSN=$PIECE(X,U,9)

                   SET SSN=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)

               End DoDot:1

 +22      ;

 +23      ;Loop thru Time & Attendance (458) file "day" x-ref

 +24       FOR 

               SET FRO=$ORDER(^PRST(458,"AD",FRO))

               if FRO'>0!(FRO>TOP)

                   QUIT 

               Begin DoDot:1

 +25               SET X=$GET(^PRST(458,"AD",FRO))

                   SET DA(1)=$PIECE(X,U)

                   SET DA=$PIECE(X,U,2)

 +26               SET DATES=$GET(^PRST(458,DA(1),1))

 +27      ; determine the 4 digit year pay period

 +28               SET D1=$PIECE(DATES,U)

                   DO PP^PRSAPPU

                   SET DA(2)=PP4Y

 +29      ; get/sort leave for the day

 +30               DO USE^PRSRLSOR

               End DoDot:1

 +31      ;

IND       ; report results

 +1        USE IO

 +2       ; all empl report

           IF SW

               DO ^PRSRL11

 +3       ; one empl report

           IF 'SW

               DO ^PRSRL12

 +4        DO ^%ZISC

 +5       ;

Q         ;

Q1         KILL %,%DT,%Y,INX,CODE,FOOT,K,LVT,PPI,USR,PRSR,PRSRI,PRSRY,PRSRY1

 +1        KILL PRSTLV,PRSV,TLE,TLI,TLUNIT,BDT,C,CNT,COS,COSORG,D0,DA,DAT,DAT2

 +2        KILL DATE,DATES,DFN,DTOUT,DUOUT,POP,D1,STFSW,X1,X2,DATT,DAY,DAYS,DIC,EDT

 +3        KILL FR,FRP,FRPP,P1,PP,PPE,PRSAI,SEL

 +4        KILL I,II,J,LEV,LEVHR,LOC,LOC1,MIS1,MIS2,MISC,MISC1,MISS,NAM,NQ,NUM

 +5        KILL ORG,POUT,POS,RG,SCEHR,SSN,SW,SW1,SW2,TC,TIM,TITLE,TL,TLEV,TO

 +6        KILL TODA,TOP,TOPP,TOUR,TYL,TYP,TYPE,X,XX,XFR,Y,YY,Z,Z1,ZTDESC,ZTRTN

 +7        KILL ZTSAVE,ZTSK,^TMP($JOB)

 +8        KILL D,FRO,PAGE,PP4Y,PRSRDUZ,PRSRSSN

 +9        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +10       QUIT 

 +11      ;

MSG1       WRITE $CHAR(7),!!,"*** Employee name not found."

           GOTO EN1

MSG2       WRITE $CHAR(7),!!,"The Date was invalid."

           GOTO ASK

MSG3       WRITE $CHAR(7),!!,"Date not found in file."

           GOTO ASK

LOOP       FOR X="D0","FR","FRO","FRP","TLE*","TO","TOP","SW","LOC","POS","PRSRY","PRSRY1","COS","ORG","XX","YY","NAM","PRSDUZ","PRSRSSN"

               SET ZTSAVE(X)=""

 +1        QUIT 

INXR(TLCODE,IEN450) ;check if IEN is in T&L cross reference of 450

 +1        QUIT $DATA(^PRSPC("ATL"_TLCODE,$PIECE(^(0),U),+IEN450))