| 1 | PRSPEAN ;WOIFO/SAB - NEW EXTENDED ABSENCE ;10/20/2004
|
|---|
| 2 | ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ; Enter New Extended Absence
|
|---|
| 5 | ;
|
|---|
| 6 | N DA,DDSFILE,DDSCHANG,DDSPARM,DIC,DIK,DIR,DIROUT,DIRUT,DO,DR,DTOUT,DUOUT
|
|---|
| 7 | N EAIEN,PRSEANEW,PRSFDT,PRSIEN,PRSX,X,Y
|
|---|
| 8 | ;
|
|---|
| 9 | ; determine Employee IEN
|
|---|
| 10 | S PRSIEN=$$PRSIEN^PRSPUT2(1)
|
|---|
| 11 | I 'PRSIEN G EXIT
|
|---|
| 12 | ;
|
|---|
| 13 | ; verify that user has electronic signature code
|
|---|
| 14 | I '$$ESIGC^PRSPUT2(1) G EXIT
|
|---|
| 15 | ;
|
|---|
| 16 | FDT ; ask new from date
|
|---|
| 17 | S DIR(0)="D^DT:"_$$FMADD^XLFDT(DT,365)_":EX",DIR("A")="FROM DATE"
|
|---|
| 18 | S DIR("?")="Enter the beginning date for a new period of extended absence"
|
|---|
| 19 | D ^DIR K DIR G:$D(DIRUT) EXIT
|
|---|
| 20 | S PRSFDT=$P(Y,U)
|
|---|
| 21 | ;
|
|---|
| 22 | ; If From Date = Today make sure ESR not already posted with RG time.
|
|---|
| 23 | I PRSFDT=DT,$$CHKRG^PRSPEAU(PRSIEN) D G FDT
|
|---|
| 24 | . W $C(7),!,"From Date can't be Today because RG time already posted on the ESR!"
|
|---|
| 25 | ;
|
|---|
| 26 | ; check for conflicts with from date
|
|---|
| 27 | S PRSX=$$CONFLICT^PRSPEAU(PRSIEN,PRSFDT)
|
|---|
| 28 | I PRSX'="" D RCON^PRSPEAU(PRSX) G FDT
|
|---|
| 29 | ;
|
|---|
| 30 | ; if date changed and new date not under memo then warn user
|
|---|
| 31 | 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
|
|---|
| 32 | ;
|
|---|
| 33 | ; create new entry in file
|
|---|
| 34 | K DO S DIC="^PRST(458.4,",DIC(0)="",X=PRSFDT
|
|---|
| 35 | S DIC("DR")="2////^S X=PRSIEN"
|
|---|
| 36 | D FILE^DICN
|
|---|
| 37 | I Y<0 W $C(7),!,"Unable to add an extended absence to the file." G EXIT
|
|---|
| 38 | S EAIEN=+Y
|
|---|
| 39 | ;
|
|---|
| 40 | ; lock record
|
|---|
| 41 | L +^PRST(458.4,EAIEN):2
|
|---|
| 42 | I '$T D G EXIT
|
|---|
| 43 | . W $C(7),!,"ERROR: Unable to lock the new entry!"
|
|---|
| 44 | . S DIK="^PRST(458.4,",DA=EAIEN D ^DIK K DIK
|
|---|
| 45 | ;
|
|---|
| 46 | ; call form to edit entry
|
|---|
| 47 | S PRSEANEW=1
|
|---|
| 48 | S DDSFILE=458.4,DA=EAIEN,DR="[PRSP EXT ABSENCE]",DDSPARM="C"
|
|---|
| 49 | D ^DDS
|
|---|
| 50 | ;
|
|---|
| 51 | ; delete new entry if not saved
|
|---|
| 52 | I $G(DDSCHANG)'=1 S DIK="^PRST(458.4,",DA=EAIEN D ^DIK K DIK
|
|---|
| 53 | ;
|
|---|
| 54 | ; unlock record
|
|---|
| 55 | L -^PRST(458.4,EAIEN)
|
|---|
| 56 | ;
|
|---|
| 57 | EXIT ; exit point
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | ;PRSPEAN
|
|---|
