PRSLIB00 ;WOIFO/JAH - PAID LIBRARY - ROUTINES & FUNCTIONS ;01/22/2005
;;4.0;PAID;**25,35,49,57,93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;=====================================================================
AVAILREC(WHO,GLOBREF,OUT) ;IS RECORD AVAILABLE
;parameters
; WHO indicates type of option attempting the lock (TK or SUP)
; GLOBREF passed by reference - used to return a global name
; OUT passed by reference - used to return results of call to
; $$ASK. Equals 1 if user entered '^' at the prompt.
; Is only defined when employee record could not be locked.
;make sure there is a pay period record for employee & that
;record is not being edited by timekeeper or supervisor.
;
;If record is available, then lock it and store pointer to
;locked record in ^TMP($J,"LOCK" so we can unlock all
;records in ^TMP "queue" upon exit of certification option.
;
N MESSAGE,M1,M2,M3,EMPNAME
;
;create message depending on which option is being used to attempt
;to edit record: Supervisory Certification or TimeKeeper posting.
;
S M1="-Employee's pay period record locked. "
S M2=$S(WHO="SUP":"Timekeeper",WHO="TK":"Supervisor",1:"Another user")
S M3=" may be editing or reviewing."
S MESSAGE=M1_M2_M3
;
;
S GLOBREF="^PRST(458,"_PPI_","_"""E"""_","_DFN_",0)"
K OUT
S AVAIL=0
I $D(^PRST(458,PPI,"E",DFN,0)) D
. S EMPNAME=$P($G(^PRSPC(DFN,0)),"^")_" "
. I '$$LOCK(GLOBREF) W !!,EMPNAME,!,MESSAGE S OUT=$$ASK^PRSLIB00()
. E D
.. S ^TMP($J,"LOCK",DFN)=""
.. S AVAIL=1
Q AVAIL
;====================================================================
;
;===================================================================
LOCK(GLOBREF) ;INCREMENTALLY LOCK A RECORD
;
;RETURN FALSE IF RECORD ALREADY HAS A LOCK
L +@GLOBREF:2 S SUCCESS=$T
Q SUCCESS
;
;===================================================================
;
;====================================================================
;
UNLOCK(GLOBREF) ;INCREMENTALLY UNLOCK A RECORD
L -@GLOBREF
Q
;
;===================================================================
;
;===================================================================
ASK(HOLD) ;ask user 2 continue function
;return true (1) if user want's 2 stop, false (0) 2 continue.
;If HOLD defined, use prompt 2 hold display until user hits return.
;If not terminal then, do nothing, return FALSE.
;
S STOP=0
I $E(IOST,1,2)="C-" D
.;
.N RESP,DIR S RESP=0
.I $G(HOLD) S DIR(0)="EA",DIR("A")="Enter return to continue. "
.E S DIR(0)="E"
.D ^DIR I Y="" S STOP=0
.I $D(DIRUT) S STOP=1
Q STOP
;=====================================================================
BLDYR(NEXT) ;Build year with last digit of year.
;pivot back 2 years and forward 7.
;NEXT is a single digit (0-9). Single digit is assummed 2 b last
;digit in a year. This function takes that digit & finds
;1st yr. including current year that has passed digit in it's
;last position. 4 digit year returned.
;
N CNT,CURR,I,ADDYRS,YR,X1,X2,Y,X,RTN
S CNT=0
S YR=$E(DT,1,3)-2
S CURR=$E(YR,3)
F I=1:1:10 Q:CURR=NEXT D
. S CURR=CURR+1
. S CURR=$E(CURR,$L(CURR))
. S CNT=CNT+1
S ADDYRS=CNT*365
S YR=YR_"0601" S X1=YR,X2=ADDYRS D C^%DTC
S Y=X D DD^%DT S RTN=$P(Y," ",3)
Q RTN
;==================================================================
LEAPYR(Y) ;boolean function determines if year is leap year.
;INPUT: Y = year in standard 4 digit format.
;OUTPUT: LEAPFLAG = return 1 for leap year, otherwise 0.
;
N LEAPFLAG
S LEAPFLAG='(Y#4)
I '(Y#100) S LEAPFLAG='(Y#400)
Q LEAPFLAG
;==================================================================
MONOGRPH(MSG) ;DISPLAY A MESSAGE (MSG)
;
N HAIR,FORHEAD,NOSE,LINE,TOE,TAB1,TAB2,LEN
S LEN=$L(MSG)
S TAB1=(47-LEN\2)
S TAB2=48
S HAIR=" /////"
S TOE="|_______________________________________________|"
S NOSE="| (_) |"
S LINE="| |"
S FORHEAD=" __________________oOO_(O-O)__OOo_______________"
W !!,HAIR,!,FORHEAD,!,NOSE,!,LINE
W !,"| ",?TAB1,MSG,?TAB2,"|",!,LINE,!,TOE,!
Q
;===================================================================
;=====================================================================
HUMDRUM(ZZ,INC) ;A SORT OF CLOCK THAT SPINS WHILE LONG PROCESSING IS OCCURRING
S ZZ=ZZ+INC I ZZ#1=0 S ZZT=ZZ#9 W $C(13),$S(ZZT=1:"|",ZZT=2:"/",ZZT=3:"-",ZZT=4:"\",ZZT=5:"|",ZZT=6:"/",ZZT=7:"-",ZZT=8:"\",1:"") I ZZ=8 S ZZ=0
Q ZZ
;=====================================================================
;
Q
MSSG(MSG) ;Randomly pick a heart warming message
; MSGS = The # of messages in this routine. If u add a message, update
N MSGS,CNT
S MSGS=8
S CNT=$R(MSGS)+1,MSG=$P($TEXT(MSG+CNT),";",2)
MSG ;
;All Work & No Training, Makes Me a Dull Dude!
;Well Trained Employees, Put Veterans First!
;You Bet, Train a Vet!
;By failing to prepare we prepare to fail.
;Ideas won't work unless you do.
;The future is purchased by the present.
;A smooth sea never made a skillful sailor.
;Don't learn safety rules simply by accident.
;
Q
;
CVTDATE(X,PRSDATE) ;
; Called by the input transform of File 458.1 (LEAVE REQUEST) field
; # 2 From Date and field # 4 To Date.
;
; INPUT: X - is set to the external representation of the date
; selected by the user.
;
; PRSDATE - The variable Z1 is created by Form PRSA LV REQ and
; is passed by the input transform to CVTDATE. This variable
; may not be defined if this field is edited by another
; method. If defined PRSDATE will be the internal FileMan
; representation of the date entered by the user for the
; From Date field. During the To Date field validation,
; PRSDATE will represent the earliest date allowed.
;
; OUTPUT: X - is returned by the function. X will contain either the
; internal FileMan format for the valid date selected by
; the user or the value -1 if an invalid date was selected.
;
N FUTYR,PASYR,%DT,BEGINDT,X1,X2,Y
;
; Set %DT to not allow TODATE earlier than FROMDATE. Z1 contains
; the date stored in FROMDATE in the FileMan internal date format.
;
I +$P($G(PRSDATE),"^")?7N S %DT(0)=$P(PRSDATE,"^")
;
; Convert user input based on assumed past date lookup.
; Y will contain the user selected date in internal FileMan format.
;
S %DT="XP" D ^%DT
S PASYR=Y
;
; Convert user input based on assumed future date lookup
; Y will contain the user selected date in internal FileMan format.
;
S %DT="XF" D ^%DT
S FUTYR=Y
;
; If these two lookups match the user specified a four digit
; year and no extra processing is necessary.
;
I PASYR=FUTYR S X=PASYR
;
; If these two lookups don't match then the user did not
; enter a four digit year. That's o.k. but we need to assume that
; they meant either 60 days ago or in the future.
;
; Subtract 60 days from today and test to see if the date the user
; entered falls within this range.
;
I PASYR'=FUTYR D
.S X1=DT,X2=-60
.D C^%DTC
.S BEGINDT=X
.; Default the date to the past year lookup and begin testing
.S X=PASYR
.; Perform two checks:
.; #1 Does the user entered date fall within that last 60 days?
.; If it doesn't execute check #2.
.; #2 Does the date falls within the standard +20 year
.; time window? If so then default to a future year.
.I BEGINDT>PASYR,($E(DT,1,3)+20'<$E(FUTYR,1,3)) S X=FUTYR
;
Q X ; Return the user selected date in the FileMan internal date format.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSLIB00 7841 printed Dec 13, 2024@02:26:59 Page 2
PRSLIB00 ;WOIFO/JAH - PAID LIBRARY - ROUTINES & FUNCTIONS ;01/22/2005
+1 ;;4.0;PAID;**25,35,49,57,93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;=====================================================================
AVAILREC(WHO,GLOBREF,OUT) ;IS RECORD AVAILABLE
+1 ;parameters
+2 ; WHO indicates type of option attempting the lock (TK or SUP)
+3 ; GLOBREF passed by reference - used to return a global name
+4 ; OUT passed by reference - used to return results of call to
+5 ; $$ASK. Equals 1 if user entered '^' at the prompt.
+6 ; Is only defined when employee record could not be locked.
+7 ;make sure there is a pay period record for employee & that
+8 ;record is not being edited by timekeeper or supervisor.
+9 ;
+10 ;If record is available, then lock it and store pointer to
+11 ;locked record in ^TMP($J,"LOCK" so we can unlock all
+12 ;records in ^TMP "queue" upon exit of certification option.
+13 ;
+14 NEW MESSAGE,M1,M2,M3,EMPNAME
+15 ;
+16 ;create message depending on which option is being used to attempt
+17 ;to edit record: Supervisory Certification or TimeKeeper posting.
+18 ;
+19 SET M1="-Employee's pay period record locked. "
+20 SET M2=$SELECT(WHO="SUP":"Timekeeper",WHO="TK":"Supervisor",1:"Another user")
+21 SET M3=" may be editing or reviewing."
+22 SET MESSAGE=M1_M2_M3
+23 ;
+24 ;
+25 SET GLOBREF="^PRST(458,"_PPI_","_"""E"""_","_DFN_",0)"
+26 KILL OUT
+27 SET AVAIL=0
+28 IF $DATA(^PRST(458,PPI,"E",DFN,0))
Begin DoDot:1
+29 SET EMPNAME=$PIECE($GET(^PRSPC(DFN,0)),"^")_" "
+30 IF '$$LOCK(GLOBREF)
WRITE !!,EMPNAME,!,MESSAGE
SET OUT=$$ASK^PRSLIB00()
+31 IF '$TEST
Begin DoDot:2
+32 SET ^TMP($JOB,"LOCK",DFN)=""
+33 SET AVAIL=1
End DoDot:2
End DoDot:1
+34 QUIT AVAIL
+35 ;====================================================================
+36 ;
+37 ;===================================================================
LOCK(GLOBREF) ;INCREMENTALLY LOCK A RECORD
+1 ;
+2 ;RETURN FALSE IF RECORD ALREADY HAS A LOCK
+3 LOCK +@GLOBREF:2
SET SUCCESS=$TEST
+4 QUIT SUCCESS
+5 ;
+6 ;===================================================================
+7 ;
+8 ;====================================================================
+9 ;
UNLOCK(GLOBREF) ;INCREMENTALLY UNLOCK A RECORD
+1 LOCK -@GLOBREF
+2 QUIT
+3 ;
+4 ;===================================================================
+5 ;
+6 ;===================================================================
ASK(HOLD) ;ask user 2 continue function
+1 ;return true (1) if user want's 2 stop, false (0) 2 continue.
+2 ;If HOLD defined, use prompt 2 hold display until user hits return.
+3 ;If not terminal then, do nothing, return FALSE.
+4 ;
+5 SET STOP=0
+6 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+7 ;
+8 NEW RESP,DIR
SET RESP=0
+9 IF $GET(HOLD)
SET DIR(0)="EA"
SET DIR("A")="Enter return to continue. "
+10 IF '$TEST
SET DIR(0)="E"
+11 DO ^DIR
IF Y=""
SET STOP=0
+12 IF $DATA(DIRUT)
SET STOP=1
End DoDot:1
+13 QUIT STOP
+14 ;=====================================================================
BLDYR(NEXT) ;Build year with last digit of year.
+1 ;pivot back 2 years and forward 7.
+2 ;NEXT is a single digit (0-9). Single digit is assummed 2 b last
+3 ;digit in a year. This function takes that digit & finds
+4 ;1st yr. including current year that has passed digit in it's
+5 ;last position. 4 digit year returned.
+6 ;
+7 NEW CNT,CURR,I,ADDYRS,YR,X1,X2,Y,X,RTN
+8 SET CNT=0
+9 SET YR=$EXTRACT(DT,1,3)-2
+10 SET CURR=$EXTRACT(YR,3)
+11 FOR I=1:1:10
if CURR=NEXT
QUIT
Begin DoDot:1
+12 SET CURR=CURR+1
+13 SET CURR=$EXTRACT(CURR,$LENGTH(CURR))
+14 SET CNT=CNT+1
End DoDot:1
+15 SET ADDYRS=CNT*365
+16 SET YR=YR_"0601"
SET X1=YR
SET X2=ADDYRS
DO C^%DTC
+17 SET Y=X
DO DD^%DT
SET RTN=$PIECE(Y," ",3)
+18 QUIT RTN
+19 ;==================================================================
LEAPYR(Y) ;boolean function determines if year is leap year.
+1 ;INPUT: Y = year in standard 4 digit format.
+2 ;OUTPUT: LEAPFLAG = return 1 for leap year, otherwise 0.
+3 ;
+4 NEW LEAPFLAG
+5 SET LEAPFLAG='(Y#4)
+6 IF '(Y#100)
SET LEAPFLAG='(Y#400)
+7 QUIT LEAPFLAG
+8 ;==================================================================
MONOGRPH(MSG) ;DISPLAY A MESSAGE (MSG)
+1 ;
+2 NEW HAIR,FORHEAD,NOSE,LINE,TOE,TAB1,TAB2,LEN
+3 SET LEN=$LENGTH(MSG)
+4 SET TAB1=(47-LEN\2)
+5 SET TAB2=48
+6 SET HAIR=" /////"
+7 SET TOE="|_______________________________________________|"
+8 SET NOSE="| (_) |"
+9 SET LINE="| |"
+10 SET FORHEAD=" __________________oOO_(O-O)__OOo_______________"
+11 WRITE !!,HAIR,!,FORHEAD,!,NOSE,!,LINE
+12 WRITE !,"| ",?TAB1,MSG,?TAB2,"|",!,LINE,!,TOE,!
+13 QUIT
+14 ;===================================================================
+15 ;=====================================================================
HUMDRUM(ZZ,INC) ;A SORT OF CLOCK THAT SPINS WHILE LONG PROCESSING IS OCCURRING
+1 SET ZZ=ZZ+INC
IF ZZ#1=0
SET ZZT=ZZ#9
WRITE $CHAR(13),$SELECT(ZZT=1:"|",ZZT=2:"/",ZZT=3:"-",ZZT=4:"\",ZZT=5:"|",ZZT=6:"/",ZZT=7:"-",ZZT=8:"\",1:"")
IF ZZ=8
SET ZZ=0
+2 QUIT ZZ
+3 ;=====================================================================
+4 ;
+5 QUIT
MSSG(MSG) ;Randomly pick a heart warming message
+1 ; MSGS = The # of messages in this routine. If u add a message, update
+2 NEW MSGS,CNT
+3 SET MSGS=8
+4 SET CNT=$RANDOM(MSGS)+1
SET MSG=$PIECE($TEXT(MSG+CNT),";",2)
MSG ;
+1 ;All Work & No Training, Makes Me a Dull Dude!
+2 ;Well Trained Employees, Put Veterans First!
+3 ;You Bet, Train a Vet!
+4 ;By failing to prepare we prepare to fail.
+5 ;Ideas won't work unless you do.
+6 ;The future is purchased by the present.
+7 ;A smooth sea never made a skillful sailor.
+8 ;Don't learn safety rules simply by accident.
+9 ;
+10 QUIT
+11 ;
CVTDATE(X,PRSDATE) ;
+1 ; Called by the input transform of File 458.1 (LEAVE REQUEST) field
+2 ; # 2 From Date and field # 4 To Date.
+3 ;
+4 ; INPUT: X - is set to the external representation of the date
+5 ; selected by the user.
+6 ;
+7 ; PRSDATE - The variable Z1 is created by Form PRSA LV REQ and
+8 ; is passed by the input transform to CVTDATE. This variable
+9 ; may not be defined if this field is edited by another
+10 ; method. If defined PRSDATE will be the internal FileMan
+11 ; representation of the date entered by the user for the
+12 ; From Date field. During the To Date field validation,
+13 ; PRSDATE will represent the earliest date allowed.
+14 ;
+15 ; OUTPUT: X - is returned by the function. X will contain either the
+16 ; internal FileMan format for the valid date selected by
+17 ; the user or the value -1 if an invalid date was selected.
+18 ;
+19 NEW FUTYR,PASYR,%DT,BEGINDT,X1,X2,Y
+20 ;
+21 ; Set %DT to not allow TODATE earlier than FROMDATE. Z1 contains
+22 ; the date stored in FROMDATE in the FileMan internal date format.
+23 ;
+24 IF +$PIECE($GET(PRSDATE),"^")?7N
SET %DT(0)=$PIECE(PRSDATE,"^")
+25 ;
+26 ; Convert user input based on assumed past date lookup.
+27 ; Y will contain the user selected date in internal FileMan format.
+28 ;
+29 SET %DT="XP"
DO ^%DT
+30 SET PASYR=Y
+31 ;
+32 ; Convert user input based on assumed future date lookup
+33 ; Y will contain the user selected date in internal FileMan format.
+34 ;
+35 SET %DT="XF"
DO ^%DT
+36 SET FUTYR=Y
+37 ;
+38 ; If these two lookups match the user specified a four digit
+39 ; year and no extra processing is necessary.
+40 ;
+41 IF PASYR=FUTYR
SET X=PASYR
+42 ;
+43 ; If these two lookups don't match then the user did not
+44 ; enter a four digit year. That's o.k. but we need to assume that
+45 ; they meant either 60 days ago or in the future.
+46 ;
+47 ; Subtract 60 days from today and test to see if the date the user
+48 ; entered falls within this range.
+49 ;
+50 IF PASYR'=FUTYR
Begin DoDot:1
+51 SET X1=DT
SET X2=-60
+52 DO C^%DTC
+53 SET BEGINDT=X
+54 ; Default the date to the past year lookup and begin testing
+55 SET X=PASYR
+56 ; Perform two checks:
+57 ; #1 Does the user entered date fall within that last 60 days?
+58 ; If it doesn't execute check #2.
+59 ; #2 Does the date falls within the standard +20 year
+60 ; time window? If so then default to a future year.
+61 IF BEGINDT>PASYR
IF ($EXTRACT(DT,1,3)+20'<$EXTRACT(FUTYR,1,3))
SET X=FUTYR
End DoDot:1
+62 ;
+63 ; Return the user selected date in the FileMan internal date format.
QUIT X
