PRSPCPP1 ; HISC/MGD - DISPLAY CURRENT PP ESR EXCEPTIONS #2 ;05/17/05
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
LOOP ; Loop through employees
N DATA,NAME
S NAME="",(PG,QT)=0,DASH="",$P(DASH,"_",80)="_"
W:$E(IOST,1,2)="C-" @IOF
F S NAME=$O(^TMP($J,"PRSPCPPE DATA",NAME)) Q:NAME="" D Q:QT
. S DATA=^TMP($J,"PRSPCPPE DATA",NAME)
. S PRSIEN=$P(DATA,U,1),IDAYS=$P(DATA,U,2)
. I $E(IOST,1,2)="C-" D Q:QT
. . I PG D PSE Q:QT
. . S PG=1
. . D HDR1,DIS
. I $E(IOST,1,2)'="C-" D Q:QT
. . I $Y'>(IOSL-15),'PG D HDR1 S PG=1 D DIS Q
. . I $Y'>(IOSL-15),PG W !! D HDR1,DIS Q
. . D PSE Q:QT S PG=0 D HDR1,DIS Q
;
Q:QT
I '$D(^TMP($J,"PRSPCPPE DATA")) D
. I $E(IOST,1,2)="C-" W @IOF
. W "DISPLAY PP ESR EXCEPTIONS",?50,$$FMTE^XLFDT($$NOW^XLFDT()),!!
. W "No exceptions were found in the specified T&Ls for pay period ",PPE,!
I $E(IOST,1,2)="C-" D PSE W @IOF
Q
;
DIS ; Display 14 days
;
S PDT=$G(^PRST(458,PPI,2)),STAT=$P($G(^PRST(458,PPI,"E",PRSIEN,0)),"^",2)
S IDAYS=0
F DAY=1:1:14 D Q:QT
. S DATA7=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7))
. S STAT=$P(DATA7,U,1) ; ESR Daily Status
. I STAT<4 S IDAYS=IDAYS+1
; Check to see if the PTP had a memorandum during this PP.
S DAY1=$P($G(^PRST(458,PPI,1)),U,1)
I +$$MIEN^PRSPUT1(PRSIEN,DAY1)=0 D Q:QT
. W !!,"This employee did not have an active Memorandum during this Pay Period."
. S QT=1
F DAY=1:1:14 D Q:QT
. S DATA0=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,0))
. S DATA5=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
. S DATA6=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,6))
. S DATA7=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7))
. S T1=$P(DATA0,U,2) ; Tour #1
. S T1EX=$S(T1:$P($G(^PRST(457.1,T1,0)),U,1),1:"") ; Tour #1 External
. S STAT=$P(DATA7,U,1) ; ESR Daily Status
. Q:STAT>3 ; Only display exceptions
. S STATEX=$$EXTERNAL^DILFD(458.02,146,"",STAT)
. I $Y>(IOSL-3) D PSE Q:QT D HDR1
. W !,$P(PDT,U,DAY),?14,$J(T1,4)," ",T1EX,?68," ",STATEX
. S T2=$P(DATA0,U,13) ; Tour #2
. I T2 D Q:QT
. . S T2EX=$S(T2:$P($G(^PRST(457.1,T2,0)),U,1),1:"") ; Tour #2 External
. . I $Y>(IOSL-3) D PSE Q:QT D HDR1
. . W !?14,$J(T2,4)," ",T2EX
. S EDLSM=$P(DATA7,U,3) ; ESR DAY LAST SIGN METHOD
. I EDLSM=2 S STATEX=STATEX_" - EA" ; Posted by Extended Absence
. S QUIT=0
. F SEG=1:5:31 D Q:QT!(QUIT)
. . S START=$P(DATA5,U,SEG)
. . I START="",SEG>1 S QUIT=1
. . Q:START=""
. . S STOP=$P(DATA5,U,SEG+1),TOT=$P(DATA5,U,SEG+2)
. . S TOTEX=""
. . I TOT'="" D
. . . S TOTEX=$O(^PRST(457.3,"B",TOT,0))
. . . S TOTEX=$E($P($G(^PRST(457.3,TOTEX,0)),U,2),1,14)
. . . S TOTEX=TOT_" "_TOTEX
. . S RC=$P(DATA5,U,SEG+3),MT=$P(DATA5,U,SEG+4)
. . S HRS=$$ELAPSE^PRSPESR2(MT,START,STOP)
. . I $Y>(IOSL-3) D PSE Q:QT D HDR1
. . W !?21,START,"-",STOP,?36,TOTEX,?56,$J(MT,2)," ",$J(HRS,5)
. . I RC'="" D Q:QT!(QUIT)
. . . S RCEX=$P($G(^PRST(457.4,RC,0)),U,4)
. . . I $Y>(IOSL-3) D PSE Q:QT D HDR1
. . . W !?38,RCEX
. . Q:QT!(QUIT)
. Q:QT!(QUIT)
. ;
. ; Display any PTP or Supervisor Remarks
. S PTPRMKS=$P(DATA6,U,1) ; PTP Remarks
. I PTPRMKS'="" D Q:QT
. . I $Y>(IOSL-3) D PSE Q:QT D HDR1
. . W !," PTP Remarks: ",PTPRMKS
. S SUPRMKS=$P(DATA6,U,2) ; Supervisor Remarks
. I SUPRMKS'="" D Q:QT
. . I $Y>(IOSL-3) D PSE Q:QT D HDR1
. . W !," Sup Remarks: ",SUPRMKS
Q
;====================================================================
HDR1 S SCRTTL="PT PHYSICIAN ESR FOR PP "_PPE
D HDR^PRSPUT1(PRSIEN,SCRTTL,,,PPI)
W !?30,"Incomplete Days: "_$J(IDAYS,2)
W !,"Day",?14,"Tour Description",?69,"Status"
W !?21,"Postings",?36,"Time Code",?55,"Meal Hours"
W !?38,"Remarks Code"
W !,DASH
Q
;
PSE I $E(IOST,1,2)="C-" D
. W !
. S DIR(0)="E",DIR("A")="Press RETURN to continue"
. D ^DIR K DIR
. I $D(DIRUT) S QT=1
Q:QT
W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPCPP1 3910 printed Apr 09, 2024@21:26:19 Page 2
PRSPCPP1 ; HISC/MGD - DISPLAY CURRENT PP ESR EXCEPTIONS #2 ;05/17/05
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
LOOP ; Loop through employees
+1 NEW DATA,NAME
+2 SET NAME=""
SET (PG,QT)=0
SET DASH=""
SET $PIECE(DASH,"_",80)="_"
+3 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+4 FOR
SET NAME=$ORDER(^TMP($JOB,"PRSPCPPE DATA",NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 SET DATA=^TMP($JOB,"PRSPCPPE DATA",NAME)
+6 SET PRSIEN=$PIECE(DATA,U,1)
SET IDAYS=$PIECE(DATA,U,2)
+7 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+8 IF PG
DO PSE
if QT
QUIT
+9 SET PG=1
+10 DO HDR1
DO DIS
End DoDot:2
if QT
QUIT
+11 IF $EXTRACT(IOST,1,2)'="C-"
Begin DoDot:2
+12 IF $Y'>(IOSL-15)
IF 'PG
DO HDR1
SET PG=1
DO DIS
QUIT
+13 IF $Y'>(IOSL-15)
IF PG
WRITE !!
DO HDR1
DO DIS
QUIT
+14 DO PSE
if QT
QUIT
SET PG=0
DO HDR1
DO DIS
QUIT
End DoDot:2
if QT
QUIT
End DoDot:1
if QT
QUIT
+15 ;
+16 if QT
QUIT
+17 IF '$DATA(^TMP($JOB,"PRSPCPPE DATA"))
Begin DoDot:1
+18 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+19 WRITE "DISPLAY PP ESR EXCEPTIONS",?50,$$FMTE^XLFDT($$NOW^XLFDT()),!!
+20 WRITE "No exceptions were found in the specified T&Ls for pay period ",PPE,!
End DoDot:1
+21 IF $EXTRACT(IOST,1,2)="C-"
DO PSE
WRITE @IOF
+22 QUIT
+23 ;
DIS ; Display 14 days
+1 ;
+2 SET PDT=$GET(^PRST(458,PPI,2))
SET STAT=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,0)),"^",2)
+3 SET IDAYS=0
+4 FOR DAY=1:1:14
Begin DoDot:1
+5 SET DATA7=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7))
+6 ; ESR Daily Status
SET STAT=$PIECE(DATA7,U,1)
+7 IF STAT<4
SET IDAYS=IDAYS+1
End DoDot:1
if QT
QUIT
+8 ; Check to see if the PTP had a memorandum during this PP.
+9 SET DAY1=$PIECE($GET(^PRST(458,PPI,1)),U,1)
+10 IF +$$MIEN^PRSPUT1(PRSIEN,DAY1)=0
Begin DoDot:1
+11 WRITE !!,"This employee did not have an active Memorandum during this Pay Period."
+12 SET QT=1
End DoDot:1
if QT
QUIT
+13 FOR DAY=1:1:14
Begin DoDot:1
+14 SET DATA0=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,0))
+15 SET DATA5=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
+16 SET DATA6=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,6))
+17 SET DATA7=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7))
+18 ; Tour #1
SET T1=$PIECE(DATA0,U,2)
+19 ; Tour #1 External
SET T1EX=$SELECT(T1:$PIECE($GET(^PRST(457.1,T1,0)),U,1),1:"")
+20 ; ESR Daily Status
SET STAT=$PIECE(DATA7,U,1)
+21 ; Only display exceptions
if STAT>3
QUIT
+22 SET STATEX=$$EXTERNAL^DILFD(458.02,146,"",STAT)
+23 IF $Y>(IOSL-3)
DO PSE
if QT
QUIT
DO HDR1
+24 WRITE !,$PIECE(PDT,U,DAY),?14,$JUSTIFY(T1,4)," ",T1EX,?68," ",STATEX
+25 ; Tour #2
SET T2=$PIECE(DATA0,U,13)
+26 IF T2
Begin DoDot:2
+27 ; Tour #2 External
SET T2EX=$SELECT(T2:$PIECE($GET(^PRST(457.1,T2,0)),U,1),1:"")
+28 IF $Y>(IOSL-3)
DO PSE
if QT
QUIT
DO HDR1
+29 WRITE !?14,$JUSTIFY(T2,4)," ",T2EX
End DoDot:2
if QT
QUIT
+30 ; ESR DAY LAST SIGN METHOD
SET EDLSM=$PIECE(DATA7,U,3)
+31 ; Posted by Extended Absence
IF EDLSM=2
SET STATEX=STATEX_" - EA"
+32 SET QUIT=0
+33 FOR SEG=1:5:31
Begin DoDot:2
+34 SET START=$PIECE(DATA5,U,SEG)
+35 IF START=""
IF SEG>1
SET QUIT=1
+36 if START=""
QUIT
+37 SET STOP=$PIECE(DATA5,U,SEG+1)
SET TOT=$PIECE(DATA5,U,SEG+2)
+38 SET TOTEX=""
+39 IF TOT'=""
Begin DoDot:3
+40 SET TOTEX=$ORDER(^PRST(457.3,"B",TOT,0))
+41 SET TOTEX=$EXTRACT($PIECE($GET(^PRST(457.3,TOTEX,0)),U,2),1,14)
+42 SET TOTEX=TOT_" "_TOTEX
End DoDot:3
+43 SET RC=$PIECE(DATA5,U,SEG+3)
SET MT=$PIECE(DATA5,U,SEG+4)
+44 SET HRS=$$ELAPSE^PRSPESR2(MT,START,STOP)
+45 IF $Y>(IOSL-3)
DO PSE
if QT
QUIT
DO HDR1
+46 WRITE !?21,START,"-",STOP,?36,TOTEX,?56,$JUSTIFY(MT,2)," ",$JUSTIFY(HRS,5)
+47 IF RC'=""
Begin DoDot:3
+48 SET RCEX=$PIECE($GET(^PRST(457.4,RC,0)),U,4)
+49 IF $Y>(IOSL-3)
DO PSE
if QT
QUIT
DO HDR1
+50 WRITE !?38,RCEX
End DoDot:3
if QT!(QUIT)
QUIT
+51 if QT!(QUIT)
QUIT
End DoDot:2
if QT!(QUIT)
QUIT
+52 if QT!(QUIT)
QUIT
+53 ;
+54 ; Display any PTP or Supervisor Remarks
+55 ; PTP Remarks
SET PTPRMKS=$PIECE(DATA6,U,1)
+56 IF PTPRMKS'=""
Begin DoDot:2
+57 IF $Y>(IOSL-3)
DO PSE
if QT
QUIT
DO HDR1
+58 WRITE !," PTP Remarks: ",PTPRMKS
End DoDot:2
if QT
QUIT
+59 ; Supervisor Remarks
SET SUPRMKS=$PIECE(DATA6,U,2)
+60 IF SUPRMKS'=""
Begin DoDot:2
+61 IF $Y>(IOSL-3)
DO PSE
if QT
QUIT
DO HDR1
+62 WRITE !," Sup Remarks: ",SUPRMKS
End DoDot:2
if QT
QUIT
End DoDot:1
if QT
QUIT
+63 QUIT
+64 ;====================================================================
HDR1 SET SCRTTL="PT PHYSICIAN ESR FOR PP "_PPE
+1 DO HDR^PRSPUT1(PRSIEN,SCRTTL,,,PPI)
+2 WRITE !?30,"Incomplete Days: "_$JUSTIFY(IDAYS,2)
+3 WRITE !,"Day",?14,"Tour Description",?69,"Status"
+4 WRITE !?21,"Postings",?36,"Time Code",?55,"Meal Hours"
+5 WRITE !?38,"Remarks Code"
+6 WRITE !,DASH
+7 QUIT
+8 ;
PSE IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+1 WRITE !
+2 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET QT=1
End DoDot:1
+5 if QT
QUIT
+6 WRITE @IOF
+7 QUIT
