FSCRPCGN ;SLC/STAFF-NOIS RPC Package Info ;1/11/98 15:24
;;1.1;NOIS;;Sep 06, 1998
;
SPEC(SPEC) ; from FSCRPCG
N CNT,PHONE
S CNT=0
S PHONE=$$PH(SPEC)
I $L(PHONE) S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Office Phone: "_PHONE
D MAILINFO(.CNT,SPEC)
D NOIS(.CNT,SPEC)
Q
;
CONTACT(PERSON) ; from FSCRPCG
N CNT,PHONE
S CNT=0
S PHONE=$$PH(PERSON)
I $L(PHONE) S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Office Phone: "_PHONE
D MAILINFO(.CNT,PERSON)
D NOIS(.CNT,PERSON)
Q
;
MAILINFO(CNT,USER) ;
N LINE,NUM
I '$O(^XMB(3.7,+$G(USER),1,0)) Q
S CNT=+$G(CNT)
S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=""
S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="MailMan Introduction:"
S NUM=0 F S NUM=$O(^XMB(3.7,USER,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
.S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
Q
;
NOIS(CNT,USER) ;
N FUNC,LINE,NUM,OFFICE,WORKSAT,ZERO
S ZERO=$G(^FSC("SPEC",+$G(USER),0)) I '$L(ZERO) Q
S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=""
I '$P(ZERO,U,2) D
.S FUNC=$$VALUE^FSCGET($P(ZERO,U,4),7105.2,4)
.S WORKSAT=$$VALUE^FSCGET($P(ZERO,U,3),7105.2,3)
.S OFFICE=$$VALUE^FSCGET($P(ZERO,U,16),7105.2,3.5)
.I $L(FUNC) S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Primary Functional Area: "_FUNC
.S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Office: "_OFFICE_" Works at: "_WORKSAT
I $O(^FSC("SPEC",USER,20,0)) D
.S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Group Affiliations:"
S NUM=0 F S NUM=$O(^FSC("SPEC",USER,20,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
.S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=" "_$$VALUE^FSCGET($P(LINE,U),7100,3.3)_" "_$P(LINE,U,2)
I $O(^FSC("SPEC",USER,30,0)) D
.S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)="Package Affiliations:"
S NUM=0 F S NUM=$O(^FSC("SPEC",USER,30,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
.S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=" "_$$VALUE^FSCGET($P(LINE,U),7100,3.1)_" "_$P(LINE,U,2)
Q
;
MOD(MOD) ;
N ADPAC,NUM,OUTCNT,PACK,PACKNAME,SITE,SITENAME,STSITE,USER,USERS K USERS
S PACK=+$P($G(^FSC("MOD",+MOD,0)),U,8)
I 'PACK Q
S PACKNAME=$P(^FSC("PACK",PACK,0),U)
S OUTCNT=0
S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)="Those affiliated with "_PACKNAME_":"
D AFFIL(PACK,.USERS)
S USER="" F S USER=$O(USERS(USER)) Q:USER="" D
.S NUM=0 F S NUM=$O(USERS(USER,NUM)) Q:NUM<1 D
..S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)=USER_" "_USERS(USER,NUM)
S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)=""
S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)="ADPACs:"
S SITENAME="" F S SITENAME=$O(^FSC("SITE","B",SITENAME)) Q:SITENAME="" D
.S SITE=0 F S SITE=$O(^FSC("SITE","B",SITENAME,SITE)) Q:SITE<1 D
..S STSITE=$$STSITE(SITE)
..I 'STSITE Q
..S ADPAC=$$APINFO(STSITE,PACK)
..I $L(ADPAC) S OUTCNT=OUTCNT+1,^TMP("FSCRPC",$J,"OUTPUT",OUTCNT)=" "_SITENAME_" "_ADPAC
K USERS
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
.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
.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
;
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
S OPACK=+$P($G(^FSC("PACK",+$G(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[HFSCRPCGN 4937 printed Dec 13, 2024@02:19:26 Page 2
FSCRPCGN ;SLC/STAFF-NOIS RPC Package Info ;1/11/98 15:24
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
SPEC(SPEC) ; from FSCRPCG
+1 NEW CNT,PHONE
+2 SET CNT=0
+3 SET PHONE=$$PH(SPEC)
+4 IF $LENGTH(PHONE)
SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)="Office Phone: "_PHONE
+5 DO MAILINFO(.CNT,SPEC)
+6 DO NOIS(.CNT,SPEC)
+7 QUIT
+8 ;
CONTACT(PERSON) ; from FSCRPCG
+1 NEW CNT,PHONE
+2 SET CNT=0
+3 SET PHONE=$$PH(PERSON)
+4 IF $LENGTH(PHONE)
SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)="Office Phone: "_PHONE
+5 DO MAILINFO(.CNT,PERSON)
+6 DO NOIS(.CNT,PERSON)
+7 QUIT
+8 ;
MAILINFO(CNT,USER) ;
+1 NEW LINE,NUM
+2 IF '$ORDER(^XMB(3.7,+$GET(USER),1,0))
QUIT
+3 SET CNT=+$GET(CNT)
+4 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=""
+5 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)="MailMan Introduction:"
+6 SET NUM=0
FOR
SET NUM=$ORDER(^XMB(3.7,USER,1,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:1
+7 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
End DoDot:1
+8 QUIT
+9 ;
NOIS(CNT,USER) ;
+1 NEW FUNC,LINE,NUM,OFFICE,WORKSAT,ZERO
+2 SET ZERO=$GET(^FSC("SPEC",+$GET(USER),0))
IF '$LENGTH(ZERO)
QUIT
+3 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=""
+4 IF '$PIECE(ZERO,U,2)
Begin DoDot:1
+5 SET FUNC=$$VALUE^FSCGET($PIECE(ZERO,U,4),7105.2,4)
+6 SET WORKSAT=$$VALUE^FSCGET($PIECE(ZERO,U,3),7105.2,3)
+7 SET OFFICE=$$VALUE^FSCGET($PIECE(ZERO,U,16),7105.2,3.5)
+8 IF $LENGTH(FUNC)
SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)="Primary Functional Area: "_FUNC
+9 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)="Office: "_OFFICE_" Works at: "_WORKSAT
End DoDot:1
+10 IF $ORDER(^FSC("SPEC",USER,20,0))
Begin DoDot:1
+11 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)="Group Affiliations:"
End DoDot:1
+12 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,20,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:1
+13 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=" "_$$VALUE^FSCGET($PIECE(LINE,U),7100,3.3)_" "_$PIECE(LINE,U,2)
End DoDot:1
+14 IF $ORDER(^FSC("SPEC",USER,30,0))
Begin DoDot:1
+15 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)="Package Affiliations:"
End DoDot:1
+16 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,30,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:1
+17 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=" "_$$VALUE^FSCGET($PIECE(LINE,U),7100,3.1)_" "_$PIECE(LINE,U,2)
End DoDot:1
+18 QUIT
+19 ;
MOD(MOD) ;
+1 NEW ADPAC,NUM,OUTCNT,PACK,PACKNAME,SITE,SITENAME,STSITE,USER,USERS
KILL USERS
+2 SET PACK=+$PIECE($GET(^FSC("MOD",+MOD,0)),U,8)
+3 IF 'PACK
QUIT
+4 SET PACKNAME=$PIECE(^FSC("PACK",PACK,0),U)
+5 SET OUTCNT=0
+6 SET OUTCNT=OUTCNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",OUTCNT)="Those affiliated with "_PACKNAME_":"
+7 DO AFFIL(PACK,.USERS)
+8 SET USER=""
FOR
SET USER=$ORDER(USERS(USER))
if USER=""
QUIT
Begin DoDot:1
+9 SET NUM=0
FOR
SET NUM=$ORDER(USERS(USER,NUM))
if NUM<1
QUIT
Begin DoDot:2
+10 SET OUTCNT=OUTCNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",OUTCNT)=USER_" "_USERS(USER,NUM)
End DoDot:2
End DoDot:1
+11 SET OUTCNT=OUTCNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",OUTCNT)=""
+12 SET OUTCNT=OUTCNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",OUTCNT)="ADPACs:"
+13 SET SITENAME=""
FOR
SET SITENAME=$ORDER(^FSC("SITE","B",SITENAME))
if SITENAME=""
QUIT
Begin DoDot:1
+14 SET SITE=0
FOR
SET SITE=$ORDER(^FSC("SITE","B",SITENAME,SITE))
if SITE<1
QUIT
Begin DoDot:2
+15 SET STSITE=$$STSITE(SITE)
+16 IF 'STSITE
QUIT
+17 SET ADPAC=$$APINFO(STSITE,PACK)
+18 IF $LENGTH(ADPAC)
SET OUTCNT=OUTCNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",OUTCNT)=" "_SITENAME_" "_ADPAC
End DoDot:2
End DoDot:1
+19 KILL USERS
+20 QUIT
+21 ;
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 SET USERNAME=$PIECE(^VA(200,USER,0),U)
+5 IF $PIECE($GET(^FSC("SPEC",USER,20,+$ORDER(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3)
Begin DoDot:2
+6 SET DUTIES=$PIECE($GET(^FSC("SPEC",USER,20,+$ORDER(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,2)
+7 SET FUNC=$$VALUE^FSCGET($PIECE(^FSC("SPEC",USER,0),U,4),7105.2,4)
IF $LENGTH(FUNC)
SET FUNC="("_FUNC_")"
+8 SET USERS(USERNAME,USER)=FUNC_" "_DUTIES_" "_$$PH(USER)
End DoDot:2
End DoDot:1
+9 SET USER=0
FOR
SET USER=$ORDER(^FSC("SPEC","AP",PACK,USER))
if USER<.1
QUIT
Begin DoDot:1
+10 SET USERNAME=$PIECE(^VA(200,USER,0),U)
+11 SET DUTIES=$PIECE($GET(^FSC("SPEC",USER,30,+$ORDER(^FSC("SPEC","AP",PACK,USER,0)),0)),U,2)
+12 SET FUNC=$$VALUE^FSCGET($PIECE(^FSC("SPEC",USER,0),U,4),7105.2,4)
IF $LENGTH(FUNC)
SET FUNC="("_FUNC_")"
+13 SET USERS(USERNAME,USER)=FUNC_" "_DUTIES_" "_$$PH(USER)
End DoDot:1
+14 QUIT
+15 ;
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 ;
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 SET OPACK=+$PIECE($GET(^FSC("PACK",+$GET(PACK),0)),U,3)
IF 'OPACK
QUIT ""
+3 SET STPACK=+$ORDER(^DIC(120102,"AP",OPACK,0))
IF 'STPACK
QUIT ""
+4 QUIT STPACK
