PRS8UT ;HISC/MRL,JAH/WIRMFO-DECOMPOSITION, UTILITIES ;3/5/93 15:24
;;4.0;PAID;**21,45**;Sep 21, 1995
;
;This routine contains utility functions associated with the
;decomposition process such as device selection.
;
;Called by Routines: PRS8, PRS8TL
;
DEV ; --- device selection
K IOP,%ZIS S %ZIS="NQM",%ZIS("A")="Output DEVICE: ",%ZIS("B")="HOME"
D ^%ZIS K %ZIS
I POP W !,"Process Terminated. No Device Specified!",*7 G END
S IOP=ION_";"_IOST_$S($D(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
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
I IO'=IO(0),'$D(IO("Q")) W !,"Output QUEUED to run on DEVICE ",IO S IO("Q")=1,ZTDTH=$H
I '$D(IO("Q")) D ^%ZIS U IO G @PRS8("PGM")
S ZTRTN=PRS8("PGM"),ZTIO=IOP,ZTDESC=PRS8("DES")
F I=1:1 S J=$P(PRS8("VAR"),"^",I) Q:J="" S ZTSAVE(J)=""
K IO("Q") D ^%ZTLOAD,HOME^%ZIS
;
END ; --- all done here
K ZTSK,IOP,%IS Q
HOLIDAY(PY,DFN,DY) ; PAY_PERIOD , EMPLOYEE , DAY_NUMBER
; Returns 1 if holiday excused/worked (HX/HW) is found for this employee
N X S X=$G(^PRST(458,+PY,"E",+DFN,"D",+DY,2))
Q (X["HX")!(X["HW")
;
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;
OLDENT(PP2Y,EMP450) ;
; Return employee entitlement from a pay period. Entitlement is
; normally built from employee's master record (FILE 450), but
; it is also stored in file 458 (which is historical) and may
; be different than the employee's current entitlement.
;
N DIC,X,Y,PPI,DA
S ENT=0
S DIC="^PRST(458,",DIC(0)="MZ",X=PP2Y
D ^DIC
Q:'+Y ENT
;
S DA(1)=+Y
S DIC=DIC_DA(1)_","_"""E"""_","
S X=EMP450 D ^DIC
Q:'+Y ENT
;
S ENT=$P($G(^PRST(458,DA(1),"E",+Y,0)),"^",5)
Q ENT
;
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;
OLDPP(PYPERIOD,EMP450NO) ;OLD PAY PERIOD LOOKUP
; Look up information about an employee from an old pay period.
; return PAYPLAN if the lookup is successful and a pay plan is found.
; return 0 if the lookup fails for any reason.
; fill OLDPP array with pay run info.
;VARS:
; PYPERIOD = Pay period that we are looking up. yy-pp format (96-01).
; EMP450NO = Employees internal entry number from file 450.
; PAYPDIEN = Internal entry number of PYPERIOD
; RTN = Return 1 for success 0 otherwise
; OLDPYDAT = Payrun data in file 459. Data is pertinant to employee
; being looked up during that pay period.
; PAYPLAN = Employees old pay plan. returned if found.
;
S RTN=0,U="^"
;ensure params are reasonable
I $G(PYPERIOD)?2N1"-"2N,($G(EMP450NO)>0) D
. S PAYPDIEN=$O(^PRST(459,"B",$G(PYPERIOD),""))
. I $G(PAYPDIEN) D
.. S OLDPYDAT=$G(^PRST(459,PAYPDIEN,"P",EMP450NO,0))
.. S PAYPLAN=$P(OLDPYDAT,U,3)
.. I PAYPLAN'="" D
... D SETOLDPP(OLDPYDAT)
... S RTN=PAYPLAN
Q RTN
SETOLDPP(EMPDATA) ;set up array with info from an employees record
;in the payrun download file (#459)
;
S U="^"
S OLDPP("PAYPLN")=$P(EMPDATA,U,3)
S OLDPP("GRADE")=$P(EMPDATA,U,4)
S OLDPP("STEP")=$P(EMPDATA,U,5)
S OLDPP("DUTYBS")=$P(EMPDATA,U,6)
S OLDPP("8BNHRS")=$P(EMPDATA,U,7)
S OLDPP("TLUNIT")=$P(EMPDATA,U,13)
S OLDPP("NRMHRS")=$P(EMPDATA,U,12)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8UT 3242 printed Dec 13, 2024@02:23:05 Page 2
PRS8UT ;HISC/MRL,JAH/WIRMFO-DECOMPOSITION, UTILITIES ;3/5/93 15:24
+1 ;;4.0;PAID;**21,45**;Sep 21, 1995
+2 ;
+3 ;This routine contains utility functions associated with the
+4 ;decomposition process such as device selection.
+5 ;
+6 ;Called by Routines: PRS8, PRS8TL
+7 ;
DEV ; --- device selection
+1 KILL IOP,%ZIS
SET %ZIS="NQM"
SET %ZIS("A")="Output DEVICE: "
SET %ZIS("B")="HOME"
+2 DO ^%ZIS
KILL %ZIS
+3 IF POP
WRITE !,"Process Terminated. No Device Specified!",*7
GOTO END
+4 SET IOP=ION_";"_IOST_$SELECT($DATA(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
+5 IF IO=IO(0)
IF "C"[$EXTRACT(IOST)
IF $DATA(IO("Q"))#2
WRITE !,"I can't permit you to QUEUE this output to a CRT!",*7
GOTO DEV
+6 IF IO'=IO(0)
IF '$DATA(IO("Q"))
WRITE !,"Output QUEUED to run on DEVICE ",IO
SET IO("Q")=1
SET ZTDTH=$HOROLOG
+7 IF '$DATA(IO("Q"))
DO ^%ZIS
USE IO
GOTO @PRS8("PGM")
+8 SET ZTRTN=PRS8("PGM")
SET ZTIO=IOP
SET ZTDESC=PRS8("DES")
+9 FOR I=1:1
SET J=$PIECE(PRS8("VAR"),"^",I)
if J=""
QUIT
SET ZTSAVE(J)=""
+10 KILL IO("Q")
DO ^%ZTLOAD
DO HOME^%ZIS
+11 ;
END ; --- all done here
+1 KILL ZTSK,IOP,%IS
QUIT
HOLIDAY(PY,DFN,DY) ; PAY_PERIOD , EMPLOYEE , DAY_NUMBER
+1 ; Returns 1 if holiday excused/worked (HX/HW) is found for this employee
+2 NEW X
SET X=$GET(^PRST(458,+PY,"E",+DFN,"D",+DY,2))
+3 QUIT (X["HX")!(X["HW")
+4 ;
+5 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+6 ;
OLDENT(PP2Y,EMP450) ;
+1 ; Return employee entitlement from a pay period. Entitlement is
+2 ; normally built from employee's master record (FILE 450), but
+3 ; it is also stored in file 458 (which is historical) and may
+4 ; be different than the employee's current entitlement.
+5 ;
+6 NEW DIC,X,Y,PPI,DA
+7 SET ENT=0
+8 SET DIC="^PRST(458,"
SET DIC(0)="MZ"
SET X=PP2Y
+9 DO ^DIC
+10 if '+Y
QUIT ENT
+11 ;
+12 SET DA(1)=+Y
+13 SET DIC=DIC_DA(1)_","_"""E"""_","
+14 SET X=EMP450
DO ^DIC
+15 if '+Y
QUIT ENT
+16 ;
+17 SET ENT=$PIECE($GET(^PRST(458,DA(1),"E",+Y,0)),"^",5)
+18 QUIT ENT
+19 ;
+20 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+21 ;
OLDPP(PYPERIOD,EMP450NO) ;OLD PAY PERIOD LOOKUP
+1 ; Look up information about an employee from an old pay period.
+2 ; return PAYPLAN if the lookup is successful and a pay plan is found.
+3 ; return 0 if the lookup fails for any reason.
+4 ; fill OLDPP array with pay run info.
+5 ;VARS:
+6 ; PYPERIOD = Pay period that we are looking up. yy-pp format (96-01).
+7 ; EMP450NO = Employees internal entry number from file 450.
+8 ; PAYPDIEN = Internal entry number of PYPERIOD
+9 ; RTN = Return 1 for success 0 otherwise
+10 ; OLDPYDAT = Payrun data in file 459. Data is pertinant to employee
+11 ; being looked up during that pay period.
+12 ; PAYPLAN = Employees old pay plan. returned if found.
+13 ;
+14 SET RTN=0
SET U="^"
+15 ;ensure params are reasonable
+16 IF $GET(PYPERIOD)?2N1"-"2N
IF ($GET(EMP450NO)>0)
Begin DoDot:1
+17 SET PAYPDIEN=$ORDER(^PRST(459,"B",$GET(PYPERIOD),""))
+18 IF $GET(PAYPDIEN)
Begin DoDot:2
+19 SET OLDPYDAT=$GET(^PRST(459,PAYPDIEN,"P",EMP450NO,0))
+20 SET PAYPLAN=$PIECE(OLDPYDAT,U,3)
+21 IF PAYPLAN'=""
Begin DoDot:3
+22 DO SETOLDPP(OLDPYDAT)
+23 SET RTN=PAYPLAN
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT RTN
SETOLDPP(EMPDATA) ;set up array with info from an employees record
+1 ;in the payrun download file (#459)
+2 ;
+3 SET U="^"
+4 SET OLDPP("PAYPLN")=$PIECE(EMPDATA,U,3)
+5 SET OLDPP("GRADE")=$PIECE(EMPDATA,U,4)
+6 SET OLDPP("STEP")=$PIECE(EMPDATA,U,5)
+7 SET OLDPP("DUTYBS")=$PIECE(EMPDATA,U,6)
+8 SET OLDPP("8BNHRS")=$PIECE(EMPDATA,U,7)
+9 SET OLDPP("TLUNIT")=$PIECE(EMPDATA,U,13)
+10 SET OLDPP("NRMHRS")=$PIECE(EMPDATA,U,12)
+11 QUIT
