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

PRSLIB00.m

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