- PRSRUTL ;HISC/JH,WCIOFO/JAH-UTILITY FOR PAID ADDIM. REPORTS ;10/16/97
- ;;4.0;PAID;**2,16,24**;Sep 21, 1995
- CHKTLE ;CHECK IF SELECTED EMP. IS ASSIGNED TO USER
- S (STFSW,TL)=0 F S TL=$O(TLE(TL)) Q:TL'>0 D Q:STFSW
- . S TL(1)=0 F S TL(1)=$O(TLE(TL,TL(1))) Q:TL(1)'>0 D Q:STFSW
- .. I $P(TLE(TL,TL(1)),U)=D0 S NAM=$P(TLE(TL,TL(1)),U,2),STFSW=1 Q
- .. Q
- . Q
- W:'STFSW !?2,$C(7),"EMPLOYEE NOT ASSIGNED TO THAT T&L.",!
- Q
- QUERY N DA,I,X W @IOF,!!,"T&L's Assigned to you.",! S DA=0 F S DA=$O(TLE(DA)) Q:DA'>0 D
- . D:$Y>(IOSL-4) RTN W !?2,$P(TLE(DA),U)
- . Q
- Q
- RTN R !!,"Press Enter/Return to continue. ",X:DTIME Q:'$T
- Q
- STAFF(X) ;This utility will pass back an employees' STATION (if no duty station) ^ STATION_"."_DUTY STATION (if duty station) ^ ORGANIZATION ^
- ; SERVICE ^ TITLE '
- ;Input - D STAFF^PRSRUTL(.veriable), whereas 'veriable' is the
- ; employees Duz No.
- ;Output - variable = 'station_"."_duty station^T&L^organization^service^title'
- N STA,TLE,COS,COSORG,DTX,DA,ORG Q:X'>0 S STA=$P($G(^PRSPC(X,0)),"^",7),TLE=$P($G(^(0)),U,8),COSORG=$P(^(0),"^",49),DTY=$P($G(^(1)),U,42),Y=$P($G(^(0)),U,17) I Y'="" D OST^PRSDUTIL
- I TLE'="" S DA=0,DA=$O(^PRST(455.5,"B",TLE,0)),TLE=$P($G(^PRST(455.5,DA,0)),U,2)
- S COS=$S(COSORG'="":$E(COSORG,1,4),1:""),ORG=$S(COSORG'="":$E(COSORG,5,8),1:"")
- I ORG'="" S ORG=$O(^PRSP(454,1,"ORG","B",COS_":"_ORG,"")),ORG=$P(^PRSP(454,1,"ORG",ORG,0),"^",2),ORG=$P(^PRSP(454.1,ORG,0),"^")
- S X=$S(DTY'="":STA_"."_DTY,1:STA)_U_DA_U_TLE_U_Y_U_ORG Q
- DTY(DTY) ;This utility will pass back an employees 'duty station'.
- ;Input - D DTY^PRSRUTL(.variable), whereas 'variable' is the
- ; employees' Duz No.
- ;Output - variable = employees' duty station.
- S DTY=$P($G(^PRSPC(DTY,1)),U,42) Q
- UPPER(X) ;Convert contents in x to upper case.
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- CKSTOP S:$$S^%ZTLOAD ZTSTOP=1 Q
- ST D HOME^%ZIS Q
- DUZ S PRSRDUZ="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S PRSRDUZ=$O(^PRSPC("SSN",SSN,0))
- I 'PRSRDUZ W !!,*7,"Your SSN was not found in Employee File!"
- I SSN="" W !!,*7,"Your SSN was not found in the New Person File!"
- Q
- CCORG(EMP0NODE) ;pass employees 0 node from file 450 EMP0NODE
- ;function returns employees cost center organization
- ; description (dx) from file 454.1. returns code if no dx.
- ; added in patch 16 by John Heiges
- ; EMP0NODE = the employee data from the zero node in file 450
- ;
- ; get piece 49 (field 458 in file 450, employees cost center/organiz)
- S COSORG=$P(EMP0NODE,"^",49)
- S COS=$S(COSORG'="":$E(COSORG,1,4),1:"")
- S ORG=$S(COSORG'="":$E(COSORG,5,8),1:"")
- I ORG'="" D
- . ;look up ccoc description. If no dx, just display ccoc.
- . N ORGDX
- . S ORGDX=$O(^PRSP(454,1,"ORG","B",COS_":"_ORG,""))
- . ;ptr 2 ccoc description
- . I ORGDX'="" S ORGDX=$P($G(^PRSP(454,1,"ORG",ORGDX,0)),"^",2)
- . I ORGDX'="" S ORG=$P(^PRSP(454.1,ORGDX,0),"^")
- . E S ORG=COS_":"_ORG
- Q ORG
- CCORGBUL(CODE,RPTDUZ,REPORT,EMP) ;
- ;This routine is invoked when the cost center organization code
- ;description is missing during the running of the EMPLOYEE LEAVE USED
- ;and the EMPLOYEE LEAVE PATTERN report. It sends a bulleting to
- ;the PAD mail group asking them to fix it.
- ;
- ;EMP = the employee who's leave is being looked at in the report
- ;CODE = cost center/organization code
- ;RPTDUZ = person who is running the report.
- ;REPORT : 1 = EMPLOYEE LEAVE USED, 0 = EMPLOYEE LEAVE PATTERN
- ;
- N TXT,I,XMDUZ,XMB,XMY,XMDUZ
- S XMY("G.PAD@"_^XMB("NETNAME"))=""
- S XMDUZ="DHCP PAID PACKAGE"
- S XMB="PRS UPDATE CCORG"
- S XMB(1)=CODE,XMB(2)=$P($G(^PRSPC(RPTDUZ,0)),"^",1)
- I REPORT>0 S XMB(3)="``Employee Leave Requested''"
- S XMB(4)=EMP
- E S XMB(3)="``Employee Leave Pattern''"
- D ^XMB
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSRUTL 3832 printed Feb 18, 2025@23:55:12 Page 2
- PRSRUTL ;HISC/JH,WCIOFO/JAH-UTILITY FOR PAID ADDIM. REPORTS ;10/16/97
- +1 ;;4.0;PAID;**2,16,24**;Sep 21, 1995
- CHKTLE ;CHECK IF SELECTED EMP. IS ASSIGNED TO USER
- +1 SET (STFSW,TL)=0
- FOR
- SET TL=$ORDER(TLE(TL))
- if TL'>0
- QUIT
- Begin DoDot:1
- +2 SET TL(1)=0
- FOR
- SET TL(1)=$ORDER(TLE(TL,TL(1)))
- if TL(1)'>0
- QUIT
- Begin DoDot:2
- +3 IF $PIECE(TLE(TL,TL(1)),U)=D0
- SET NAM=$PIECE(TLE(TL,TL(1)),U,2)
- SET STFSW=1
- QUIT
- +4 QUIT
- End DoDot:2
- if STFSW
- QUIT
- +5 QUIT
- End DoDot:1
- if STFSW
- QUIT
- +6 if 'STFSW
- WRITE !?2,$CHAR(7),"EMPLOYEE NOT ASSIGNED TO THAT T&L.",!
- +7 QUIT
- QUERY NEW DA,I,X
- WRITE @IOF,!!,"T&L's Assigned to you.",!
- SET DA=0
- FOR
- SET DA=$ORDER(TLE(DA))
- if DA'>0
- QUIT
- Begin DoDot:1
- +1 if $Y>(IOSL-4)
- DO RTN
- WRITE !?2,$PIECE(TLE(DA),U)
- +2 QUIT
- End DoDot:1
- +3 QUIT
- RTN READ !!,"Press Enter/Return to continue. ",X:DTIME
- if '$TEST
- QUIT
- +1 QUIT
- STAFF(X) ;This utility will pass back an employees' STATION (if no duty station) ^ STATION_"."_DUTY STATION (if duty station) ^ ORGANIZATION ^
- +1 ; SERVICE ^ TITLE '
- +2 ;Input - D STAFF^PRSRUTL(.veriable), whereas 'veriable' is the
- +3 ; employees Duz No.
- +4 ;Output - variable = 'station_"."_duty station^T&L^organization^service^title'
- +5 NEW STA,TLE,COS,COSORG,DTX,DA,ORG
- if X'>0
- QUIT
- SET STA=$PIECE($GET(^PRSPC(X,0)),"^",7)
- SET TLE=$PIECE($GET(^(0)),U,8)
- SET COSORG=$PIECE(^(0),"^",49)
- SET DTY=$PIECE($GET(^(1)),U,42)
- SET Y=$PIECE($GET(^(0)),U,17)
- IF Y'=""
- DO OST^PRSDUTIL
- +6 IF TLE'=""
- SET DA=0
- SET DA=$ORDER(^PRST(455.5,"B",TLE,0))
- SET TLE=$PIECE($GET(^PRST(455.5,DA,0)),U,2)
- +7 SET COS=$SELECT(COSORG'="":$EXTRACT(COSORG,1,4),1:"")
- SET ORG=$SELECT(COSORG'="":$EXTRACT(COSORG,5,8),1:"")
- +8 IF ORG'=""
- SET ORG=$ORDER(^PRSP(454,1,"ORG","B",COS_":"_ORG,""))
- SET ORG=$PIECE(^PRSP(454,1,"ORG",ORG,0),"^",2)
- SET ORG=$PIECE(^PRSP(454.1,ORG,0),"^")
- +9 SET X=$SELECT(DTY'="":STA_"."_DTY,1:STA)_U_DA_U_TLE_U_Y_U_ORG
- QUIT
- DTY(DTY) ;This utility will pass back an employees 'duty station'.
- +1 ;Input - D DTY^PRSRUTL(.variable), whereas 'variable' is the
- +2 ; employees' Duz No.
- +3 ;Output - variable = employees' duty station.
- +4 SET DTY=$PIECE($GET(^PRSPC(DTY,1)),U,42)
- QUIT
- UPPER(X) ;Convert contents in x to upper case.
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- CKSTOP if $$S^%ZTLOAD
- SET ZTSTOP=1
- QUIT
- ST DO HOME^%ZIS
- QUIT
- DUZ SET PRSRDUZ=""
- SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
- IF SSN'=""
- SET PRSRDUZ=$ORDER(^PRSPC("SSN",SSN,0))
- +1 IF 'PRSRDUZ
- WRITE !!,*7,"Your SSN was not found in Employee File!"
- +2 IF SSN=""
- WRITE !!,*7,"Your SSN was not found in the New Person File!"
- +3 QUIT
- CCORG(EMP0NODE) ;pass employees 0 node from file 450 EMP0NODE
- +1 ;function returns employees cost center organization
- +2 ; description (dx) from file 454.1. returns code if no dx.
- +3 ; added in patch 16 by John Heiges
- +4 ; EMP0NODE = the employee data from the zero node in file 450
- +5 ;
- +6 ; get piece 49 (field 458 in file 450, employees cost center/organiz)
- +7 SET COSORG=$PIECE(EMP0NODE,"^",49)
- +8 SET COS=$SELECT(COSORG'="":$EXTRACT(COSORG,1,4),1:"")
- +9 SET ORG=$SELECT(COSORG'="":$EXTRACT(COSORG,5,8),1:"")
- +10 IF ORG'=""
- Begin DoDot:1
- +11 ;look up ccoc description. If no dx, just display ccoc.
- +12 NEW ORGDX
- +13 SET ORGDX=$ORDER(^PRSP(454,1,"ORG","B",COS_":"_ORG,""))
- +14 ;ptr 2 ccoc description
- +15 IF ORGDX'=""
- SET ORGDX=$PIECE($GET(^PRSP(454,1,"ORG",ORGDX,0)),"^",2)
- +16 IF ORGDX'=""
- SET ORG=$PIECE(^PRSP(454.1,ORGDX,0),"^")
- +17 IF '$TEST
- SET ORG=COS_":"_ORG
- End DoDot:1
- +18 QUIT ORG
- CCORGBUL(CODE,RPTDUZ,REPORT,EMP) ;
- +1 ;This routine is invoked when the cost center organization code
- +2 ;description is missing during the running of the EMPLOYEE LEAVE USED
- +3 ;and the EMPLOYEE LEAVE PATTERN report. It sends a bulleting to
- +4 ;the PAD mail group asking them to fix it.
- +5 ;
- +6 ;EMP = the employee who's leave is being looked at in the report
- +7 ;CODE = cost center/organization code
- +8 ;RPTDUZ = person who is running the report.
- +9 ;REPORT : 1 = EMPLOYEE LEAVE USED, 0 = EMPLOYEE LEAVE PATTERN
- +10 ;
- +11 NEW TXT,I,XMDUZ,XMB,XMY,XMDUZ
- +12 SET XMY("G.PAD@"_^XMB("NETNAME"))=""
- +13 SET XMDUZ="DHCP PAID PACKAGE"
- +14 SET XMB="PRS UPDATE CCORG"
- +15 SET XMB(1)=CODE
- SET XMB(2)=$PIECE($GET(^PRSPC(RPTDUZ,0)),"^",1)
- +16 IF REPORT>0
- SET XMB(3)="``Employee Leave Requested''"
- +17 SET XMB(4)=EMP
- +18 IF '$TEST
- SET XMB(3)="``Employee Leave Pattern''"
- +19 DO ^XMB
- +20 QUIT