Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSA8BNH

PRSA8BNH.m

Go to the documentation of this file.
  1. PRSA8BNH ;WOIFO/JAH - Tour Hours vs 8B Norm Hrs Report ;12/28/07
  1. ;;4.0;PAID;**116,110**;Sep 21, 1995;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ; Search for 8b normal hours that don't match tours
  1. ; look in timecard 8B node for normal hours otherwise use 450
  1. ;
  1. PAYROLL ;prompt for T&L's--set's up payroll all T&L's
  1. N PRSTLV,FORWHO
  1. S PRSTLV=7
  1. S FORWHO="for Payroll"
  1. D MAIN
  1. Q
  1. ;
  1. TIMEKEEP ; entry point sets up timekeeper T&L variable for PRSAUTL call
  1. N PRSTLV,FORWHO S PRSTLV=2,FORWHO="for Timekeeper"
  1. D MAIN
  1. Q
  1. ;
  1. SUPERV ; sets up supervisor for T&L lookup
  1. N PRSTLV,FORWHO S PRSTLV=3,FORWHO="for T&A Supervisor"
  1. D MAIN
  1. Q
  1. ;
  1. MAIN ;
  1. N DIR,DIRUT,TLS,Y,PPI,PPE,NOTOUR,NOTCARD,PPRANGE,DAILYHRS,EP,SP,SDT,EDT
  1. S TLS=1
  1. S DIR(0)="Y"
  1. S DIR("B")="Y"
  1. S DIR("A")="All T&L's"
  1. D ^DIR
  1. Q:$D(DIRUT)
  1. I +Y=1 S TLS="ALL"
  1. I TLS=1 D
  1. . D ^PRSAUTL
  1. Q:TLS=1&($G(TLI)="")
  1. ;
  1. S PPI=$$GETPP^PRSA8BNI()
  1. Q:PPI'>0
  1. S PPE=$P($G(^PRST(458,PPI,0)),U)
  1. S SDT=$P($G(^PRST(458,PPI,2)),U)
  1. S EDT=$P($G(^PRST(458,PPI,2)),U,14)
  1. S SP=$L(SDT," ")
  1. S EP=$L(EDT," ")
  1. S PPRANGE=$P(SDT," ",SP)_" thru "_$P(EDT," ",EP)
  1. ;
  1. ; ask user to include employees with no timecard at all.
  1. S NOTCARD=$$NOTCARD^PRSA8BNI()
  1. Q:NOTCARD<0
  1. ;
  1. ; ask user to include employees with no tour of duty entered
  1. S NOTOUR=$$NOTOURS^PRSA8BNI()
  1. Q:NOTOUR<0
  1. ;
  1. ; ask user to include employees daily tour hours
  1. S DAILYHRS=$$DAILYHRS^PRSA8BNI()
  1. Q:DAILYHRS<0
  1. ;
  1. ;
  1. N %ZIS,POP,IOP
  1. S %ZIS="MQ"
  1. D ^%ZIS
  1. Q:POP
  1. I $D(IO("Q")) D
  1. . K IO("Q")
  1. . N ZTDESC,ZTRTN,ZTSAVE
  1. . S ZTDESC="PAID REPORT: TOUR HOURS DON'T MATCH 8B NORMAL"
  1. . S ZTRTN="TOUR8B^PRSA8BNH"
  1. . S ZTSAVE("PRSTLV")=""
  1. . S ZTSAVE("TLE")=""
  1. . S ZTSAVE("PPI")=""
  1. . S ZTSAVE("PPE")=""
  1. . S ZTSAVE("TLS")=""
  1. . S ZTSAVE("NOTOUR")=""
  1. . S ZTSAVE("NOTCARD")=""
  1. . S ZTSAVE("DAILYHRS")=""
  1. . S ZTSAVE("PPRANGE")=""
  1. . S ZTSAVE("FORWHO")=""
  1. . D ^%ZTLOAD
  1. . I $D(ZTSK) S ZTREQ="@"
  1. E D
  1. . D TOUR8B
  1. K PRSTLV
  1. D ^%ZISC K %ZIS,IOP
  1. Q
  1. ;
  1. TOUR8B ;
  1. U IO
  1. N OUT,TLECNT,TSTAMP,Y,%,%I,GRANDTOT,PG,ATL
  1. D NOW^%DTC S Y=% D DD^%DT S TSTAMP=$P(Y,":",1,2)
  1. S (TLECNT,OUT,GRANDTOT,PG)=0
  1. I TLS="ALL" D
  1. . N TLI,TLE
  1. . S ATL="ATL"
  1. . F S ATL=$O(^PRSPC(ATL)) Q:ATL>"ATLVCS"!OUT D
  1. .. S TLE=$E(ATL,4,6)
  1. .. Q:TLE=""
  1. .. S TLI=$O(^PRST(455.5,"B",TLE,0))
  1. .. Q:TLI'>0
  1. ..; skip T&L's supervisors and timekeepers don't have access too
  1. .. Q:(PRSTLV=2)&('$D(^PRST(455.5,"AT",DUZ,TLI)))
  1. .. Q:(PRSTLV=3)&('$D(^PRST(455.5,"AS",DUZ,TLI)))
  1. .. I TLECNT=0 D HDR^PRSA8BNI(.PG,TSTAMP,0,FORWHO,PPE,PPRANGE)
  1. .. D LOOPTL(.OUT,.GRANDTOT,TLE,PPI,TSTAMP)
  1. .. S TLECNT=TLECNT+1
  1. E D
  1. . D HDR^PRSA8BNI(.PG,TSTAMP,0,FORWHO,PPE,PPRANGE)
  1. . D LOOPTL(.OUT,.GRANDTOT,TLE,PPI,TSTAMP)
  1. . S TLECNT=TLECNT+1
  1. D REPDONE^PRSA8BNI(OUT,TLECNT,TSTAMP,DAILYHRS,GRANDTOT)
  1. Q
  1. ;
  1. LOOPTL(OUT,TOT,TLE,PPI,TSTAMP) ; LOOP THROUGH T&L
  1. N COUNT,NN,PRSIEN,EMPNODE,PRSENAME,HRS,EMPND1,SEPIND,WEEKHRS,PRSD,PRSSN
  1. K ERRORS
  1. S (COUNT,OUT)=0
  1. S NN=""
  1. F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" D
  1. . F PRSIEN=0:0 S PRSIEN=$O(^PRSPC("ATL"_TLE,NN,PRSIEN)) Q:PRSIEN<1!(OUT) D
  1. ..; skip Extended LWOP or anyone without a timecard
  1. .. Q:'NOTCARD&($G(^PRST(458,PPI,"E",PRSIEN,0))="")
  1. .. Q:'NOTOUR&($P($G(^PRST(458,PPI,"E",PRSIEN,"D",1,0)),U,2)="")
  1. .. S EMPNODE=$G(^PRSPC(PRSIEN,0))
  1. .. S EMPND1=$G(^PRSPC(PRSIEN,1))
  1. .. S SEPIND=$P(EMPND1,U,33)
  1. .. Q:EMPNODE=""!(SEPIND="Y")
  1. .. I '$$HRSMATCH^PRSATPE(PPI,PRSIEN) D
  1. ... S COUNT=COUNT+1
  1. ... S GRANDTOT=GRANDTOT+1
  1. ... S ERRORS(PRSIEN)=""
  1. I COUNT>0 D
  1. . I DAILYHRS,$Y>(IOSL-12) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
  1. . I 'DAILYHRS,$Y>(IOSL-7) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
  1. . W !!,?12,"T & L UNIT: "_TLE," ",COUNT," mismatches found."
  1. . S PRSIEN=""
  1. . F S PRSIEN=$O(ERRORS(PRSIEN)) Q:PRSIEN'>0!OUT D
  1. .. S WEEKHRS=$$GETHOURS^PRSA8BNI(PPI,PRSIEN)
  1. .. S PRSENAME=$P($G(^PRSPC(PRSIEN,0)),U)
  1. .. S PRSSN=$P($G(^PRSPC(PRSIEN,0)),U,9)
  1. .. S PRSSN=$S(PRSTLV=7:$E(PRSSN,1,3)_"-"_$E(PRSSN,4,5),PRSTLV'<2:$E(PRSSN,1)_"XX-XX",1:"XXX-XX")_"-"_$E(PRSSN,6,9)
  1. .. I DAILYHRS,$Y>(IOSL-10) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
  1. .. I 'DAILYHRS,$Y>(IOSL-5) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
  1. .. D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS)
  1. ..; show the actual tour hours for each day
  1. .. I DAILYHRS D
  1. ... N HRS,I
  1. ... D TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)
  1. ... I $Y>(IOSL-8) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS)
  1. ... D TRHDR^PRSA8BNI
  1. ... F PRSD=1:1:7 D Q:OUT
  1. .... I $Y>(IOSL-4) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS),TRHDR^PRSA8BNI
  1. .... Q:OUT
  1. .... D TOURDISP(PPI,PRSIEN,PRSD,.HRS)
  1. .. Q:OUT
  1. .. I $Y>(IOSL-5) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
  1. Q
  1. TOURDISP(PPI,PRSIEN,PRSD,HRS) ;
  1. N Y1,Y2,Y4,Y5,DTE,TD1C1,TD1C2,L2,L3,TD2C1,TD2C2
  1. S TD1C1=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2),Y1=$G(^(1)),Y4=$G(^(4))
  1. S TD2C1=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",13)
  1. I Y1="" S Y1=$S(TD1C1=1:"Day Off",TD1C1=2:"Day Tour",TD1C1=3!(TD1C1=4):"Intermittent",1:"")
  1. S TD1C2=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD+7,0)),"^",2),Y2=$G(^(1)),Y5=$G(^(4))
  1. S TD2C2=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD+7,0)),"^",13)
  1. I Y2="" S Y2=$S(TD1C2=1:"Day Off",TD1C2=2:"Day Tour",TD1C2=3!(TD1C2=4):"Intermittent",1:"")
  1. S DTE=$P("Sun Mon Tue Wed Thu Fri Sat"," ",PRSD)
  1. W !?7,DTE S (L2,L3)=0
  1. I Y1="",Y2="" Q
  1. ;
  1. S0 ; Set Schedule Array
  1. N A1,L1,B
  1. F L1=1:3:19 D
  1. . S A1=$P(Y1,"^",L1) Q:A1=""
  1. . S L2=L2+1,Y1(L2)=A1
  1. . S:$P(Y1,"^",L1+1)'="" Y1(L2)=Y1(L2)_"-"_$P(Y1,"^",L1+1)
  1. . I L1=1 D
  1. .. N DAYHRS S DAYHRS=$J($P(HRS(PRSD),U,2),5,2)
  1. .. S B=$E(" ",1,20-$L(DAYHRS)-$L(Y1(L2)))
  1. .. S Y1(L2)=$J(TD1C1,5,0)_" "_Y1(L2)_B_DAYHRS
  1. . E D
  1. .. S Y1(L2)=" "_Y1(L2)
  1. . I $P(Y1,"^",L1+2)'="" D
  1. .. S L2=L2+1
  1. .. S Y1(L2)=" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",1)
  1. G:Y4="" S1
  1. F L1=1:3:19 D
  1. . S A1=$P(Y4,"^",L1) Q:A1=""
  1. . S L2=L2+1
  1. . S Y1(L2)=A1
  1. . S:$P(Y4,"^",L1+1)'="" Y1(L2)=Y1(L2)_"-"_$P(Y4,"^",L1+1)
  1. . I L1=1 D
  1. .. S Y1(L2)=$J(TD2C1,5,0)_" "_Y1(L2)
  1. . E D
  1. .. S Y1(L2)=" "_Y1(L2)
  1. . I $P(Y4,"^",L1+2)'="" D
  1. .. S L2=L2+1
  1. .. S Y1(L2)=" "_$P($G(^PRST(457.2,+$P(Y4,"^",L1+2),0)),"^",1)
  1. ;
  1. S1 ; Set Schedule Array
  1. F L1=1:3:19 D
  1. . S A1=$P(Y2,"^",L1) Q:A1=""
  1. . S L3=L3+1
  1. . S Y2(L3)=A1
  1. . S:$P(Y2,"^",L1+1)'="" Y2(L3)=Y2(L3)_"-"_$P(Y2,"^",L1+1)
  1. . I L1=1 D
  1. .. N DAYHRS S DAYHRS=$J($P(HRS(PRSD+7),U,2),5,2)
  1. .. S B=$E(" ",1,20-$L(DAYHRS)-$L(Y2(L3)))
  1. .. S Y2(L3)=$J(TD1C2,5,0)_" "_Y2(L3)_B_DAYHRS
  1. . E D
  1. .. S Y2(L3)=" "_Y2(L3)
  1. . I $P(Y2,"^",L1+2)'="" D
  1. .. S L3=L3+1
  1. .. S Y2(L3)=" "_$P($G(^PRST(457.2,+$P(Y2,"^",L1+2),0)),"^",1)
  1. ;
  1. G:Y5="" S2
  1. ;
  1. F L1=1:3:19 D
  1. . S A1=$P(Y5,"^",L1) Q:A1=""
  1. . S L3=L3+1,Y2(L3)=A1
  1. . S:$P(Y5,"^",L1+1)'="" Y2(L3)=Y2(L3)_"-"_$P(Y5,"^",L1+1)
  1. . I L1=1 D
  1. .. S Y2(L3)=$J(TD2C2,5,0)_" "_Y2(L3)
  1. . E D
  1. .. S Y2(L3)=" "_Y2(L3)
  1. . I $P(Y5,"^",L1+2)'="" D
  1. .. S L3=L3+1
  1. .. S Y2(L3)=" "_$P($G(^PRST(457.2,+$P(Y5,"^",L1+2),0)),"^",1)
  1. ;
  1. S2 ;
  1. N K
  1. F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) D
  1. . W:K>1 ! W:$D(Y1(K)) ?12,Y1(K) W:$D(Y2(K)) ?47,Y2(K)
  1. Q