source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCLMPOC.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1FSCLMPOC ;SLC/STAFF-NOIS List Manager Protocol Other Contacts ;6/3/98 10:58
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4CONTACTS(CALL) ; from FSCLMPO
5 N CONTACT,CONTPH,CNT,DEVSP,MOD,OK,PACK,PACKNAME,PIECE,SITE,SPEC,STINFO,STSITE,USER,USERS K USERS
6 S OK=1
7 S SITE=$P(^FSCD("CALL",CALL,0),U,5),CONTACT=$P(^(0),U,6),CONTPH=$P(^(0),U,7),MOD=$P(^(0),U,8),SPEC=$P(^(0),U,9),DEVSP=$P(^(0),U,21)
8 I SPEC W !,"Specialist: ",$$VALUE^FSCGET(SPEC,7100,5)," ",$$PH(SPEC)
9 I DEVSP W !,"Referred Specialist: ",$$VALUE^FSCGET(DEVSP,7100,5.1)," ",$$PH(DEVSP)
10 W !!,"Contact: ",$$VALUE^FSCGET(CONTACT,7100,2.1)," ",CONTPH
11 W !,"NOIS contact information for this location: ",$$NOISINFO(SITE)
12 I 'MOD D PAUSE^FSCU(.OK) Q
13 S PACK=$P(^FSC("MOD",MOD,0),U,8),PACKNAME=$P(^FSC("PACK",PACK,0),U)
14 S STSITE=$$STSITE(SITE) I STSITE D
15 .W !!,"IRM Chief and phone: ",$$IRMINFO(STSITE)
16 .W !,PACKNAME," ADPAC and phone: ",$$APINFO(STSITE,PACK)
17 .W !,"Information on ",$P(^FSC("SITE",SITE,0),U),":"
18 .S STINFO=$G(^NTS(2050,STSITE,1))
19 .F PIECE=1:1:3 W !?3,$P(STINFO,U,PIECE)
20 .W ", ",$$VALUE^FSCGET($P(STINFO,U,4),2050,7)," ",$P(STINFO,U,5)
21 .W !?3,"FTS #: ",$P(STINFO,U,6)
22 .W !?3,"COMM #: ",$P(STINFO,U,7)
23 W !!,"Those affiliated with ",PACKNAME,":"
24 D AFFIL(PACK,.USERS)
25 S CNT=16,USER="" F S USER=$O(USERS(USER)) Q:USER="" D I 'OK Q
26 .S NUM=0 F S NUM=$O(USERS(USER,NUM)) Q:NUM<1 D I 'OK Q
27 ..W !,USER," ",USERS(USER,NUM)
28 ..S CNT=CNT+1 I CNT'<(IOSL-1) S CNT=1 D PAUSE^FSCU(.OK) I 'OK Q
29 I 'OK Q
30 D PAUSE^FSCU(.OK)
31 Q
32 ;
33AFFIL(PACK,USERS) ;
34 N DUTIES,FUNC,PACKGP,USER,USERNAME K USERS
35 S PACKGP=+$P(^FSC("PACK",PACK,0),U,2)
36 S USER=0 F S USER=$O(^FSC("SPEC","AG",PACKGP,USER)) Q:USER<.1 D
37 .I '$$ACCESS^FSCU(USER,"SPEC") Q
38 .S USERNAME=$P(^VA(200,USER,0),U)
39 .I $P($G(^FSC("SPEC",USER,20,+$O(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3) D
40 ..S DUTIES=$P($G(^FSC("SPEC",USER,20,+$O(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,2)
41 ..S FUNC=$$VALUE^FSCGET($P(^FSC("SPEC",USER,0),U,4),7105.2,4) I $L(FUNC) S FUNC="("_FUNC_")"
42 ..S USERS(USERNAME,USER)=FUNC_" "_DUTIES_" "_$$PH(USER)
43 S USER=0 F S USER=$O(^FSC("SPEC","AP",PACK,USER)) Q:USER<.1 D
44 .I '$$ACCESS^FSCU(USER,"SPEC") Q
45 .S USERNAME=$P(^VA(200,USER,0),U)
46 .S DUTIES=$P($G(^FSC("SPEC",USER,30,+$O(^FSC("SPEC","AP",PACK,USER,0)),0)),U,2)
47 .S FUNC=$$VALUE^FSCGET($P(^FSC("SPEC",USER,0),U,4),7105.2,4) I $L(FUNC) S FUNC="("_FUNC_")"
48 .S USERS(USERNAME,USER)=FUNC_" "_DUTIES_" "_$$PH(USER)
49 Q
50 ;
51NOISINFO(SITE) ; $$(site) -> contact & phone #
52 N INFO
53 S INFO=$P($G(^FSC("SITE",SITE,0)),U,6) I 'INFO Q ""
54 S INFO=$$VALUE^FSCGET(INFO,7100,2.1)
55 S INFO=INFO_" "_$S($L($P(^FSC("SITE",SITE,0),U,7)):$P(^(0),U,7),1:$P(^(0),U,8))
56 Q INFO
57 ;
58SITEINFO(SITE) ; $$(site) -> system type
59 N INFO,VALUE
60 S INFO=""
61 S VALUE=$P($G(^FSC("SITE",SITE,0)),U,16)
62 I VALUE S INFO="System: "_$$VALUE^FSCGET(VALUE,7100,2.9)
63 S VALUE=$P($G(^FSC("SITE",SITE,0)),U,13)
64 I VALUE S INFO=INFO_$S($L(INFO):", ",1:"")_"Type: "_$$VALUE^FSCGET(VALUE,7100,2.7)
65 Q INFO
66 ;
67PH(PERSON) ; $$(person) -> phone # from file 200
68 Q $P($G(^VA(200,PERSON,.13)),U,2)
69 ;
70IRMINFO(STSITE) ; $$(site) -> irm chief & phone #
71 N INFO,IRM
72 S IRM=$G(^NTS(2050,STSITE,21))
73 S INFO=$P(IRM,U)_" "_$P(IRM,U,2) I $L(INFO)=2 Q ""
74 Q INFO
75 ;
76APINFO(STSITE,PACK) ; $$(site, pack) -> adpac & phone #
77 N ADPAC,INFO,STPACK
78 S STPACK=$$STPACK(PACK) I 'STPACK Q ""
79 S ADPAC=$G(^NTS(2050,STSITE,8,STPACK,0))
80 S INFO=$P(ADPAC,U,2)_" "_$P(ADPAC,U,3) I $L(INFO)=2 Q ""
81 Q INFO
82 ;
83STSITE(SITE) ; $$(site) -> site tracking site
84 N DOMAIN,STSITE
85 S DOMAIN=+$P(^FSC("SITE",SITE,0),U,14) I 'DOMAIN Q ""
86 S DOMAIN=$$VALUE^FSCGET(DOMAIN,7105.1,9)
87 S STSITE=+$O(^NTS(2050,"AE",DOMAIN,0)) I 'STSITE Q ""
88 Q STSITE
89 ;
90STPACK(PACK) ; $$(package) -> site tracking package
91 N OPACK,STPACK
92 I '$L(PACK) Q ""
93 S OPACK=+$P($G(^FSC("PACK",PACK,0)),U,3) I 'OPACK Q ""
94 S STPACK=+$O(^DIC(120102,"AP",OPACK,0)) I 'STPACK Q ""
95 Q STPACK
Note: See TracBrowser for help on using the repository browser.