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

PRSPLVA.m

Go to the documentation of this file.
  1. PRSPLVA ;WOIFO/SAB - AUTOPOST LEAVE FOR PART-TIME PHY. WITH MEMO ;4/6/2005
  1. ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. PLPP(PRSIEN,PPI,DAYN) ; Post Leave for a Pay Period (or day)
  1. ; Called by the open next PP option to post leave to one new pay period
  1. ; for one part-time physician.
  1. ; Called by the enter/edit tour option to re-post leave to one
  1. ; pay period when a tour is changed.
  1. ; Input
  1. ; PRSIEN - Employee IEN (file 450), should be PTP with active memo
  1. ; PPI - Pay Period IEN (file 458)
  1. ; DAYN - (optional) day # within pay period to only post that day
  1. ;
  1. N LVIEN,LVY0,PPD1,PPD15,PRSX,RPPD1,RTDT,Y
  1. S DAYN=$G(DAYN)
  1. ;
  1. ; Determine pay period dates
  1. S Y=$G(^PRST(458,PPI,1))
  1. S PRSX=$S(DAYN:DAYN,1:1) ; if passed use day # instead of 1st PP day
  1. S PPD1=$P(Y,U,PRSX) ; 1st day of PP
  1. S RPPD1=9999999-PPD1 ; reverse 1st day of PP
  1. S PRSX=$S(DAYN:DAYN,1:14) ; if passed use day # instead of last PP day
  1. S PPD15=$$FMADD^XLFDT($P(Y,U,PRSX),1) ; Last day of PP+1
  1. ; (use day 15 to include leave that starts on 2nd day of 2-day tour and
  1. ; would be posted on the prior day)
  1. K PRSX
  1. Q:PPD1=""
  1. ;
  1. ; loop thru leave requests for employee by reverse to date until
  1. ; to date is before the pay period or no more to dates
  1. S RTDT=""
  1. F S RTDT=$O(^PRST(458.1,"AD",PRSIEN,RTDT)) Q:'RTDT!(RTDT>RPPD1) D
  1. . ; loop thru requests
  1. . S LVIEN=0
  1. . S LVIEN=$O(^PRST(458.1,"AD",PRSIEN,RTDT,LVIEN)) Q:'LVIEN D
  1. . . S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
  1. . . Q:$P(LVY0,U,3)>PPD15 ; skip if from date after pay period+1
  1. . . Q:$P(LVY0,U,9)'="A" ; skip if status not approved
  1. . . ;
  1. . . ; approved request may overlap PP so post the leave request
  1. . . D PLR(LVIEN,PPI,DAYN)
  1. Q
  1. ;
  1. PLR(LVIEN,SPPI,DAYN,PRSEX) ; Post Leave Request
  1. ; Called during open next pay period process (by PLPP above) to post
  1. ; one leave request to a single pay period.
  1. ; Called during Supervisory Approvals process to post one leave request
  1. ; to all opened pay periods.
  1. ; Input
  1. ; LVIEN - Leave Request IEN (file 458.1)
  1. ; SPPI - Pay Period IEN (file 458) or Null Value if for all.
  1. ; DAYN - (optional) day # within SPPI or null value
  1. ; PRSEX - Passed by reference, will be initialized (killed)
  1. ; Output
  1. ; PRSEX - passed by reference, only defined if the leave was not
  1. ; posted to the ESR and should not be approved because the
  1. ; leave is not currently on the time card and it has a status
  1. ; of Payroll. This exception should only be applicable when
  1. ; auto post is called by the supervisory approval of leave.
  1. ;
  1. ;
  1. ; Note: All applicable time cards are assumed to be locked prior to
  1. ; calling this API.
  1. ;
  1. Q:'$G(LVIEN) ; required input
  1. S SPPI=$G(SPPI)
  1. ;
  1. N D1,DAY,EDN,EPP4Y,FATAL,LVDTE,LVDTS,LVY0,PP4Y,PPDN,PPDNB
  1. N PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,PRSIEN,PRSX,SDN,SPP4Y,TCST,TCUNPOST,Y
  1. ;
  1. K PRSEX
  1. ;
  1. S DAYN=$G(DAYN)
  1. S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
  1. S PRSIEN=$P(LVY0,U,2) ; employee IEN
  1. D
  1. . N CNX,PRSM,X,Y
  1. . S X=$P(LVY0,U,4)_U_$P(LVY0,U,6)
  1. . D CNV^PRSATIM
  1. . S PRSM=Y
  1. . S LVDTS=$$FMADD^XLFDT($P(LVY0,U,3),,,$P(PRSM,U,1)) ; leave d/t start
  1. . S LVDTE=$$FMADD^XLFDT($P(LVY0,U,5),,,$P(PRSM,U,2)) ; leave d/t end
  1. ;
  1. ; determine starting and ending pay periods
  1. ; if single pay period specified
  1. I $G(SPPI) D
  1. . S D1=$P(^PRST(458,SPPI,1),U) D PP^PRSAPPU S (SPP4Y,EPP4Y)=PP4Y
  1. ; if no pay period specified
  1. I '$G(SPPI) D
  1. . S D1=$$FMADD^XLFDT($P(LVY0,U,3),-1) D PP^PRSAPPU S SPP4Y=PP4Y ; based on leave from -1 (use -1 in case of 2-day tour)
  1. . S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
  1. ;
  1. ; loop thru pay periods
  1. S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
  1. F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
  1. . S PPI=$O(^PRST(458,"AB",PP4Y,0))
  1. . ;
  1. . ; check status of memo
  1. . S D1=$P($G(^PRST(458,PPI,1)),U)
  1. . S PRSX=$$MIEN^PRSPUT1(PRSIEN,D1)
  1. . Q:PRSX'>0 ; skip if pay period is not covered by memo
  1. . Q:$P(PRSX,U,2)=4 ; skip if memo is reconciled
  1. . K PRSX
  1. . ;
  1. . ; obtain time card status
  1. . S TCST=$P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)
  1. . ;
  1. . ; determine begin and end day numbers within pay period
  1. . S PPY1=$G(^PRST(458,PPI,1))
  1. . ; begin day is greater of leave from date-1 and 1st PP day
  1. . S PRSX=$S(DAYN:DAYN,1:1) ; if passed use day # instead of 1st PP day
  1. . S SDT=$S($P(PPY1,U,PRSX)>$$FMADD^XLFDT($P(LVY0,U,3),-1):$P(PPY1,U,PRSX),1:$$FMADD^XLFDT($P(LVY0,U,3),-1))
  1. . S SDN=$P($G(^PRST(458,"AD",SDT)),U,2) ; start day number
  1. . ; end day is lesser of leave request to date and last PP day
  1. . S PRSX=$S(DAYN:DAYN,1:14) ; if passed use day # instead of last PP day
  1. . S EDT=$S($P(LVY0,U,5)>$P(PPY1,U,PRSX):$P(PPY1,U,PRSX),1:$P(LVY0,U,5))
  1. . S EDN=$P($G(^PRST(458,"AD",EDT)),U,2) ; end day number
  1. . K PPY1,PRSX,SDT,EDT
  1. . ;
  1. . ; loop thru applicable days in PP
  1. . S PPDN=SDN-1 ; initial PP day number for loop
  1. . F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>EDN) D PDAY^PRSPLVA1
  1. ;
  1. ; handle fatal exception and quit without updating file 458
  1. I $G(FATAL) S PRSEX=$P(FATAL,U,2) Q
  1. ;
  1. ; clear appropriate time card days
  1. S PPI="" F S PPI=$O(TCUNPOST(PPI)) Q:'PPI D
  1. . S PPDN="" F S PPDN=$O(TCUNPOST(PPI,PPDN)) Q:'PPDN D
  1. . . N X
  1. . . S X=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PPDN)
  1. ;
  1. ; update the ESR
  1. I $D(PRSFDA) D FILE^DIE("","PRSFDA") D MSG^DIALOG()
  1. ;
  1. Q
  1. ;
  1. ULR(LVY0) ; Unpost Leave Request
  1. ; Called by the Edit Leave Request and Cancel Leave Request options
  1. ; to unpost one leave request from all opened pay periods.
  1. ; Input
  1. ; LVIEN - Leave Request 0 Node (before edit) (see file 458.1)
  1. ;
  1. ; Note: All applicable time cards are assumed to be locked prior to
  1. ; calling this API.
  1. ;
  1. Q:$G(LVY0)="" ; required input
  1. ;
  1. N D1,DAY,EDN,EPP4Y,LVDTE,LVDTS,PP4Y,PPDN,PPDNB
  1. N PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,PRSIEN,SDN,SPP4Y,Y
  1. ;
  1. S PRSIEN=$P(LVY0,U,2) ; employee IEN
  1. D
  1. . N CNX,PRSM,X,Y
  1. . S X=$P(LVY0,U,4)_U_$P(LVY0,U,6)
  1. . D CNV^PRSATIM
  1. . S PRSM=Y
  1. . S LVDTS=$$FMADD^XLFDT($P(LVY0,U,3),,,$P(PRSM,U,1)) ; leave d/t start
  1. . S LVDTE=$$FMADD^XLFDT($P(LVY0,U,5),,,$P(PRSM,U,2)) ; leave d/t end
  1. ;
  1. ; determine starting and ending pay periods
  1. S D1=$$FMADD^XLFDT($P(LVY0,U,3),-1) D PP^PRSAPPU S SPP4Y=PP4Y ; based on leave from -1 (use -1 in case of 2-day tour)
  1. S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
  1. ;
  1. ; loop thru pay periods
  1. S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
  1. F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
  1. . S PPI=$O(^PRST(458,"AB",PP4Y,0))
  1. . ;
  1. . ; check status of memo
  1. . S D1=$P($G(^PRST(458,PPI,1)),U)
  1. . S PRSX=$$MIEN^PRSPUT1(PRSIEN,D1)
  1. . Q:PRSX'>0 ; skip if pay period is not covered by memo
  1. . Q:$P(PRSX,U,2)=4 ; skip if memo is reconciled
  1. . K PRSX
  1. . ;
  1. . ; determine begin and end day numbers within pay period
  1. . S PPY1=$G(^PRST(458,PPI,1))
  1. . ; begin day is greater of leave from date-1 and 1st PP day
  1. . S SDT=$S($P(PPY1,U,1)>$$FMADD^XLFDT($P(LVY0,U,3),-1):$P(PPY1,U,1),1:$$FMADD^XLFDT($P(LVY0,U,3),-1))
  1. . S SDN=$P($G(^PRST(458,"AD",SDT)),U,2) ; start day number
  1. . ; end day is lesser of leave request to date and last PP day
  1. . S EDT=$S($P(LVY0,U,5)>$P(PPY1,U,14):$P(PPY1,U,14),1:$P(LVY0,U,5))
  1. . S EDN=$P($G(^PRST(458,"AD",EDT)),U,2) ; end day number
  1. . K PPY1,SDT,EDT
  1. . ;
  1. . ; loop thru applicable days in PP
  1. . S PPDN=SDN-1 ; initial PP day number for loop
  1. . F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>EDN) D PDAY^PRSPLVA2
  1. ;
  1. ; update the ESR
  1. I $D(PRSFDA) D FILE^DIE("S","PRSFDA") D MSG^DIALOG()
  1. ;
  1. ; Call API BURP^PRSPESR2 to 'burp' the ESR for any unposted days.
  1. ; loop thru iens in PRSFDA(), get node 5, use burp, if result different
  1. ; then save result back in node 5
  1. I $D(PRSFDA) D
  1. . N PPDIENS,PPDN,PPI,PRSIEN,PRSX,PRSY
  1. . ; loop thru iens (days)
  1. . S PPDIENS="" F S PPDIENS=$O(PRSFDA(458.02,PPDIENS)) Q:PPDIENS="" D
  1. . . S PPDN=$P(PPDIENS,",",1)
  1. . . S PRSIEN=$P(PPDIENS,",",2)
  1. . . S PPI=$P(PPDIENS,",",3)
  1. . . S PRSX=$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))
  1. . . S PRSY=$$BURP^PRSPESR2(PRSX)
  1. . . I PRSX'=PRSY S ^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5)=PRSY
  1. ;
  1. Q
  1. ;
  1. ;PRSPLVA