- 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 Feb 18, 2025@23:49:30 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