source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPCPP1.m@ 1789

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PRSPCPP1 ; HISC/MGD - DISPLAY CURRENT PP ESR EXCEPTIONS #2 ;05/17/05
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4LOOP ; Loop through employees
5 N DATA,NAME
6 S NAME="",(PG,QT)=0,DASH="",$P(DASH,"_",80)="_"
7 W:$E(IOST,1,2)="C-" @IOF
8 F S NAME=$O(^TMP($J,"PRSPCPPE DATA",NAME)) Q:NAME="" D Q:QT
9 . S DATA=^TMP($J,"PRSPCPPE DATA",NAME)
10 . S PRSIEN=$P(DATA,U,1),IDAYS=$P(DATA,U,2)
11 . I $E(IOST,1,2)="C-" D Q:QT
12 . . I PG D PSE Q:QT
13 . . S PG=1
14 . . D HDR1,DIS
15 . I $E(IOST,1,2)'="C-" D Q:QT
16 . . I $Y'>(IOSL-15),'PG D HDR1 S PG=1 D DIS Q
17 . . I $Y'>(IOSL-15),PG W !! D HDR1,DIS Q
18 . . D PSE Q:QT S PG=0 D HDR1,DIS Q
19 ;
20 Q:QT
21 I '$D(^TMP($J,"PRSPCPPE DATA")) D
22 . I $E(IOST,1,2)="C-" W @IOF
23 . W "DISPLAY PP ESR EXCEPTIONS",?50,$$FMTE^XLFDT($$NOW^XLFDT()),!!
24 . W "No exceptions were found in the specified T&Ls for pay period ",PPE,!
25 I $E(IOST,1,2)="C-" D PSE W @IOF
26 Q
27 ;
28DIS ; Display 14 days
29 ;
30 S PDT=$G(^PRST(458,PPI,2)),STAT=$P($G(^PRST(458,PPI,"E",PRSIEN,0)),"^",2)
31 S IDAYS=0
32 F DAY=1:1:14 D Q:QT
33 . S DATA7=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7))
34 . S STAT=$P(DATA7,U,1) ; ESR Daily Status
35 . I STAT<4 S IDAYS=IDAYS+1
36 ; Check to see if the PTP had a memorandum during this PP.
37 S DAY1=$P($G(^PRST(458,PPI,1)),U,1)
38 I +$$MIEN^PRSPUT1(PRSIEN,DAY1)=0 D Q:QT
39 . W !!,"This employee did not have an active Memorandum during this Pay Period."
40 . S QT=1
41 F DAY=1:1:14 D Q:QT
42 . S DATA0=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,0))
43 . S DATA5=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
44 . S DATA6=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,6))
45 . S DATA7=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7))
46 . S T1=$P(DATA0,U,2) ; Tour #1
47 . S T1EX=$S(T1:$P($G(^PRST(457.1,T1,0)),U,1),1:"") ; Tour #1 External
48 . S STAT=$P(DATA7,U,1) ; ESR Daily Status
49 . Q:STAT>3 ; Only display exceptions
50 . S STATEX=$$EXTERNAL^DILFD(458.02,146,"",STAT)
51 . I $Y>(IOSL-3) D PSE Q:QT D HDR1
52 . W !,$P(PDT,U,DAY),?14,$J(T1,4)," ",T1EX,?68," ",STATEX
53 . S T2=$P(DATA0,U,13) ; Tour #2
54 . I T2 D Q:QT
55 . . S T2EX=$S(T2:$P($G(^PRST(457.1,T2,0)),U,1),1:"") ; Tour #2 External
56 . . I $Y>(IOSL-3) D PSE Q:QT D HDR1
57 . . W !?14,$J(T2,4)," ",T2EX
58 . S EDLSM=$P(DATA7,U,3) ; ESR DAY LAST SIGN METHOD
59 . I EDLSM=2 S STATEX=STATEX_" - EA" ; Posted by Extended Absence
60 . S QUIT=0
61 . F SEG=1:5:31 D Q:QT!(QUIT)
62 . . S START=$P(DATA5,U,SEG)
63 . . I START="",SEG>1 S QUIT=1
64 . . Q:START=""
65 . . S STOP=$P(DATA5,U,SEG+1),TOT=$P(DATA5,U,SEG+2)
66 . . S TOTEX=""
67 . . I TOT'="" D
68 . . . S TOTEX=$O(^PRST(457.3,"B",TOT,0))
69 . . . S TOTEX=$E($P($G(^PRST(457.3,TOTEX,0)),U,2),1,14)
70 . . . S TOTEX=TOT_" "_TOTEX
71 . . S RC=$P(DATA5,U,SEG+3),MT=$P(DATA5,U,SEG+4)
72 . . S HRS=$$ELAPSE^PRSPESR2(MT,START,STOP)
73 . . I $Y>(IOSL-3) D PSE Q:QT D HDR1
74 . . W !?21,START,"-",STOP,?36,TOTEX,?56,$J(MT,2)," ",$J(HRS,5)
75 . . I RC'="" D Q:QT!(QUIT)
76 . . . S RCEX=$P($G(^PRST(457.4,RC,0)),U,4)
77 . . . I $Y>(IOSL-3) D PSE Q:QT D HDR1
78 . . . W !?38,RCEX
79 . . Q:QT!(QUIT)
80 . Q:QT!(QUIT)
81 . ;
82 . ; Display any PTP or Supervisor Remarks
83 . S PTPRMKS=$P(DATA6,U,1) ; PTP Remarks
84 . I PTPRMKS'="" D Q:QT
85 . . I $Y>(IOSL-3) D PSE Q:QT D HDR1
86 . . W !," PTP Remarks: ",PTPRMKS
87 . S SUPRMKS=$P(DATA6,U,2) ; Supervisor Remarks
88 . I SUPRMKS'="" D Q:QT
89 . . I $Y>(IOSL-3) D PSE Q:QT D HDR1
90 . . W !," Sup Remarks: ",SUPRMKS
91 Q
92 ;====================================================================
93HDR1 S SCRTTL="PT PHYSICIAN ESR FOR PP "_PPE
94 D HDR^PRSPUT1(PRSIEN,SCRTTL,,,PPI)
95 W !?30,"Incomplete Days: "_$J(IDAYS,2)
96 W !,"Day",?14,"Tour Description",?69,"Status"
97 W !?21,"Postings",?36,"Time Code",?55,"Meal Hours"
98 W !?38,"Remarks Code"
99 W !,DASH
100 Q
101 ;
102PSE I $E(IOST,1,2)="C-" D
103 . W !
104 . S DIR(0)="E",DIR("A")="Press RETURN to continue"
105 . D ^DIR K DIR
106 . I $D(DIRUT) S QT=1
107 Q:QT
108 W @IOF
109 Q
Note: See TracBrowser for help on using the repository browser.