source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCGN.m@ 767

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1FSCRPCGN ;SLC/STAFF-NOIS RPC Package Info ;1/11/98 15:24
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4SPEC(SPEC) ; from FSCRPCG
5 N CNT,PHONE
6 S CNT=0
7 S PHONE=$$PH(SPEC)
8 I $L(PHONE) S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Office Phone: "_PHONE
9 D MAILINFO(.CNT,SPEC)
10 D NOIS(.CNT,SPEC)
11 Q
12 ;
13CONTACT(PERSON) ; from FSCRPCG
14 N CNT,PHONE
15 S CNT=0
16 S PHONE=$$PH(PERSON)
17 I $L(PHONE) S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Office Phone: "_PHONE
18 D MAILINFO(.CNT,PERSON)
19 D NOIS(.CNT,PERSON)
20 Q
21 ;
22MAILINFO(CNT,USER) ;
23 N LINE,NUM
24 I '$O(^XMB(3.7,+$G(USER),1,0)) Q
25 S CNT=+$G(CNT)
26 S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=""
27 S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="MailMan Introduction:"
28 S NUM=0 F S NUM=$O(^XMB(3.7,USER,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
29 .S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
30 Q
31 ;
32NOIS(CNT,USER) ;
33 N FUNC,LINE,NUM,OFFICE,WORKSAT,ZERO
34 S ZERO=$G(^FSC("SPEC",+$G(USER),0)) I '$L(ZERO) Q
35 S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=""
36 I '$P(ZERO,U,2) D
37 .S FUNC=$$VALUE^FSCGET($P(ZERO,U,4),7105.2,4)
38 .S WORKSAT=$$VALUE^FSCGET($P(ZERO,U,3),7105.2,3)
39 .S OFFICE=$$VALUE^FSCGET($P(ZERO,U,16),7105.2,3.5)
40 .I $L(FUNC) S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Primary Functional Area: "_FUNC
41 .S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Office: "_OFFICE_" Works at: "_WORKSAT
42 I $O(^FSC("SPEC",USER,20,0)) D
43 .S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Group Affiliations:"
44 S NUM=0 F S NUM=$O(^FSC("SPEC",USER,20,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
45 .S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=" "_$$VALUE^FSCGET($P(LINE,U),7100,3.3)_" "_$P(LINE,U,2)
46 I $O(^FSC("SPEC",USER,30,0)) D
47 .S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Package Affiliations:"
48 S NUM=0 F S NUM=$O(^FSC("SPEC",USER,30,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
49 .S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=" "_$$VALUE^FSCGET($P(LINE,U),7100,3.1)_" "_$P(LINE,U,2)
50 Q
51 ;
52MOD(MOD) ;
53 N ADPAC,NUM,OUTCNT,PACK,PACKNAME,SITE,SITENAME,STSITE,USER,USERS K USERS
54 S PACK=+$P($G(^FSC("MOD",+MOD,0)),U,8)
55 I 'PACK Q
56 S PACKNAME=$P(^FSC("PACK",PACK,0),U)
57 S OUTCNT=0
58 S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)="Those affiliated with "_PACKNAME_":"
59 D AFFIL(PACK,.USERS)
60 S USER="" F S USER=$O(USERS(USER)) Q:USER="" D
61 .S NUM=0 F S NUM=$O(USERS(USER,NUM)) Q:NUM<1 D
62 ..S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)=USER_" "_USERS(USER,NUM)
63 S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)=""
64 S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)="ADPACs:"
65 S SITENAME="" F S SITENAME=$O(^FSC("SITE","B",SITENAME)) Q:SITENAME="" D
66 .S SITE=0 F S SITE=$O(^FSC("SITE","B",SITENAME,SITE)) Q:SITE<1 D
67 ..S STSITE=$$STSITE(SITE)
68 ..I 'STSITE Q
69 ..S ADPAC=$$APINFO(STSITE,PACK)
70 ..I $L(ADPAC) S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)=" "_SITENAME_" "_ADPAC
71 K USERS
72 Q
73 ;
74AFFIL(PACK,USERS) ;
75 N DUTIES,FUNC,PACKGP,USER,USERNAME K USERS
76 S PACKGP=+$P(^FSC("PACK",PACK,0),U,2)
77 S USER=0 F S USER=$O(^FSC("SPEC","AG",PACKGP,USER)) Q:USER<.1 D
78 .S USERNAME=$P(^VA(200,USER,0),U)
79 .I $P($G(^FSC("SPEC",USER,20,+$O(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3) D
80 ..S DUTIES=$P($G(^FSC("SPEC",USER,20,+$O(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,2)
81 ..S FUNC=$$VALUE^FSCGET($P(^FSC("SPEC",USER,0),U,4),7105.2,4) I $L(FUNC) S FUNC="("_FUNC_")"
82 ..S USERS(USERNAME,USER)=FUNC_" "_DUTIES_" "_$$PH(USER)
83 S USER=0 F S USER=$O(^FSC("SPEC","AP",PACK,USER)) Q:USER<.1 D
84 .S USERNAME=$P(^VA(200,USER,0),U)
85 .S DUTIES=$P($G(^FSC("SPEC",USER,30,+$O(^FSC("SPEC","AP",PACK,USER,0)),0)),U,2)
86 .S FUNC=$$VALUE^FSCGET($P(^FSC("SPEC",USER,0),U,4),7105.2,4) I $L(FUNC) S FUNC="("_FUNC_")"
87 .S USERS(USERNAME,USER)=FUNC_" "_DUTIES_" "_$$PH(USER)
88 Q
89 ;
90NOISINFO(SITE) ; $$(site) -> contact & phone #
91 N INFO
92 S INFO=$P($G(^FSC("SITE",SITE,0)),U,6) I 'INFO Q ""
93 S INFO=$$VALUE^FSCGET(INFO,7100,2.1)
94 S INFO=INFO_" "_$S($L($P(^FSC("SITE",SITE,0),U,7)):$P(^(0),U,7),1:$P(^(0),U,8))
95 Q INFO
96 ;
97PH(PERSON) ; $$(person) -> phone # from file 200
98 Q $P($G(^VA(200,PERSON,.13)),U,2)
99 ;
100IRMINFO(STSITE) ; $$(site) -> irm chief & phone #
101 N INFO,IRM
102 S IRM=$G(^NTS(2050,STSITE,21))
103 S INFO=$P(IRM,U)_" "_$P(IRM,U,2) I $L(INFO)=2 Q ""
104 Q INFO
105 ;
106APINFO(STSITE,PACK) ; $$(site, pack) -> adpac & phone #
107 N ADPAC,INFO,STPACK
108 S STPACK=$$STPACK(PACK) I 'STPACK Q ""
109 S ADPAC=$G(^NTS(2050,STSITE,8,STPACK,0))
110 S INFO=$P(ADPAC,U,2)_" "_$P(ADPAC,U,3) I $L(INFO)=2 Q ""
111 Q INFO
112 ;
113STSITE(SITE) ; $$(site) -> site tracking site
114 N DOMAIN,STSITE
115 S DOMAIN=+$P(^FSC("SITE",SITE,0),U,14) I 'DOMAIN Q ""
116 S DOMAIN=$$VALUE^FSCGET(DOMAIN,7105.1,9)
117 S STSITE=+$O(^NTS(2050,"AE",DOMAIN,0)) I 'STSITE Q ""
118 Q STSITE
119 ;
120STPACK(PACK) ; $$(package) -> site tracking package
121 N OPACK,STPACK
122 S OPACK=+$P($G(^FSC("PACK",+$G(PACK),0)),U,3) I 'OPACK Q ""
123 S STPACK=+$O(^DIC(120102,"AP",OPACK,0)) I 'STPACK Q ""
124 Q STPACK
Note: See TracBrowser for help on using the repository browser.