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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPOC 3972 printed Dec 13, 2024@02:18:26 Page 2
FSCLMPOC ;SLC/STAFF-NOIS List Manager Protocol Other Contacts ;6/3/98 10:58
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
CONTACTS(CALL) ; from FSCLMPO
+1 NEW CONTACT,CONTPH,CNT,DEVSP,MOD,OK,PACK,PACKNAME,PIECE,SITE,SPEC,STINFO,STSITE,USER,USERS
KILL USERS
+2 SET OK=1
+3 SET SITE=$PIECE(^FSCD("CALL",CALL,0),U,5)
SET CONTACT=$PIECE(^(0),U,6)
SET CONTPH=$PIECE(^(0),U,7)
SET MOD=$PIECE(^(0),U,8)
SET SPEC=$PIECE(^(0),U,9)
SET DEVSP=$PIECE(^(0),U,21)
+4 IF SPEC
WRITE !,"Specialist: ",$$VALUE^FSCGET(SPEC,7100,5)," ",$$PH(SPEC)
+5 IF DEVSP
WRITE !,"Referred Specialist: ",$$VALUE^FSCGET(DEVSP,7100,5.1)," ",$$PH(DEVSP)
+6 WRITE !!,"Contact: ",$$VALUE^FSCGET(CONTACT,7100,2.1)," ",CONTPH
+7 WRITE !,"NOIS contact information for this location: ",$$NOISINFO(SITE)
+8 IF 'MOD
DO PAUSE^FSCU(.OK)
QUIT
+9 SET PACK=$PIECE(^FSC("MOD",MOD,0),U,8)
SET PACKNAME=$PIECE(^FSC("PACK",PACK,0),U)
+10 SET STSITE=$$STSITE(SITE)
IF STSITE
Begin DoDot:1
+11 WRITE !!,"IRM Chief and phone: ",$$IRMINFO(STSITE)
+12 WRITE !,PACKNAME," ADPAC and phone: ",$$APINFO(STSITE,PACK)
+13 WRITE !,"Information on ",$PIECE(^FSC("SITE",SITE,0),U),":"
+14 SET STINFO=$GET(^NTS(2050,STSITE,1))
+15 FOR PIECE=1:1:3
WRITE !?3,$PIECE(STINFO,U,PIECE)
+16 WRITE ", ",$$VALUE^FSCGET($PIECE(STINFO,U,4),2050,7)," ",$PIECE(STINFO,U,5)
+17 WRITE !?3,"FTS #: ",$PIECE(STINFO,U,6)
+18 WRITE !?3,"COMM #: ",$PIECE(STINFO,U,7)
End DoDot:1
+19 WRITE !!,"Those affiliated with ",PACKNAME,":"
+20 DO AFFIL(PACK,.USERS)
+21 SET CNT=16
SET USER=""
FOR
SET USER=$ORDER(USERS(USER))
if USER=""
QUIT
Begin DoDot:1
+22 SET NUM=0
FOR
SET NUM=$ORDER(USERS(USER,NUM))
if NUM<1
QUIT
Begin DoDot:2
+23 WRITE !,USER," ",USERS(USER,NUM)
+24 SET CNT=CNT+1
IF CNT'<(IOSL-1)
SET CNT=1
DO PAUSE^FSCU(.OK)
IF 'OK
QUIT
End DoDot:2
IF 'OK
QUIT
End DoDot:1
IF 'OK
QUIT
+25 IF 'OK
QUIT
+26 DO PAUSE^FSCU(.OK)
+27 QUIT
+28 ;
AFFIL(PACK,USERS) ;
+1 NEW DUTIES,FUNC,PACKGP,USER,USERNAME
KILL USERS
+2 SET PACKGP=+$PIECE(^FSC("PACK",PACK,0),U,2)
+3 SET USER=0
FOR
SET USER=$ORDER(^FSC("SPEC","AG",PACKGP,USER))
if USER<.1
QUIT
Begin DoDot:1
+4 IF '$$ACCESS^FSCU(USER,"SPEC")
QUIT
+5 SET USERNAME=$PIECE(^VA(200,USER,0),U)
+6 IF $PIECE($GET(^FSC("SPEC",USER,20,+$ORDER(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3)
Begin DoDot:2
+7 SET DUTIES=$PIECE($GET(^FSC("SPEC",USER,20,+$ORDER(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,2)
+8 SET FUNC=$$VALUE^FSCGET($PIECE(^FSC("SPEC",USER,0),U,4),7105.2,4)
IF $LENGTH(FUNC)
SET FUNC="("_FUNC_")"
+9 SET USERS(USERNAME,USER)=FUNC_" "_DUTIES_" "_$$PH(USER)
End DoDot:2
End DoDot:1
+10 SET USER=0
FOR
SET USER=$ORDER(^FSC("SPEC","AP",PACK,USER))
if USER<.1
QUIT
Begin DoDot:1
+11 IF '$$ACCESS^FSCU(USER,"SPEC")
QUIT
+12 SET USERNAME=$PIECE(^VA(200,USER,0),U)
+13 SET DUTIES=$PIECE($GET(^FSC("SPEC",USER,30,+$ORDER(^FSC("SPEC","AP",PACK,USER,0)),0)),U,2)
+14 SET FUNC=$$VALUE^FSCGET($PIECE(^FSC("SPEC",USER,0),U,4),7105.2,4)
IF $LENGTH(FUNC)
SET FUNC="("_FUNC_")"
+15 SET USERS(USERNAME,USER)=FUNC_" "_DUTIES_" "_$$PH(USER)
End DoDot:1
+16 QUIT
+17 ;
NOISINFO(SITE) ; $$(site) -> contact & phone #
+1 NEW INFO
+2 SET INFO=$PIECE($GET(^FSC("SITE",SITE,0)),U,6)
IF 'INFO
QUIT ""
+3 SET INFO=$$VALUE^FSCGET(INFO,7100,2.1)
+4 SET INFO=INFO_" "_$SELECT($LENGTH($PIECE(^FSC("SITE",SITE,0),U,7)):$PIECE(^(0),U,7),1:$PIECE(^(0),U,8))
+5 QUIT INFO
+6 ;
SITEINFO(SITE) ; $$(site) -> system type
+1 NEW INFO,VALUE
+2 SET INFO=""
+3 SET VALUE=$PIECE($GET(^FSC("SITE",SITE,0)),U,16)
+4 IF VALUE
SET INFO="System: "_$$VALUE^FSCGET(VALUE,7100,2.9)
+5 SET VALUE=$PIECE($GET(^FSC("SITE",SITE,0)),U,13)
+6 IF VALUE
SET INFO=INFO_$SELECT($LENGTH(INFO):", ",1:"")_"Type: "_$$VALUE^FSCGET(VALUE,7100,2.7)
+7 QUIT INFO
+8 ;
PH(PERSON) ; $$(person) -> phone # from file 200
+1 QUIT $PIECE($GET(^VA(200,PERSON,.13)),U,2)
+2 ;
IRMINFO(STSITE) ; $$(site) -> irm chief & phone #
+1 NEW INFO,IRM
+2 SET IRM=$GET(^NTS(2050,STSITE,21))
+3 SET INFO=$PIECE(IRM,U)_" "_$PIECE(IRM,U,2)
IF $LENGTH(INFO)=2
QUIT ""
+4 QUIT INFO
+5 ;
APINFO(STSITE,PACK) ; $$(site, pack) -> adpac & phone #
+1 NEW ADPAC,INFO,STPACK
+2 SET STPACK=$$STPACK(PACK)
IF 'STPACK
QUIT ""
+3 SET ADPAC=$GET(^NTS(2050,STSITE,8,STPACK,0))
+4 SET INFO=$PIECE(ADPAC,U,2)_" "_$PIECE(ADPAC,U,3)
IF $LENGTH(INFO)=2
QUIT ""
+5 QUIT INFO
+6 ;
STSITE(SITE) ; $$(site) -> site tracking site
+1 NEW DOMAIN,STSITE
+2 SET DOMAIN=+$PIECE(^FSC("SITE",SITE,0),U,14)
IF 'DOMAIN
QUIT ""
+3 SET DOMAIN=$$VALUE^FSCGET(DOMAIN,7105.1,9)
+4 SET STSITE=+$ORDER(^NTS(2050,"AE",DOMAIN,0))
IF 'STSITE
QUIT ""
+5 QUIT STSITE
+6 ;
STPACK(PACK) ; $$(package) -> site tracking package
+1 NEW OPACK,STPACK
+2 IF '$LENGTH(PACK)
QUIT ""
+3 SET OPACK=+$PIECE($GET(^FSC("PACK",PACK,0)),U,3)
IF 'OPACK
QUIT ""
+4 SET STPACK=+$ORDER(^DIC(120102,"AP",OPACK,0))
IF 'STPACK
QUIT ""
+5 QUIT STPACK
