source: WorldVistAEHR/trunk/r/PAID-PRS/PRS8UT.m@ 1166

Last change on this file since 1166 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PRS8UT ;HISC/MRL,JAH/WIRMFO-DECOMPOSITION, UTILITIES ;3/5/93 15:24
2 ;;4.0;PAID;**21,45**;Sep 21, 1995
3 ;
4 ;This routine contains utility functions associated with the
5 ;decomposition process such as device selection.
6 ;
7 ;Called by Routines: PRS8, PRS8TL
8 ;
9DEV ; --- device selection
10 K IOP,%ZIS S %ZIS="NQM",%ZIS("A")="Output DEVICE: ",%ZIS("B")="HOME"
11 D ^%ZIS K %ZIS
12 I POP W !,"Process Terminated. No Device Specified!",*7 G END
13 S IOP=ION_";"_IOST_$S($D(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
14 I IO=IO(0),"C"[$E(IOST),$D(IO("Q"))#2 W !,"I can't permit you to QUEUE this output to a CRT!",*7 G DEV
15 I IO'=IO(0),'$D(IO("Q")) W !,"Output QUEUED to run on DEVICE ",IO S IO("Q")=1,ZTDTH=$H
16 I '$D(IO("Q")) D ^%ZIS U IO G @PRS8("PGM")
17 S ZTRTN=PRS8("PGM"),ZTIO=IOP,ZTDESC=PRS8("DES")
18 F I=1:1 S J=$P(PRS8("VAR"),"^",I) Q:J="" S ZTSAVE(J)=""
19 K IO("Q") D ^%ZTLOAD,HOME^%ZIS
20 ;
21END ; --- all done here
22 K ZTSK,IOP,%IS Q
23HOLIDAY(PY,DFN,DY) ; PAY_PERIOD , EMPLOYEE , DAY_NUMBER
24 ; Returns 1 if holiday excused/worked (HX/HW) is found for this employee
25 N X S X=$G(^PRST(458,+PY,"E",+DFN,"D",+DY,2))
26 Q (X["HX")!(X["HW")
27 ;
28 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
29 ;
30OLDENT(PP2Y,EMP450) ;
31 ; Return employee entitlement from a pay period. Entitlement is
32 ; normally built from employee's master record (FILE 450), but
33 ; it is also stored in file 458 (which is historical) and may
34 ; be different than the employee's current entitlement.
35 ;
36 N DIC,X,Y,PPI,DA
37 S ENT=0
38 S DIC="^PRST(458,",DIC(0)="MZ",X=PP2Y
39 D ^DIC
40 Q:'+Y ENT
41 ;
42 S DA(1)=+Y
43 S DIC=DIC_DA(1)_","_"""E"""_","
44 S X=EMP450 D ^DIC
45 Q:'+Y ENT
46 ;
47 S ENT=$P($G(^PRST(458,DA(1),"E",+Y,0)),"^",5)
48 Q ENT
49 ;
50 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
51 ;
52OLDPP(PYPERIOD,EMP450NO) ;OLD PAY PERIOD LOOKUP
53 ; Look up information about an employee from an old pay period.
54 ; return PAYPLAN if the lookup is successful and a pay plan is found.
55 ; return 0 if the lookup fails for any reason.
56 ; fill OLDPP array with pay run info.
57 ;VARS:
58 ; PYPERIOD = Pay period that we are looking up. yy-pp format (96-01).
59 ; EMP450NO = Employees internal entry number from file 450.
60 ; PAYPDIEN = Internal entry number of PYPERIOD
61 ; RTN = Return 1 for success 0 otherwise
62 ; OLDPYDAT = Payrun data in file 459. Data is pertinant to employee
63 ; being looked up during that pay period.
64 ; PAYPLAN = Employees old pay plan. returned if found.
65 ;
66 S RTN=0,U="^"
67 ;ensure params are reasonable
68 I $G(PYPERIOD)?2N1"-"2N,($G(EMP450NO)>0) D
69 . S PAYPDIEN=$O(^PRST(459,"B",$G(PYPERIOD),""))
70 . I $G(PAYPDIEN) D
71 .. S OLDPYDAT=$G(^PRST(459,PAYPDIEN,"P",EMP450NO,0))
72 .. S PAYPLAN=$P(OLDPYDAT,U,3)
73 .. I PAYPLAN'="" D
74 ... D SETOLDPP(OLDPYDAT)
75 ... S RTN=PAYPLAN
76 Q RTN
77SETOLDPP(EMPDATA) ;set up array with info from an employees record
78 ;in the payrun download file (#459)
79 ;
80 S U="^"
81 S OLDPP("PAYPLN")=$P(EMPDATA,U,3)
82 S OLDPP("GRADE")=$P(EMPDATA,U,4)
83 S OLDPP("STEP")=$P(EMPDATA,U,5)
84 S OLDPP("DUTYBS")=$P(EMPDATA,U,6)
85 S OLDPP("8BNHRS")=$P(EMPDATA,U,7)
86 S OLDPP("TLUNIT")=$P(EMPDATA,U,13)
87 S OLDPP("NRMHRS")=$P(EMPDATA,U,12)
88 Q
Note: See TracBrowser for help on using the repository browser.