source: FOIAVistA/trunk/r/PAID-PRS/PRSRUTL.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1PRSRUTL ;HISC/JH,WCIOFO/JAH-UTILITY FOR PAID ADDIM. REPORTS ;10/16/97
2 ;;4.0;PAID;**2,16,24**;Sep 21, 1995
3CHKTLE ;CHECK IF SELECTED EMP. IS ASSIGNED TO USER
4 S (STFSW,TL)=0 F S TL=$O(TLE(TL)) Q:TL'>0 D Q:STFSW
5 . S TL(1)=0 F S TL(1)=$O(TLE(TL,TL(1))) Q:TL(1)'>0 D Q:STFSW
6 .. I $P(TLE(TL,TL(1)),U)=D0 S NAM=$P(TLE(TL,TL(1)),U,2),STFSW=1 Q
7 .. Q
8 . Q
9 W:'STFSW !?2,$C(7),"EMPLOYEE NOT ASSIGNED TO THAT T&L.",!
10 Q
11QUERY 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
12 . D:$Y>(IOSL-4) RTN W !?2,$P(TLE(DA),U)
13 . Q
14 Q
15RTN R !!,"Press Enter/Return to continue. ",X:DTIME Q:'$T
16 Q
17STAFF(X) ;This utility will pass back an employees' STATION (if no duty station) ^ STATION_"."_DUTY STATION (if duty station) ^ ORGANIZATION ^
18 ; SERVICE ^ TITLE '
19 ;Input - D STAFF^PRSRUTL(.veriable), whereas 'veriable' is the
20 ; employees Duz No.
21 ;Output - variable = 'station_"."_duty station^T&L^organization^service^title'
22 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
23 I TLE'="" S DA=0,DA=$O(^PRST(455.5,"B",TLE,0)),TLE=$P($G(^PRST(455.5,DA,0)),U,2)
24 S COS=$S(COSORG'="":$E(COSORG,1,4),1:""),ORG=$S(COSORG'="":$E(COSORG,5,8),1:"")
25 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),"^")
26 S X=$S(DTY'="":STA_"."_DTY,1:STA)_U_DA_U_TLE_U_Y_U_ORG Q
27DTY(DTY) ;This utility will pass back an employees 'duty station'.
28 ;Input - D DTY^PRSRUTL(.variable), whereas 'variable' is the
29 ; employees' Duz No.
30 ;Output - variable = employees' duty station.
31 S DTY=$P($G(^PRSPC(DTY,1)),U,42) Q
32UPPER(X) ;Convert contents in x to upper case.
33 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
34CKSTOP S:$$S^%ZTLOAD ZTSTOP=1 Q
35ST D HOME^%ZIS Q
36DUZ S PRSRDUZ="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S PRSRDUZ=$O(^PRSPC("SSN",SSN,0))
37 I 'PRSRDUZ W !!,*7,"Your SSN was not found in Employee File!"
38 I SSN="" W !!,*7,"Your SSN was not found in the New Person File!"
39 Q
40CCORG(EMP0NODE) ;pass employees 0 node from file 450 EMP0NODE
41 ;function returns employees cost center organization
42 ; description (dx) from file 454.1. returns code if no dx.
43 ; added in patch 16 by John Heiges
44 ; EMP0NODE = the employee data from the zero node in file 450
45 ;
46 ; get piece 49 (field 458 in file 450, employees cost center/organiz)
47 S COSORG=$P(EMP0NODE,"^",49)
48 S COS=$S(COSORG'="":$E(COSORG,1,4),1:"")
49 S ORG=$S(COSORG'="":$E(COSORG,5,8),1:"")
50 I ORG'="" D
51 . ;look up ccoc description. If no dx, just display ccoc.
52 . N ORGDX
53 . S ORGDX=$O(^PRSP(454,1,"ORG","B",COS_":"_ORG,""))
54 . ;ptr 2 ccoc description
55 . I ORGDX'="" S ORGDX=$P($G(^PRSP(454,1,"ORG",ORGDX,0)),"^",2)
56 . I ORGDX'="" S ORG=$P(^PRSP(454.1,ORGDX,0),"^")
57 . E S ORG=COS_":"_ORG
58 Q ORG
59CCORGBUL(CODE,RPTDUZ,REPORT,EMP) ;
60 ;This routine is invoked when the cost center organization code
61 ;description is missing during the running of the EMPLOYEE LEAVE USED
62 ;and the EMPLOYEE LEAVE PATTERN report. It sends a bulleting to
63 ;the PAD mail group asking them to fix it.
64 ;
65 ;EMP = the employee who's leave is being looked at in the report
66 ;CODE = cost center/organization code
67 ;RPTDUZ = person who is running the report.
68 ;REPORT : 1 = EMPLOYEE LEAVE USED, 0 = EMPLOYEE LEAVE PATTERN
69 ;
70 N TXT,I,XMDUZ,XMB,XMY,XMDUZ
71 S XMY("G.PAD@"_^XMB("NETNAME"))=""
72 S XMDUZ="DHCP PAID PACKAGE"
73 S XMB="PRS UPDATE CCORG"
74 S XMB(1)=CODE,XMB(2)=$P($G(^PRSPC(RPTDUZ,0)),"^",1)
75 I REPORT>0 S XMB(3)="``Employee Leave Requested''"
76 S XMB(4)=EMP
77 E S XMB(3)="``Employee Leave Pattern''"
78 D ^XMB
79 Q
Note: See TracBrowser for help on using the repository browser.