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

FSCLMPOC ;SLC/STAFF-NOIS List Manager Protocol Other Contacts ;6/3/98  10:58
 ;;1.1;NOIS;;Sep 06, 1998
 ;
CONTACTS(CALL) ; from FSCLMPO
 N CONTACT,CONTPH,CNT,DEVSP,MOD,OK,PACK,PACKNAME,PIECE,SITE,SPEC,STINFO,STSITE,USER,USERS K USERS
 S OK=1
 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)
 I SPEC W !,"Specialist: ",$$VALUE^FSCGET(SPEC,7100,5),"  ",$$PH(SPEC)
 I DEVSP W !,"Referred Specialist: ",$$VALUE^FSCGET(DEVSP,7100,5.1),"  ",$$PH(DEVSP)
 W !!,"Contact: ",$$VALUE^FSCGET(CONTACT,7100,2.1),"  ",CONTPH
 W !,"NOIS contact information for this location: ",$$NOISINFO(SITE)
 I 'MOD D PAUSE^FSCU(.OK) Q
 S PACK=$P(^FSC("MOD",MOD,0),U,8),PACKNAME=$P(^FSC("PACK",PACK,0),U)
 S STSITE=$$STSITE(SITE) I STSITE D
 .W !!,"IRM Chief and phone: ",$$IRMINFO(STSITE)
 .W !,PACKNAME," ADPAC and phone: ",$$APINFO(STSITE,PACK)
 .W !,"Information on ",$P(^FSC("SITE",SITE,0),U),":"
 .S STINFO=$G(^NTS(2050,STSITE,1))
 .F PIECE=1:1:3 W !?3,$P(STINFO,U,PIECE)
 .W ", ",$$VALUE^FSCGET($P(STINFO,U,4),2050,7),"   ",$P(STINFO,U,5)
 .W !?3,"FTS #: ",$P(STINFO,U,6)
 .W !?3,"COMM #: ",$P(STINFO,U,7)
 W !!,"Those affiliated with ",PACKNAME,":"
 D AFFIL(PACK,.USERS)
 S CNT=16,USER="" F  S USER=$O(USERS(USER)) Q:USER=""  D  I 'OK Q
 .S NUM=0 F  S NUM=$O(USERS(USER,NUM)) Q:NUM<1  D  I 'OK Q
 ..W !,USER,"  ",USERS(USER,NUM)
 ..S CNT=CNT+1 I CNT'<(IOSL-1) S CNT=1 D PAUSE^FSCU(.OK) I 'OK Q
 I 'OK Q
 D PAUSE^FSCU(.OK)
 Q
 ;
AFFIL(PACK,USERS) ;
 N DUTIES,FUNC,PACKGP,USER,USERNAME K USERS
 S PACKGP=+$P(^FSC("PACK",PACK,0),U,2)
 S USER=0 F  S USER=$O(^FSC("SPEC","AG",PACKGP,USER)) Q:USER<.1  D
 .I '$$ACCESS^FSCU(USER,"SPEC") Q
 .S USERNAME=$P(^VA(200,USER,0),U)
 .I $P($G(^FSC("SPEC",USER,20,+$O(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3) D
 ..S DUTIES=$P($G(^FSC("SPEC",USER,20,+$O(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,2)
 ..S FUNC=$$VALUE^FSCGET($P(^FSC("SPEC",USER,0),U,4),7105.2,4) I $L(FUNC) S FUNC="("_FUNC_")"
 ..S USERS(USERNAME,USER)=FUNC_"    "_DUTIES_"    "_$$PH(USER)
 S USER=0 F  S USER=$O(^FSC("SPEC","AP",PACK,USER)) Q:USER<.1  D
 .I '$$ACCESS^FSCU(USER,"SPEC") Q
 .S USERNAME=$P(^VA(200,USER,0),U)
 .S DUTIES=$P($G(^FSC("SPEC",USER,30,+$O(^FSC("SPEC","AP",PACK,USER,0)),0)),U,2)
 .S FUNC=$$VALUE^FSCGET($P(^FSC("SPEC",USER,0),U,4),7105.2,4) I $L(FUNC) S FUNC="("_FUNC_")"
 .S USERS(USERNAME,USER)=FUNC_"    "_DUTIES_"    "_$$PH(USER)
 Q
 ;
NOISINFO(SITE) ; $$(site) -> contact & phone #
 N INFO
 S INFO=$P($G(^FSC("SITE",SITE,0)),U,6) I 'INFO Q ""
 S INFO=$$VALUE^FSCGET(INFO,7100,2.1)
 S INFO=INFO_"  "_$S($L($P(^FSC("SITE",SITE,0),U,7)):$P(^(0),U,7),1:$P(^(0),U,8))
 Q INFO
 ;
SITEINFO(SITE) ; $$(site) -> system type
 N INFO,VALUE
 S INFO=""
 S VALUE=$P($G(^FSC("SITE",SITE,0)),U,16)
 I VALUE S INFO="System: "_$$VALUE^FSCGET(VALUE,7100,2.9)
 S VALUE=$P($G(^FSC("SITE",SITE,0)),U,13)
 I VALUE S INFO=INFO_$S($L(INFO):", ",1:"")_"Type: "_$$VALUE^FSCGET(VALUE,7100,2.7)
 Q INFO
 ;
PH(PERSON) ; $$(person) -> phone # from file 200
 Q $P($G(^VA(200,PERSON,.13)),U,2)
 ;
IRMINFO(STSITE) ; $$(site) -> irm chief & phone #
 N INFO,IRM
 S IRM=$G(^NTS(2050,STSITE,21))
 S INFO=$P(IRM,U)_"  "_$P(IRM,U,2) I $L(INFO)=2 Q ""
 Q INFO
 ;
APINFO(STSITE,PACK) ; $$(site, pack) -> adpac & phone #
 N ADPAC,INFO,STPACK
 S STPACK=$$STPACK(PACK) I 'STPACK Q ""
 S ADPAC=$G(^NTS(2050,STSITE,8,STPACK,0))
 S INFO=$P(ADPAC,U,2)_"  "_$P(ADPAC,U,3) I $L(INFO)=2 Q ""
 Q INFO
 ;
STSITE(SITE) ; $$(site) -> site tracking site
 N DOMAIN,STSITE
 S DOMAIN=+$P(^FSC("SITE",SITE,0),U,14) I 'DOMAIN Q ""
 S DOMAIN=$$VALUE^FSCGET(DOMAIN,7105.1,9)
 S STSITE=+$O(^NTS(2050,"AE",DOMAIN,0)) I 'STSITE Q ""
 Q STSITE
 ;
STPACK(PACK) ; $$(package) -> site tracking package
 N OPACK,STPACK
 I '$L(PACK) Q ""
 S OPACK=+$P($G(^FSC("PACK",PACK,0)),U,3) I 'OPACK Q ""
 S STPACK=+$O(^DIC(120102,"AP",OPACK,0)) I 'STPACK Q ""
 Q STPACK