source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPEAN.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PRSPEAN ;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 ;
16FDT ; 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 ;
57EXIT ; exit point
58 Q
59 ;
60 ;PRSPEAN
Note: See TracBrowser for help on using the repository browser.