PRSPEAN.m

PRSPEAN ;WOIFO/SAB - NEW 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.

 ; Enter New Extended Absence

 ;

 N DA,DDSFILE,DDSCHANG,DDSPARM,DIC,DIK,DIR,DIROUT,DIRUT,DO,DR,DTOUT,DUOUT

 N EAIEN,PRSEANEW,PRSFDT,PRSIEN,PRSX,X,Y

 ;

 ; determine Employee IEN

 S PRSIEN=$$PRSIEN^PRSPUT2(1)

 I 'PRSIEN G EXIT

 ;

 ; verify that user has electronic signature code

 I '$$ESIGC^PRSPUT2(1) G EXIT

 ;

FDT ; ask new from date

 S DIR(0)="D^DT:"_$$FMADD^XLFDT(DT,365)_":EX",DIR("A")="FROM DATE"

 S DIR("?")="Enter the beginning date for a new period of extended absence"

 D ^DIR K DIR G:$D(DIRUT) EXIT

 S PRSFDT=$P(Y,U)

 ;

 ; If From Date = Today make sure ESR not already posted with RG time.

 I PRSFDT=DT,$$CHKRG^PRSPEAU(PRSIEN) D  G FDT

 . W $C(7),!,"From Date can't be Today because RG time already posted on the ESR!"

 ;

 ; check for conflicts with from date

 S PRSX=$$CONFLICT^PRSPEAU(PRSIEN,PRSFDT)

 I PRSX'="" D RCON^PRSPEAU(PRSX) G FDT

 ;

 ; if date changed and new date not under memo then warn user

 I $$MIEN^PRSPUT1(PRSIEN,PRSFDT)'>0 W $C(7),!!,"Note: From Date is not covered by a memo." S DIR(0)="E" D ^DIR K DIK G:$D(DIRUT) EXIT

 ;

 ; create new entry in file

 K DO S DIC="^PRST(458.4,",DIC(0)="",X=PRSFDT

 S DIC("DR")="2////^S X=PRSIEN"

 D FILE^DICN

 I Y<0 W $C(7),!,"Unable to add an extended absence to the file." G EXIT

 S EAIEN=+Y

 ;

 ; lock record

 L +^PRST(458.4,EAIEN):2

 I '$T D  G EXIT

 . W $C(7),!,"ERROR: Unable to lock the new entry!"

 . S DIK="^PRST(458.4,",DA=EAIEN D ^DIK K DIK

 ;

 ; call form to edit entry

 S PRSEANEW=1

 S DDSFILE=458.4,DA=EAIEN,DR="[PRSP EXT ABSENCE]",DDSPARM="C"

 D ^DDS

 ;

 ; delete new entry if not saved

 I $G(DDSCHANG)'=1 S DIK="^PRST(458.4,",DA=EAIEN D ^DIK K DIK

 ;

 ; unlock record

 L -^PRST(458.4,EAIEN)

 ;

EXIT ; exit point

 Q

 ;

 ;PRSPEAN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRSPEAN   1930     printed  Mar 13, 2025@21:33                                                                                                                                                                                                        Page 2

PRSPEAN   ;WOIFO/SAB - NEW 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       ; Enter New Extended Absence

 +4       ;

 +5        NEW DA,DDSFILE,DDSCHANG,DDSPARM,DIC,DIK,DIR,DIROUT,DIRUT,DO,DR,DTOUT,DUOUT

 +6        NEW EAIEN,PRSEANEW,PRSFDT,PRSIEN,PRSX,X,Y

 +7       ;

 +8       ; determine Employee IEN

 +9        SET PRSIEN=$$PRSIEN^PRSPUT2(1)

 +10       IF 'PRSIEN

               GOTO EXIT

 +11      ;

 +12      ; verify that user has electronic signature code

 +13       IF '$$ESIGC^PRSPUT2(1)

               GOTO EXIT

 +14      ;

FDT       ; ask new from date

 +1        SET DIR(0)="D^DT:"_$$FMADD^XLFDT(DT,365)_":EX"

           SET DIR("A")="FROM DATE"

 +2        SET DIR("?")="Enter the beginning date for a new period of extended absence"

 +3        DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO EXIT

 +4        SET PRSFDT=$PIECE(Y,U)

 +5       ;

 +6       ; If From Date = Today make sure ESR not already posted with RG time.

 +7        IF PRSFDT=DT

               IF $$CHKRG^PRSPEAU(PRSIEN)

                   Begin DoDot:1

 +8                    WRITE $CHAR(7),!,"From Date can't be Today because RG time already posted on the ESR!"

                   End DoDot:1

                   GOTO FDT

 +9       ;

 +10      ; check for conflicts with from date

 +11       SET PRSX=$$CONFLICT^PRSPEAU(PRSIEN,PRSFDT)

 +12       IF PRSX'=""

               DO RCON^PRSPEAU(PRSX)

               GOTO FDT

 +13      ;

 +14      ; if date changed and new date not under memo then warn user

 +15       IF $$MIEN^PRSPUT1(PRSIEN,PRSFDT)'>0

               WRITE $CHAR(7),!!,"Note: From Date is not covered by a memo."

               SET DIR(0)="E"

               DO ^DIR

               KILL DIK

               if $DATA(DIRUT)

                   GOTO EXIT

 +16      ;

 +17      ; create new entry in file

 +18       KILL DO

           SET DIC="^PRST(458.4,"

           SET DIC(0)=""

           SET X=PRSFDT

 +19       SET DIC("DR")="2////^S X=PRSIEN"

 +20       DO FILE^DICN

 +21       IF Y<0

               WRITE $CHAR(7),!,"Unable to add an extended absence to the file."

               GOTO EXIT

 +22       SET EAIEN=+Y

 +23      ;

 +24      ; lock record

 +25       LOCK +^PRST(458.4,EAIEN):2

 +26       IF '$TEST

               Begin DoDot:1

 +27               WRITE $CHAR(7),!,"ERROR: Unable to lock the new entry!"

 +28               SET DIK="^PRST(458.4,"

                   SET DA=EAIEN

                   DO ^DIK

                   KILL DIK

               End DoDot:1

               GOTO EXIT

 +29      ;

 +30      ; call form to edit entry

 +31       SET PRSEANEW=1

 +32       SET DDSFILE=458.4

           SET DA=EAIEN

           SET DR="[PRSP EXT ABSENCE]"

           SET DDSPARM="C"

 +33       DO ^DDS

 +34      ;

 +35      ; delete new entry if not saved

 +36       IF $GET(DDSCHANG)'=1

               SET DIK="^PRST(458.4,"

               SET DA=EAIEN

               DO ^DIK

               KILL DIK

 +37      ;

 +38      ; unlock record

 +39       LOCK -^PRST(458.4,EAIEN)

 +40      ;

EXIT      ; exit point

 +1        QUIT 

 +2       ;

 +3       ;PRSPEAN