Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSALVR

PRSALVR.m

Go to the documentation of this file.
  1. PRSALVR ;HISC/REL - Leave Request ;11/30/2004
  1. ;;4.0;PAID;**61,93**;Sep 21, 1995;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0))
  1. I 'DFN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX
  1. S TLE=$P($G(^PRSPC(DFN,0)),"^",8) S:TLE="" TLE=" " S TLI=+$O(^PRST(455.5,"B",TLE,0))
  1. D ^PRSAENT S ZENT="",Z1="30 31 31 31 32 33 28 35 35 34 30",Z2="AL SL CB AD NL WP CU AA DL ML RL"
  1. F K=1:1:11 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" "
  1. I ZENT="" W !!?5,"You are not entitled to any type of Leave." G EX
  1. L +^PRST(458.1,0) K DDSFILE,DA,DR
  1. N1 S DA=$P(^PRST(458.1,0),"^",3)+1 I $D(^PRST(458.1,DA)) S $P(^PRST(458.1,0),"^",3)=DA G N1
  1. S $P(^PRST(458.1,0),"^",3)=DA,$P(^(0),"^",4)=$P(^(0),"^",4)+1 L -^PRST(458.1,0)
  1. S ^PRST(458.1,DA,0)=DA_"^"_DFN,^PRST(458.1,"B",DA,DA)="",^PRST(458.1,"C",DFN,DA)=""
  1. S ZOLD=^PRST(458.1,DA,0) D ED
  1. K DIR S DIR("A")="Do you wish to enter another Leave Request? ",DIR(0)="YA",DIR("B")="No" W ! D ^DIR G PRSALVR:Y,EX Q
  1. ED ; Edit Leave Request
  1. ;
  1. N PPLCK,PPLCKE,SKIP
  1. ; if request is approved and employee has any part-time physician memos
  1. ; then lock appropriate pay periods
  1. S SKIP=0
  1. I $P(ZOLD,U,12),$$PTP^PRSPUT3($P(ZOLD,U,2)) D
  1. . ; lock applicable time cards
  1. . D LCK^PRSPAPU($P(ZOLD,U,2),$$FMADD^XLFDT($P(ZOLD,U,3),-1),$P(ZOLD,U,5),.PPLCK,.PPLCKE)
  1. . ; if problem locking time cards
  1. . I $D(PPLCKE) D
  1. . . S SKIP=1 ; set flag to skip edit of leave
  1. . . D TCULCK^PRSPAPU($P(ZOLD,U,2),.PPLCK) ; unlock any locked PP
  1. . . D RLCKE^PRSPAPU(.PPLCKE) ; report problems
  1. Q:SKIP ; don't proceed with edit
  1. ;
  1. S $P(^PRST(458.1,DA,0),"^",16)=$S(ENT["D":"D",1:"H") S X="IOUON;IOUOFF" D ENDR^%ZISS
  1. S Y15=IOUON_"Number of "_$S(ENT["D":"Days",1:"Hours")_IOUOFF_":"
  1. S DDSFILE=458.1,DR="[PRSA LV REQ]" D ^DDS K DS
  1. I '$P(^PRST(458.1,DA,0),"^",3) S DIK="^PRST(458.1," D ^DIK K DIK Q
  1. I ZOLD=^PRST(458.1,DA,0) Q
  1. ;
  1. ; if timecards were locked (PTP), unpost the leave and remove the locks
  1. I $D(PPLCK) D
  1. . D ULR^PRSPLVA(ZOLD)
  1. . D TCULCK^PRSPAPU($P(ZOLD,U,2),.PPLCK)
  1. ;
  1. D NOW^%DTC S $P(^PRST(458.1,DA,0),"^",9,11)="R^"_DUZ_"^"_%,^PRST(458.1,"AR",DFN,DA)=""
  1. I $P(ZOLD,"^",12) S $P(^PRST(458.1,DA,0),"^",12,14)="^^" K ^(1)
  1. S Z1=$P($G(^PRST(458.1,DA,0)),"^",7) I "AL SL CB AD"[Z1 S PRT=0 D BAL^PRSALVS I BAL<0 D OK
  1. D CHK,UPD^PRSASAL Q
  1. OK ; Negative Balance Message
  1. W !!,"WARNING: Your Leave Balance MAY go below zero!"
  1. R !!,"Press RETURN to Continue.",X:DTIME Q
  1. VAL ; Validate request
  1. Q:'$D(Z1) I $P(Z1,"^",1)>$P(Z1,"^",3) S STR="Start date cannot be after the ending date." G V1
  1. S X1=$P(Z1,"^",3),X2=$P(Z1,"^",1) D ^%DTC I X>40 S STR="Period of leave cannot exceed 40 days." G V1
  1. Q:$P(Z1,"^",1)<$P(Z1,"^",3) S X=$P(Z1,"^",2)_"^"_$P(Z1,"^",4) D CNV^PRSATIM
  1. S Z2=$P(Y,"^",1),Z4=$P(Y,"^",2)
  1. I Z2'<Z4 S STR="Start time must be less than ending time." G V1
  1. ;The following line of code intentally commented out as unnecessary
  1. ;as well as causing an erroneous error message. Refer PRS*4*61
  1. ;I "AL SL"[$P(Z1,"^",7) S PRT=0 D BAL^PRSALVS I BAL<0 S STR="WARNING: Your leave balance MAY go below zero." D HLP^DDSUTL(.STR)
  1. Q
  1. V1 S DDSERROR=1 D HLP^DDSUTL(.STR) Q
  1. CHK ; Check if start date already posted
  1. S Z1=$P(^PRST(458.1,DA,0),"^",3)
  1. S Y=$G(^PRST(458,"AD",Z1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2) I PPI="" Q
  1. Q:'$D(^PRST(458,PPI,"E",DFN,"D",DAY,10)) S Y=$G(^(2)) Q:Y[$P(^PRST(458.1,DA,0),"^",7)
  1. S XMB="PRSA LV TK" F XMKK=0:0 S XMKK=$O(^PRST(455.5,TLI,"T",XMKK)) Q:XMKK<1 S XMY(XMKK)=""
  1. S XMB(1)=$P($G(^PRSPC(DFN,0)),"^",1)
  1. S X=$P($G(^PRST(458.1,DA,0)),"^",3) D DTP^PRSAPPU S XMB(3)=Y,XMB(2)=""
  1. S LVT=";"_$P(^DD(458.1,6,0),"^",3)
  1. S X=$P($G(^PRST(458.1,DA,0)),"^",7),%=$F(LVT,";"_X_":") I %>0 S XMB(2)=$P($E(LVT,%,999),";",1)
  1. D ^XMB K XMB,XMY,XMM,XMDT,XMKK Q
  1. EX G KILL^XUSCLEAN