PRSPEAU ;WOIFO/SAB - EXTENDED ABSENCE UTILITIES ;10/19/2004
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
CONFLICT(PRSIEN,NFDT,NTDT,XEAIEN) ; check for conflict with existing EAs
; input
; PRSIEN - employee ien (file 450)
; NFDT - new from date in fileman format
; NTDT - (optional) new to date in fileman format
; XEAIEN - (optional) existing extended absense ien, passed if dates
; for an existing record are being checked so that entry does
; not conflict with itself.
; returns string with value =
; list of Extended Absence iens (delimited by ^) that conflict OR
; null when no conflict found
;
; A conflict exists if the date range (New From-New To) overlaps the
; date range of a different, active (does not include cancelled)
; extended absence. If the To Date is not passed, then the software
; will just check the From Date to issue that it does not conflict with
; another extended absence.
;
N EAIEN,EAY0,PRSRET,PRSY,TDT
S PRSRET=""
S NTDT=$G(NTDT,NFDT) ; if To Date not passed then set equal to From Date
;
; loop thru extended absences for employee by reverse To Date until
; the To Date is before the New From Date or no more To Dates
S TDT=9999999 ; initial To Date for loop
F S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT),-1) Q:'TDT!(TDT<NFDT) D
. ; loop thru extended absences with To Date
. S EAIEN=0
. S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN D
. . Q:EAIEN=$G(XEAIEN) ; skip if entry is the one being checked
. . S EAY0=$G(^PRST(458.4,EAIEN,0)) ; extended absense 0 node
. . Q:$P(EAY0,U)=""!($P(EAY0,U,2)="") ; dates missing - invalid
. . Q:$P(EAY0,U)>NTDT ; skip if From Date after New To Date
. . Q:$P(EAY0,U,6)'="A" ; skip if Status not active
. . ;
. . ; extended absence overlaps the pay period
. . S PRSRET=PRSRET_EAIEN_U ; conflict
;
Q PRSRET
;
RCON(LIST,WRITE,PRSARRN) ; Report Conflicts
; input
; LIST - string of conflicting Ext Absence IENs delimited by ^
; WRITE - (optional) true (=1) if text should be written (default)
; false (=0) if array should be returned instead
; PRSARRN - (optional) array name, default value is "PRSARR"
; output
; If WRITE is True, the input array name (or "PRSARR" if not
; specified) will be killed.
; If WRITE is False, the input array name will contain the text
;
Q:$G(LIST)=""
;
N EAIEN,LN,PC
;
S PRSARRN=$G(PRSARRN,"PRSARR")
S WRITE=$G(WRITE,1)
;
S @PRSARRN@(1)="The specified dates conflict with other extended absence(s)."
S @PRSARRN@(2)="Please specify different dates for this extended absence or"
S @PRSARRN@(3)="remove the conflict by first editing the other extended absence(s)."
S LN=3
F PC=1:1 S EAIEN=$P(LIST,U,PC) Q:EAIEN="" D
. S LN=LN+1
. S @PRSARRN@(LN)=" Conflicts with Absence: "_$$GET1^DIQ(458.4,EAIEN_",",.01)_" to "_$$GET1^DIQ(458.4,EAIEN_",",1)
;
; if not WRITE then quit (return text in array to caller)
Q:'WRITE
;
; otherwise write text to current device and then kill array of text
S LN=0 F S LN=$O(@PRSARRN@(LN)) Q:'LN D
. W !,@PRSARRN@(LN)
K @PRSARRN
;
Q
;
CHKRG(PRSIEN) ; Check for RG Posted to Today's ESR
; Input
; PRSIEN - Employee IEN (file 450)
; Returns
; boolean value, true (=1) if RG already posted on ESR for Today
;
N D1,DAY,PP4Y,PPE,PPI,PRSRET
;
S PRSRET=0 ; init return value
;
I $G(PRSIEN) D
. S D1=DT
. D PP^PRSAPPU
. Q:'$G(PPI)
. Q:'$G(DAY)
. I $G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))["RG" S PRSRET=1
;
Q PRSRET
;
DISEA(EAIEN,IC) ; Display EA
; input
; EAIEN - Extended Absence IEN (file 458.4)
; IC - (optional) item count, number to be included in display
; result
; Writes information to current device (2-4 lines)
Q:'$G(EAIEN) ; IEN required
S IC=$G(IC)
;
N PRSE,PRSIENS,PRSV
S PRSIENS=EAIEN_","
;
D GETS^DIQ(458.4,PRSIENS,".01;1;3;4;5;6","","PRSV","PRSE")
;
; display info if no error
I '$D(PRSE) D
. W !
. I IC W $$RJ^XLFSTR(IC_") ",4)
. W PRSV(458.4,PRSIENS,.01)_" to "_PRSV(458.4,PRSIENS,1)
. W ?33,"Status: ",PRSV(458.4,PRSIENS,5)
. I PRSV(458.4,PRSIENS,6)]"" W !,?4,PRSV(458.4,PRSIENS,6) ; remarks
. W !,?33,"Entered: ",PRSV(458.4,PRSIENS,3)
. I PRSV(458.4,PRSIENS,4)]"" W !,?33,"Updated: ",PRSV(458.4,PRSIENS,4)
;
I $D(PRSE) D MSG^DIALOG(,,,,"PRSE") ; display error
;
Q
;
BLDLST(PRSIEN,MINTDT,OKSTAT) ; Build List of Extended Absence Entries
; input
; PRSIEN - Employee IEN (file 450)
; MINTDT - Minumum To Date (FileMan Internal)
; OKSTAT - String of acceptable EA status values to place in list
; delimited by ^ (e.g. "A" or "^A^" or "A^X"...)
; ARRN - (optional) name of an array that will contain the list
; default value is "EALIST"
; output
; local array EALIST with format
; EALIST(0)=count of items in list
; EALIST(1)=1st extended absence IEN in list
; EALIST(n)=nth extended absence IEN in list
;
; initialize the list
K EALIST
;
Q:'$G(PRSIEN)
Q:$G(MINTDT)'?7N
Q:$G(OKSTAT)=""
;
I $E(OKSTAT)'="^" S OKSTAT="^"_OKSTAT
I $E(OKSTAT,$L(OKSTAT))'="^" S OKSTAT=OKSTAT_"^"
;
;
N CNT,EAIEN,PRSX,TDT
;
; loop thru extended absences by to date - build sorted temp list
S TDT=MINTDT-.01
F S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT)) Q:'TDT D
. S EAIEN=0
. F S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN D
. . Q:OKSTAT'[(U_$P($G(^PRST(458.4,EAIEN,0)),U,6)_U)
. . S EALIST("T",TDT_"^"_EAIEN)=""
;
; build output list by number based on order in temp list
S CNT=0,PRSX=""
F S PRSX=$O(EALIST("T",PRSX)) Q:PRSX="" D
. S CNT=CNT+1
. S EALIST(CNT)=$P(PRSX,U,2)
S EALIST(0)=CNT ; set header node with count
;
K EALIST("T") ; delete temp list
;
Q
;
DISLST() ; Display List of Extended Absences
; input
; local array EALIST with format
; EALIST(0)=count of items in list
; EALIST(1)=1st extended absence IEN in list
; EALIST(n)=nth extended absence IEN in list
; returns 1 if user entered an up-arrow or time-out
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,PRSI,PRSRET,X,Y
;
S PRSRET=0
;
I EALIST(0)=0 W !,"No extended absences were found."
;
S PRSI=0 F S PRSI=$O(EALIST(PRSI)) Q:'PRSI D Q:PRSRET
. I $Y+6>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y PRSRET=1 Q:'Y W @IOF
. S EAIEN=EALIST(PRSI)
. D DISEA(EAIEN,PRSI)
;
Q PRSRET
;
;PRSPEAU
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPEAU 6564 printed Dec 13, 2024@02:27:59 Page 2
PRSPEAU ;WOIFO/SAB - EXTENDED ABSENCE UTILITIES ;10/19/2004
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
CONFLICT(PRSIEN,NFDT,NTDT,XEAIEN) ; check for conflict with existing EAs
+1 ; input
+2 ; PRSIEN - employee ien (file 450)
+3 ; NFDT - new from date in fileman format
+4 ; NTDT - (optional) new to date in fileman format
+5 ; XEAIEN - (optional) existing extended absense ien, passed if dates
+6 ; for an existing record are being checked so that entry does
+7 ; not conflict with itself.
+8 ; returns string with value =
+9 ; list of Extended Absence iens (delimited by ^) that conflict OR
+10 ; null when no conflict found
+11 ;
+12 ; A conflict exists if the date range (New From-New To) overlaps the
+13 ; date range of a different, active (does not include cancelled)
+14 ; extended absence. If the To Date is not passed, then the software
+15 ; will just check the From Date to issue that it does not conflict with
+16 ; another extended absence.
+17 ;
+18 NEW EAIEN,EAY0,PRSRET,PRSY,TDT
+19 SET PRSRET=""
+20 ; if To Date not passed then set equal to From Date
SET NTDT=$GET(NTDT,NFDT)
+21 ;
+22 ; loop thru extended absences for employee by reverse To Date until
+23 ; the To Date is before the New From Date or no more To Dates
+24 ; initial To Date for loop
SET TDT=9999999
+25 FOR
SET TDT=$ORDER(^PRST(458.4,"AEE",PRSIEN,TDT),-1)
if 'TDT!(TDT<NFDT)
QUIT
Begin DoDot:1
+26 ; loop thru extended absences with To Date
+27 SET EAIEN=0
+28 SET EAIEN=$ORDER(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN))
if 'EAIEN
QUIT
Begin DoDot:2
+29 ; skip if entry is the one being checked
if EAIEN=$GET(XEAIEN)
QUIT
+30 ; extended absense 0 node
SET EAY0=$GET(^PRST(458.4,EAIEN,0))
+31 ; dates missing - invalid
if $PIECE(EAY0,U)=""!($PIECE(EAY0,U,2)="")
QUIT
+32 ; skip if From Date after New To Date
if $PIECE(EAY0,U)>NTDT
QUIT
+33 ; skip if Status not active
if $PIECE(EAY0,U,6)'="A"
QUIT
+34 ;
+35 ; extended absence overlaps the pay period
+36 ; conflict
SET PRSRET=PRSRET_EAIEN_U
End DoDot:2
End DoDot:1
+37 ;
+38 QUIT PRSRET
+39 ;
RCON(LIST,WRITE,PRSARRN) ; Report Conflicts
+1 ; input
+2 ; LIST - string of conflicting Ext Absence IENs delimited by ^
+3 ; WRITE - (optional) true (=1) if text should be written (default)
+4 ; false (=0) if array should be returned instead
+5 ; PRSARRN - (optional) array name, default value is "PRSARR"
+6 ; output
+7 ; If WRITE is True, the input array name (or "PRSARR" if not
+8 ; specified) will be killed.
+9 ; If WRITE is False, the input array name will contain the text
+10 ;
+11 if $GET(LIST)=""
QUIT
+12 ;
+13 NEW EAIEN,LN,PC
+14 ;
+15 SET PRSARRN=$GET(PRSARRN,"PRSARR")
+16 SET WRITE=$GET(WRITE,1)
+17 ;
+18 SET @PRSARRN@(1)="The specified dates conflict with other extended absence(s)."
+19 SET @PRSARRN@(2)="Please specify different dates for this extended absence or"
+20 SET @PRSARRN@(3)="remove the conflict by first editing the other extended absence(s)."
+21 SET LN=3
+22 FOR PC=1:1
SET EAIEN=$PIECE(LIST,U,PC)
if EAIEN=""
QUIT
Begin DoDot:1
+23 SET LN=LN+1
+24 SET @PRSARRN@(LN)=" Conflicts with Absence: "_$$GET1^DIQ(458.4,EAIEN_",",.01)_" to "_$$GET1^DIQ(458.4,EAIEN_",",1)
End DoDot:1
+25 ;
+26 ; if not WRITE then quit (return text in array to caller)
+27 if 'WRITE
QUIT
+28 ;
+29 ; otherwise write text to current device and then kill array of text
+30 SET LN=0
FOR
SET LN=$ORDER(@PRSARRN@(LN))
if 'LN
QUIT
Begin DoDot:1
+31 WRITE !,@PRSARRN@(LN)
End DoDot:1
+32 KILL @PRSARRN
+33 ;
+34 QUIT
+35 ;
CHKRG(PRSIEN) ; Check for RG Posted to Today's ESR
+1 ; Input
+2 ; PRSIEN - Employee IEN (file 450)
+3 ; Returns
+4 ; boolean value, true (=1) if RG already posted on ESR for Today
+5 ;
+6 NEW D1,DAY,PP4Y,PPE,PPI,PRSRET
+7 ;
+8 ; init return value
SET PRSRET=0
+9 ;
+10 IF $GET(PRSIEN)
Begin DoDot:1
+11 SET D1=DT
+12 DO PP^PRSAPPU
+13 if '$GET(PPI)
QUIT
+14 if '$GET(DAY)
QUIT
+15 IF $GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))["RG"
SET PRSRET=1
End DoDot:1
+16 ;
+17 QUIT PRSRET
+18 ;
DISEA(EAIEN,IC) ; Display EA
+1 ; input
+2 ; EAIEN - Extended Absence IEN (file 458.4)
+3 ; IC - (optional) item count, number to be included in display
+4 ; result
+5 ; Writes information to current device (2-4 lines)
+6 ; IEN required
if '$GET(EAIEN)
QUIT
+7 SET IC=$GET(IC)
+8 ;
+9 NEW PRSE,PRSIENS,PRSV
+10 SET PRSIENS=EAIEN_","
+11 ;
+12 DO GETS^DIQ(458.4,PRSIENS,".01;1;3;4;5;6","","PRSV","PRSE")
+13 ;
+14 ; display info if no error
+15 IF '$DATA(PRSE)
Begin DoDot:1
+16 WRITE !
+17 IF IC
WRITE $$RJ^XLFSTR(IC_") ",4)
+18 WRITE PRSV(458.4,PRSIENS,.01)_" to "_PRSV(458.4,PRSIENS,1)
+19 WRITE ?33,"Status: ",PRSV(458.4,PRSIENS,5)
+20 ; remarks
IF PRSV(458.4,PRSIENS,6)]""
WRITE !,?4,PRSV(458.4,PRSIENS,6)
+21 WRITE !,?33,"Entered: ",PRSV(458.4,PRSIENS,3)
+22 IF PRSV(458.4,PRSIENS,4)]""
WRITE !,?33,"Updated: ",PRSV(458.4,PRSIENS,4)
End DoDot:1
+23 ;
+24 ; display error
IF $DATA(PRSE)
DO MSG^DIALOG(,,,,"PRSE")
+25 ;
+26 QUIT
+27 ;
BLDLST(PRSIEN,MINTDT,OKSTAT) ; Build List of Extended Absence Entries
+1 ; input
+2 ; PRSIEN - Employee IEN (file 450)
+3 ; MINTDT - Minumum To Date (FileMan Internal)
+4 ; OKSTAT - String of acceptable EA status values to place in list
+5 ; delimited by ^ (e.g. "A" or "^A^" or "A^X"...)
+6 ; ARRN - (optional) name of an array that will contain the list
+7 ; default value is "EALIST"
+8 ; output
+9 ; local array EALIST with format
+10 ; EALIST(0)=count of items in list
+11 ; EALIST(1)=1st extended absence IEN in list
+12 ; EALIST(n)=nth extended absence IEN in list
+13 ;
+14 ; initialize the list
+15 KILL EALIST
+16 ;
+17 if '$GET(PRSIEN)
QUIT
+18 if $GET(MINTDT)'?7N
QUIT
+19 if $GET(OKSTAT)=""
QUIT
+20 ;
+21 IF $EXTRACT(OKSTAT)'="^"
SET OKSTAT="^"_OKSTAT
+22 IF $EXTRACT(OKSTAT,$LENGTH(OKSTAT))'="^"
SET OKSTAT=OKSTAT_"^"
+23 ;
+24 ;
+25 NEW CNT,EAIEN,PRSX,TDT
+26 ;
+27 ; loop thru extended absences by to date - build sorted temp list
+28 SET TDT=MINTDT-.01
+29 FOR
SET TDT=$ORDER(^PRST(458.4,"AEE",PRSIEN,TDT))
if 'TDT
QUIT
Begin DoDot:1
+30 SET EAIEN=0
+31 FOR
SET EAIEN=$ORDER(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN))
if 'EAIEN
QUIT
Begin DoDot:2
+32 if OKSTAT'[(U_$PIECE($GET(^PRST(458.4,EAIEN,0)),U,6)_U)
QUIT
+33 SET EALIST("T",TDT_"^"_EAIEN)=""
End DoDot:2
End DoDot:1
+34 ;
+35 ; build output list by number based on order in temp list
+36 SET CNT=0
SET PRSX=""
+37 FOR
SET PRSX=$ORDER(EALIST("T",PRSX))
if PRSX=""
QUIT
Begin DoDot:1
+38 SET CNT=CNT+1
+39 SET EALIST(CNT)=$PIECE(PRSX,U,2)
End DoDot:1
+40 ; set header node with count
SET EALIST(0)=CNT
+41 ;
+42 ; delete temp list
KILL EALIST("T")
+43 ;
+44 QUIT
+45 ;
DISLST() ; Display List of Extended Absences
+1 ; input
+2 ; local array EALIST with format
+3 ; EALIST(0)=count of items in list
+4 ; EALIST(1)=1st extended absence IEN in list
+5 ; EALIST(n)=nth extended absence IEN in list
+6 ; returns 1 if user entered an up-arrow or time-out
+7 ;
+8 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,PRSI,PRSRET,X,Y
+9 ;
+10 SET PRSRET=0
+11 ;
+12 IF EALIST(0)=0
WRITE !,"No extended absences were found."
+13 ;
+14 SET PRSI=0
FOR
SET PRSI=$ORDER(EALIST(PRSI))
if 'PRSI
QUIT
Begin DoDot:1
+15 IF $Y+6>IOSL
SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET PRSRET=1
if 'Y
QUIT
WRITE @IOF
+16 SET EAIEN=EALIST(PRSI)
+17 DO DISEA(EAIEN,PRSI)
End DoDot:1
if PRSRET
QUIT
+18 ;
+19 QUIT PRSRET
+20 ;
+21 ;PRSPEAU
