| [613] | 1 | PRS8UT ;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 | ;
|
|---|
| 9 | DEV ; --- 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 | ;
|
|---|
| 21 | END ; --- all done here
|
|---|
| 22 | K ZTSK,IOP,%IS Q
|
|---|
| 23 | HOLIDAY(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 | ;
|
|---|
| 30 | OLDENT(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 | ;
|
|---|
| 52 | OLDPP(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
|
|---|
| 77 | SETOLDPP(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
|
|---|
