PRSPEAD ;WOIFO/SAB - DISPLAY EXTENDED ABSENCE ;10/20/2004
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
; Display List of Extended Absences
;
N CNT,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EAIEN,OUT,PG,PRSIEN,TDT,X,Y
;
; determine Employee IEN
S PRSIEN=$$PRSIEN^PRSPUT2(1)
I 'PRSIEN G EXIT
;
S (CNT,OUT,PG)=0
D HD
;
W !?24,"VA TIME & ATTENDANCE SYSTEM",!?26,"DISPLAY EXTENDED ABSENCE",!
;
; ask date
S DIR(0)="D^::EX",DIR("A")="Begin with Date",DIR("B")="T"
D ^DIR K DIR G:$D(DIRUT) EXIT
;
; loop thru employee extended absences by to date
S TDT=Y-.01
F S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT)) Q:TDT="" D Q:OUT
. S EAIEN=0
. F S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN D Q:OUT
. . I $Y+6>IOSL D HD Q:OUT
. . D DISEA^PRSPEAU(EAIEN)
. . S CNT=CNT+1
;
I 'OUT,CNT=0 W !!,"No extended absence records on file."
I 'OUT S DIR(0)="E" D ^DIR K DIR
;
EXIT ; exit point
Q
;
HD ; header
I $E(IOST,1,2)="C-",PG S DIR(0)="E" D ^DIR K DIR I 'Y S OUT=1 Q
I $E(IOST,1,2)="C-"!PG W @IOF
S PG=PG+1
Q
;
;PRSPEAD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPEAD 1146 printed Nov 22, 2024@17:37:58 Page 2
PRSPEAD ;WOIFO/SAB - DISPLAY EXTENDED ABSENCE ;10/20/2004
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ; Display List of Extended Absences
+4 ;
+5 NEW CNT,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EAIEN,OUT,PG,PRSIEN,TDT,X,Y
+6 ;
+7 ; determine Employee IEN
+8 SET PRSIEN=$$PRSIEN^PRSPUT2(1)
+9 IF 'PRSIEN
GOTO EXIT
+10 ;
+11 SET (CNT,OUT,PG)=0
+12 DO HD
+13 ;
+14 WRITE !?24,"VA TIME & ATTENDANCE SYSTEM",!?26,"DISPLAY EXTENDED ABSENCE",!
+15 ;
+16 ; ask date
+17 SET DIR(0)="D^::EX"
SET DIR("A")="Begin with Date"
SET DIR("B")="T"
+18 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+19 ;
+20 ; loop thru employee extended absences by to date
+21 SET TDT=Y-.01
+22 FOR
SET TDT=$ORDER(^PRST(458.4,"AEE",PRSIEN,TDT))
if TDT=""
QUIT
Begin DoDot:1
+23 SET EAIEN=0
+24 FOR
SET EAIEN=$ORDER(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN))
if 'EAIEN
QUIT
Begin DoDot:2
+25 IF $Y+6>IOSL
DO HD
if OUT
QUIT
+26 DO DISEA^PRSPEAU(EAIEN)
+27 SET CNT=CNT+1
End DoDot:2
if OUT
QUIT
End DoDot:1
if OUT
QUIT
+28 ;
+29 IF 'OUT
IF CNT=0
WRITE !!,"No extended absence records on file."
+30 IF 'OUT
SET DIR(0)="E"
DO ^DIR
KILL DIR
+31 ;
EXIT ; exit point
+1 QUIT
+2 ;
HD ; header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET OUT=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"!PG
WRITE @IOF
+3 SET PG=PG+1
+4 QUIT
+5 ;
+6 ;PRSPEAD
