PRSPEAD.m

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 ---PRSPEAD   1146     printed  Apr 09, 2024@21:32:09                                                                                                                                                                                                     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