source: FOIAVistA/tag/r/PAID-PRS/PRSRTLPR.m@ 1540

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PRSRTLPR ;HISC/JH-DISPLAY/PRINT SUP.,TIMEKEPPER,OT SUP. ;5/8/95
2 ;;4.0;PAID;**2,6,10,16,17**;Sep 21, 1995
3FIS S PRSR=2,PRSTLV=3
4 ;
5 ;Time&Leave selection. Return TLE array populated with info about
6 ;the T&L unit the user selected.
7 D TLESEL^PRSRUT0 G Q:$G(TLE)=""!(SSN="") W ! S SW=$S(TLE>1:1,1:0)
8 S ZTRTN="START^PRSRTLPR",ZTDESC="TIMEKEEPER,SUP.,O/T SUP. REPORT" D ST^PRSRUTL,LOOP,QUE1^PRSRUT0 G Q1:POP!($D(ZTSK))
9 ;
10START K ^TMP($J,"TLPR")
11 S ^TMP($J,"TLPR")="P A I D T & L R E P O R T",(CNT,POUT)=0
12 ;
13 ;set up the TMP global with timekeepers, supervisors, approvers
14 ;on nodes 1,2,3 respectively. Outer loop controls separate T&L units
15 S J=0 F II=0:0 S J=$O(TLE(J)) Q:J'>0 D
16 . S DA(1)=$P(TLE(J),U) Q:DA(1)="" S DA(2)=$P(TLE(J),U,2) D SORT
17 S DAT=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) U IO D HDR1
18 I 'CNT W !,"|",?10,"No Timekeepers, Supervisors or O/T Supervisors on file.",?79,"|" S POUT=1 D NONE
19 G Q1:POUT
20 S CNT=1,(HOLD,TLE)=""
21 ;
22 ; PRINT out each T&L unit
23 F I=0:0 S TLE=$O(^TMP($J,"TLPR",TLE)) Q:TLE="" D Q:POUT
24 .; Get one of each job function to print horizontally.
25 .; quit if all three job function nodes are exhausted.
26 . F II=1:1 S MORE=$$GETNEXT(.TMK,.SUP,.OTA,II) D Q:'MORE!(POUT)
27 .. S NAM(1)=$S($P(TMK,U)'="":$E($P($G(^VA(200,$P(TMK,U),0)),U),1,22),1:"")
28 .. S NAM(2)=$S($P(SUP,U)'="":$E($P($G(^VA(200,$P(SUP,U),0)),U),1,22),1:"")
29 .. S NAM(3)=$S($P(OTA,U)'="":$E($P($G(^VA(200,$P(OTA,U),0)),U),1,22),1:"")
30 .. D:$Y>(IOSL-5) HDR Q:POUT W !,"|",$S(TLE'=HOLD:TLE,1:""),?5,"|",$S(NAM(1)'="":NAM(1),1:""),?28,"|",$S(NAM(2)'="":NAM(2),1:""),?52,$P(SUP,U,2),?56,"|",$S(NAM(3)'="":NAM(3),1:""),?79,"|"
31 .. S HOLD=TLE,CNT=CNT+2 Q
32 . D:'POUT VLIN0 S CNT=1 Q
33 I IOSL<66 F I=$Y:1:IOSL-5 D VLIN0
34 G Q1:POUT I CNT D VLIN1 S CODE="T001",FOOT="VA TIME & ATTENDANCE SYSTEM" D FOOT2^PRSRUT0
35Q I $E(IOST)="C" R !!,"Press Return/Enter to continue. ",X:DTIME
36Q1 K ANT,CNT,COD,CODE,D0,DA,DAT,DIC,FOOT,HOLD,I,II,J,POP,POUT,PRSR,PRSTLV,NAM,SNT,SSN,SW,TL,TLA,TLE,TLI,TLS,TNT,TLT,TLUNIT,X,Y,Z1,ZTDESC,ZTRTN,ZTSAVE,^TMP($J,"TLPR") D ^%ZISC S:$D(ZTSK) ZTREQ="@" K ZTSK
37 Q
38GETNEXT(TK,SV,OT,NODE) ;
39 ;get the next timekeeper, supervisor, and OT/CT approver
40 S RTN=1
41 S TK=$G(^TMP($J,"TLPR",TLE,1,NODE))
42 S SV=$G(^TMP($J,"TLPR",TLE,2,NODE))
43 S OT=$G(^TMP($J,"TLPR",TLE,3,NODE))
44 I TK=""&(SV="")&(OT="") S RTN=0
45 Q RTN
46SORT ;modified by John Heiges patch 17.
47 N J,JFN,NEXT
48 ; loop thru job function multiples (timekeep, supervr & OT/CT)
49 ; and store in ^TMP($J,
50 ; JFN = job function node
51 ; timekeepers->node 1, supervisors->node 2, ot/ct approvers->node 3
52 ; DA(1)= T&L unit #
53 ; DA = T&L unit internal entry #
54 ;
55 ; get ien of T&L unit
56 S DA="" S DA=$O(^PRST(455.5,"B",DA(1),DA)) Q:DA'>0
57 ;
58 ; loop thru each job function multiple
59 S COD="" F I=0:0 S COD=$O(^PRST(455.5,DA,COD)) Q:COD="" D
60 . S JFN=$S("T"[COD:1,"S"[COD:2,1:3)
61 . S D0=0 F NEXT=1:1 S D0=$O(^PRST(455.5,DA,COD,D0)) Q:D0'>0 D
62 .. S TL=$P($G(^PRST(455.5,DA,COD,D0,0)),U,2)
63 .. S ^TMP($J,"TLPR",DA(1),JFN,NEXT)=D0_U_TL
64 .. S CNT=1
65 .. Q
66 . Q
67 Q
68NONE I IOSL<66 F I=$Y:1:IOSL-5 D VLIN0
69 D HDR
70 Q
71HDR D VLIN1 S CODE="T001",FOOT="VA TIME & ATTENDANCE SYSTEM" D FOOT2^PRSRUT0
72 I $E(IOST)="C" R !,"Press Return/Enter to continue. ",X:DTIME S:'$T!(X="^")!($G(NAM(1))=""&($G(NAM(2))=""&($G(NAM(3))=""))) POUT=1
73 Q:POUT
74HDR1 W:$E(IOST)="C" @IOF W !?26,^TMP($J,"TLPR"),?66,"DATE: ",DAT,!
75 W !,"|",?5,"|",?28,"|",?52,"CERT",?56,"|",?79,"|"
76 W !,"|","T&L",?5,"|","TIMEKEEPER",?28,"|","SUPERVISOR",?52,"T&L",?56,"|","O/T SUPERVISOR",?79,"|" D VLIN1 Q
77VLIN0 W !,"|",?5,"|",?28,"|",?56,"|",?79,"|" Q
78VLIN1 W !,"|----|----------------------|---------------------------|----------------------|" Q
79LOOP F X="TLE*","SW" S ZTSAVE(X)=""
80 Q
Note: See TracBrowser for help on using the repository browser.