- 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 Jan 18, 2025@03:28:09 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