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

PRSPEAU.m

Go to the documentation of this file. 
  1. PRSPEAU ;WOIFO/SAB - EXTENDED ABSENCE UTILITIES ;10/19/2004
  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.  ;
  1. CONFLICT(PRSIEN,NFDT,NTDT,XEAIEN) ; check for conflict with existing EAs
  1.  ; input
  1.  ;   PRSIEN - employee ien (file 450)
  1.  ;   NFDT   - new from date in fileman format
  1.  ;   NTDT   - (optional) new to date in fileman format
  1.  ;   XEAIEN - (optional) existing extended absense ien, passed if dates
  1.  ;            for an existing record are being checked so that entry does
  1.  ;            not conflict with itself.
  1.  ; returns string with value =
  1.  ;   list of Extended Absence iens (delimited by ^) that conflict OR
  1.  ;   null when no conflict found
  1.  ;
  1.  ; A conflict exists if the date range (New From-New To) overlaps the
  1.  ; date range of a different, active (does not include cancelled)
  1.  ; extended absence.  If the To Date is not passed, then the software
  1.  ; will just check the From Date to issue that it does not conflict with
  1.  ; another extended absence.
  1.  ;
  1.  N EAIEN,EAY0,PRSRET,PRSY,TDT
  1.  S PRSRET=""
  1.  S NTDT=$G(NTDT,NFDT) ; if To Date not passed then set equal to From Date
  1.  ;
  1.  ; loop thru extended absences for employee by reverse To Date until
  1.  ; the To Date is before the New From Date or no more To Dates
  1.  S TDT=9999999 ; initial To Date for loop
  1.  F  S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT),-1) Q:'TDT!(TDT<NFDT)  D
  1.  . ; loop thru extended absences with To Date
  1.  . S EAIEN=0
  1.  . S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN  D
  1.  . . Q:EAIEN=$G(XEAIEN)  ; skip if entry is the one being checked
  1.  . . S EAY0=$G(^PRST(458.4,EAIEN,0)) ; extended absense 0 node
  1.  . . Q:$P(EAY0,U)=""!($P(EAY0,U,2)="")  ; dates missing - invalid
  1.  . . Q:$P(EAY0,U)>NTDT  ; skip if From Date after New To Date
  1.  . . Q:$P(EAY0,U,6)'="A"  ; skip if Status not active
  1.  . . ;
  1.  . . ; extended absence overlaps the pay period
  1.  . . S PRSRET=PRSRET_EAIEN_U  ; conflict
  1.  ;
  1.  Q PRSRET
  1.  ;
  1. RCON(LIST,WRITE,PRSARRN) ; Report Conflicts
  1.  ; input
  1.  ;   LIST    - string of conflicting Ext Absence IENs delimited by ^
  1.  ;   WRITE   - (optional) true (=1) if text should be written (default)
  1.  ;                        false (=0) if array should be returned instead
  1.  ;   PRSARRN - (optional) array name, default value is "PRSARR"
  1.  ; output
  1.  ;   If WRITE is True, the input array name (or "PRSARR" if not
  1.  ;     specified) will be killed.
  1.  ;   If WRITE is False, the input array name will contain the text
  1.  ;
  1.  Q:$G(LIST)=""
  1.  ;
  1.  N EAIEN,LN,PC
  1.  ;
  1.  S PRSARRN=$G(PRSARRN,"PRSARR")
  1.  S WRITE=$G(WRITE,1)
  1.  ;
  1.  S @PRSARRN@(1)="The specified dates conflict with other extended absence(s)."
  1.  S @PRSARRN@(2)="Please specify different dates for this extended absence or"
  1.  S @PRSARRN@(3)="remove the conflict by first editing the other extended absence(s)."
  1.  S LN=3
  1.  F PC=1:1 S EAIEN=$P(LIST,U,PC) Q:EAIEN=""  D
  1.  . S LN=LN+1
  1.  . S @PRSARRN@(LN)="  Conflicts with Absence: "_$$GET1^DIQ(458.4,EAIEN_",",.01)_" to "_$$GET1^DIQ(458.4,EAIEN_",",1)
  1.  ;
  1.  ; if not WRITE then quit (return text in array to caller)
  1.  Q:'WRITE
  1.  ;
  1.  ; otherwise write text to current device and then kill array of text
  1.  S LN=0 F  S LN=$O(@PRSARRN@(LN)) Q:'LN  D
  1.  . W !,@PRSARRN@(LN)
  1.  K @PRSARRN
  1.  ;
  1.  Q
  1.  ;
  1. CHKRG(PRSIEN) ; Check for RG Posted to Today's ESR
  1.  ; Input
  1.  ;   PRSIEN - Employee IEN (file 450)
  1.  ; Returns
  1.  ;   boolean value, true (=1) if RG already posted on ESR for Today
  1.  ;
  1.  N D1,DAY,PP4Y,PPE,PPI,PRSRET
  1.  ;
  1.  S PRSRET=0 ; init return value
  1.  ;
  1.  I $G(PRSIEN) D
  1.  . S D1=DT
  1.  . D PP^PRSAPPU
  1.  . Q:'$G(PPI)
  1.  . Q:'$G(DAY)
  1.  . I $G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))["RG" S PRSRET=1
  1.  ;
  1.  Q PRSRET
  1.  ;
  1. DISEA(EAIEN,IC) ; Display EA
  1.  ; input
  1.  ;   EAIEN - Extended Absence IEN (file 458.4)
  1.  ;   IC    - (optional) item count, number to be included in display
  1.  ; result
  1.  ;   Writes information to current device (2-4 lines)
  1.  Q:'$G(EAIEN)  ; IEN required
  1.  S IC=$G(IC)
  1.  ;
  1.  N PRSE,PRSIENS,PRSV
  1.  S PRSIENS=EAIEN_","
  1.  ;
  1.  D GETS^DIQ(458.4,PRSIENS,".01;1;3;4;5;6","","PRSV","PRSE")
  1.  ;
  1.  ; display info if no error
  1.  I '$D(PRSE) D
  1.  . W !
  1.  . I IC W $$RJ^XLFSTR(IC_") ",4)
  1.  . W PRSV(458.4,PRSIENS,.01)_" to "_PRSV(458.4,PRSIENS,1)
  1.  . W ?33,"Status: ",PRSV(458.4,PRSIENS,5)
  1.  . I PRSV(458.4,PRSIENS,6)]"" W !,?4,PRSV(458.4,PRSIENS,6) ; remarks
  1.  . W !,?33,"Entered: ",PRSV(458.4,PRSIENS,3)
  1.  . I PRSV(458.4,PRSIENS,4)]"" W !,?33,"Updated: ",PRSV(458.4,PRSIENS,4)
  1.  ;
  1.  I $D(PRSE) D MSG^DIALOG(,,,,"PRSE") ; display error
  1.  ;
  1.  Q
  1.  ;
  1. BLDLST(PRSIEN,MINTDT,OKSTAT) ; Build List of Extended Absence Entries
  1.  ; input
  1.  ;   PRSIEN - Employee IEN (file 450)
  1.  ;   MINTDT - Minumum To Date (FileMan Internal)
  1.  ;   OKSTAT - String of acceptable EA status values to place in list
  1.  ;            delimited by ^ (e.g. "A" or "^A^" or "A^X"...)
  1.  ;   ARRN   - (optional) name of an array that will contain the list
  1.  ;            default value is "EALIST"
  1.  ; output
  1.  ;   local array EALIST with format
  1.  ;   EALIST(0)=count of items in list
  1.  ;   EALIST(1)=1st extended absence IEN in list
  1.  ;   EALIST(n)=nth extended absence IEN in list
  1.  ;
  1.  ; initialize the list
  1.  K EALIST
  1.  ;
  1.  Q:'$G(PRSIEN)
  1.  Q:$G(MINTDT)'?7N
  1.  Q:$G(OKSTAT)=""
  1.  ;
  1.  I $E(OKSTAT)'="^" S OKSTAT="^"_OKSTAT
  1.  I $E(OKSTAT,$L(OKSTAT))'="^" S OKSTAT=OKSTAT_"^"
  1.  ;
  1.  ;
  1.  N CNT,EAIEN,PRSX,TDT
  1.  ;
  1.  ; loop thru extended absences by to date - build sorted temp list
  1.  S TDT=MINTDT-.01
  1.  F  S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT)) Q:'TDT  D
  1.  . S EAIEN=0
  1.  . F  S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN  D
  1.  . . Q:OKSTAT'[(U_$P($G(^PRST(458.4,EAIEN,0)),U,6)_U)
  1.  . . S EALIST("T",TDT_"^"_EAIEN)=""
  1.  ;
  1.  ; build output list by number based on order in temp list 
  1.  S CNT=0,PRSX=""
  1.  F  S PRSX=$O(EALIST("T",PRSX)) Q:PRSX=""  D
  1.  . S CNT=CNT+1
  1.  . S EALIST(CNT)=$P(PRSX,U,2)
  1.  S EALIST(0)=CNT ; set header node with count
  1.  ;
  1.  K EALIST("T") ; delete temp list
  1.  ;
  1.  Q
  1.  ;
  1. DISLST() ; Display List of Extended Absences
  1.  ; input
  1.  ;   local array EALIST with format
  1.  ;   EALIST(0)=count of items in list
  1.  ;   EALIST(1)=1st extended absence IEN in list
  1.  ;   EALIST(n)=nth extended absence IEN in list
  1.  ; returns 1 if user entered an up-arrow or time-out
  1.  ;
  1.  N DIR,DIRUT,DIROUT,DTOUT,DUOUT,PRSI,PRSRET,X,Y
  1.  ;
  1.  S PRSRET=0
  1.  ;
  1.  I EALIST(0)=0 W !,"No extended absences were found."
  1.  ;
  1.  S PRSI=0 F  S PRSI=$O(EALIST(PRSI)) Q:'PRSI  D  Q:PRSRET
  1.  . I $Y+6>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y PRSRET=1 Q:'Y  W @IOF
  1.  . S EAIEN=EALIST(PRSI)
  1.  . D DISEA(EAIEN,PRSI)
  1.  ;
  1.  Q PRSRET
  1.  ;
  1.  ;PRSPEAU