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 ---[H[J[2J[HPRSPEAN 1930 printed Oct 16, 2024@18:28:43 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
