source: FOIAVistA/trunk/r/PAID-PRS/PRSPCORE.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1PRSPCORE ;WOIFO/JAH - pt phys report on Core Hour Tours ;01/22/05
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; Report all tours of duty that currently have a Core Hours
6 ; designation in the TOUR OF DUTY(#457.1)
7 ;
8 ; The Payroll Supervisor will need to remove the
9 ; designation from the indicated tour.
10 ;
11 Q
12COREHRS ; main driver for the core hours report
13 ; Get Station Number
14 N Y,%,TSTAMP,%ZIS,POP,INCLUDE,PPI,PPE
15 D NOW^%DTC S Y=% D DD^%DT S TSTAMP=Y
16 ;
17 ; look for core designation in the tours
18 ;
19 D INTRO
20 Q:$$ASK^PRSLIB00(1)
21 S INCLUDE=$$INCLEMP^PRSPCORE()
22 Q:INCLUDE<0
23 S PPI=0
24 I INCLUDE S PPI=$$WHICHPP() Q:PPI<0
25 I PPI>0 S PPE=$P(^PRST(458,PPI,0),U)
26 ; if the pay period is not open then don't try to print employee list
27 I PPI=0 S INCLUDE=0
28 ;
29 S %ZIS="MQ"
30 D ^%ZIS
31 Q:POP
32 I $D(IO("Q")) D
33 . K IO("Q")
34 . N ZTDESC,ZTRTN,ZTSAVE
35 . S ZTDESC="PAID TOURS WITH CORE TIME REPORT",ZTRTN="TOURCHK^PRSPCORE"
36 . S ZTSAVE("TSTAMP")="",ZTSAVE("INCLUDE")="",ZTSAVE("PPI")="",ZTSAVE("PPE")=""
37 . D ^%ZTLOAD
38 .;
39 E D
40 . D TOURCHK
41 Q
42 ;
43INTRO ;always show the option description to the user since this is
44 ; standalone secondary option.
45 N X,Y,DIC,PRSHLP,PRSER,OPTIEN,LN
46 W @IOF,!
47 S X="PRSP PS CORE HRS RPT"
48 S DIC="^DIC(19,"
49 S DIC(0)="MZ"
50 D ^DIC
51 Q:$G(Y)'>0
52 S OPTIEN=+$G(Y)
53 S X=$$GET1^DIQ(19,OPTIEN,3.5,,"PRSHLP","PRSER")
54 S LN=0
55 F S LN=$O(PRSHLP(LN)) Q:LN'>0 D
56 . W !,PRSHLP(LN)
57 S LN=0
58 F S LN=$O(PRSER(LN)) Q:LN'>0 D
59 . W !,PRSER(LN)
60 Q
61HDR(TSTAMP) ;
62 N I,L1
63 W @IOF,!
64 I $G(INCLUDE) W ?2,"Employee search in PP ",PPE," included."
65 W ?(IOM-$L(TSTAMP)-1),TSTAMP
66 S L1="PAID - TOURS OF DUTY WITH PHYS/DENT CORE HOURS SEGMENTS REPORT"
67 W !,?(IOM-$L(L1))/2,L1
68 W !," TOUR #",?10,"TOUR NAME",?50,"SEGMENT"
69 W !
70 F I=1:1:IOM-1 W "-"
71 Q
72 ;
73RET(TSTAMP) ;
74 I ($E(IOST,1,2)'="C-")!($D(ZTQUEUED)) D HDR(TSTAMP) Q 0
75 ;
76 N OUT
77 S OUT=$$ASK^PRSLIB00(1)
78 I 'OUT D HDR(TSTAMP)
79 Q OUT
80 ;
81TOURCHK ; check tour of duty file for tours with special time Phy/Dent core
82 ;
83 ; STIEN-SPECIAL TOUR INDICATOR IEN (457.2)
84 ; STPTR-POINTER FROM TOUR OF DUTY FILE TO THE SPECIAL TOUR IND FILE
85 ;
86 U IO
87 N I,ZNODE,NODE1,OUT,STPTR,STIEN,STCNT,SEGCNT,HASCORE,NODEX,TOUR
88 ; Loop through tours
89 ;
90 S STIEN=$O(^PRST(457.2,"B","Phy/Den Core Hours",0))
91 I STIEN'>0 D Q
92 . D HDR(TSTAMP)
93 . W !!,"REPORT ABORTED!"
94 . W !,"No Phy/Den Core Hours entry found in file 457.2"
95 S (STCNT,TOUR,OUT)=0,NODEX=1
96 D HDR(TSTAMP)
97 F S TOUR=$O(^PRST(457.1,TOUR)) Q:TOUR'>0!(OUT) D
98 . S HASCORE=0
99 . S ZNODE=$G(^PRST(457.1,TOUR,0))
100 . S NODE1=$G(^PRST(457.1,TOUR,1))
101 . ;
102 . ; Loop through 7 Special Codes looking for code
103 . ; #3 Phy/Den Core Hours
104 . ;
105 . S SEGCNT=0
106 . F I=3:3:21 D
107 .. S STPTR=$P(NODE1,U,I)
108 .. I STPTR=STIEN S SEGCNT=SEGCNT+1 D
109 ... S HASCORE=1
110 ... I SEGCNT=1 D
111 .... S STCNT=STCNT+1
112 .... W !!,$J(TOUR,7),?10,$P(ZNODE,U)
113 ... E D
114 .... W !
115 ... W ?50,I/3,": ",$P(NODE1,U,I-2)," - ",$P(NODE1,U,I-1)
116 .;
117 . I $Y>(IOSL-3) S OUT=$$RET(TSTAMP) Q:OUT
118 . I HASCORE S OUT=$$TLLIST^PRSPCORE(TOUR,TSTAMP) Q:OUT
119 . I INCLUDE,HASCORE S OUT=$$EMPLIST(TSTAMP,TOUR,PPI,TOUR) S HASCORE=0 Q:OUT
120 ;
121 ;
122 I STCNT=0 W !!,?5,"No Tours were found with Special Tour Indicator of Phy/Den Core Hrs"
123 D ^%ZISC
124 I $D(ZTSK) S ZTREQ="@"
125 Q
126WHICHPP() ;
127 N PPI,SRT,DFN
128 S PPI=$P($G(^PRST(458,"AD",DT)),U)
129 I PPI'>0 S PPI=$O(^PRST(458,99999),-1)
130 Q:PPI'>0
131 S DFN=0 D NOL^PRSATE2
132 S PPI=$S(SRT="L":PPI-1,SRT="N":PPI+1,SRT="C":PPI,1:-1)
133 Q:PPI<0 PPI
134 I '$G(^PRST(458,PPI,0)) S PPI=0 W !,"No employee tour data available for the unopened pay period."
135 Q PPI
136INCLEMP() ;ASK USER IF THEY WANT TO INCLUDE EMPLOYEES WITH THE TOUR
137 N DIR,DIRUT,Y,INCLUDE
138 S DIR(0)="YA0"
139 S DIR("B")="N"
140 S DIR("A")="List employees with Phys/Den Core Hours Tours?"
141 D ^DIR
142 S INCLUDE=+Y
143 I $D(DIRUT) S INCLUDE=-1
144 Q INCLUDE
145EMPLIST(TS,TR,PPI,STIEN) ;LOOP THRU PP TO DISPLAY EMPS W/ PHY/DEN CORE TOURS
146 ;
147 N PRSIEN,PRSD,TRNODE,TR1,TR2,CORECNT,FOUND,OUT
148 S OUT=0
149 W !
150 S (CORECNT,PRSIEN,OUT)=0
151 ; ^PRST(458,236,"E",12717,"D",12,0) = 12^295^0^9^13198^3050114.11 ...
152 ;
153 F S PRSIEN=$O(^PRST(458,PPI,"E",PRSIEN)) Q:PRSIEN'>0!(OUT) D
154 . S (PRSD,FOUND)=0
155 . F PRSD=1:1:14 D
156 .. S TRNODE=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
157 .. S TR1=$P(TRNODE,U,2)
158 .. S TR2=$P(TRNODE,U,13)
159 .. I (TR1=STIEN)!(TR2=STIEN) S FOUND=1,CORECNT=CORECNT+1 Q
160 . S ZNODE=$G(^PRSPC(PRSIEN,0))
161 . I FOUND W !,?12,$P(ZNODE,U),?45,"T&L: ",$P(ZNODE,U,8),?67,"nnn-nn-",$E($P(ZNODE,U,9),6,9)
162 . I $Y>(IOSL-3) S OUT=$$RET(TSTAMP) Q:OUT
163 I CORECNT=0 W !,?12,"No employees with this core hours tour in pp ",PPE
164 Q OUT
165 ;
166TLLIST(TIE,TSTAMP) ;LOOP THRU TOUR TO DISPLAY ASSOCIATED T&Ls
167 ; INPUT : Tour Internal Entry number
168 ; local vars:
169 ; ATL - Associated T & L unit
170 ; ATLCT - count the assoc tls
171 N ATL,ATLCT,OUT
172 W !,?12,"Associated T&Ls: "
173 I $$GET1^DIQ(457.1,TIE,4,,,)="YES" D Q 0
174 . W "This tour is available to all T&L units."
175 ;
176 S (OUT,ATLCT,ATL)=0
177 F S ATL=$O(^PRST(457.1,TIE,"T","B",ATL)) Q:ATL'>0!(OUT) D
178 . I $X>(IOM-10) D
179 .. W ", ",!,?29
180 . E D
181 .. I ATLCT>0 W ", "
182 . I $Y>(IOSL-3) S OUT=$$RET(TSTAMP) Q:OUT W !!,?12,"Associated T&Ls: "
183 . S ATLCT=ATLCT+1
184 . W $$GET1^DIQ(455.5,ATL,.01,,,)
185 I ATLCT=0 W "No T&L units are associated with this tour."
186 Q OUT
Note: See TracBrowser for help on using the repository browser.