FSCRPCUD ;SLC/STAFF-NOIS RPC User Defaults ;4/16/98 15:18
;;1.1;NOIS;;Sep 06, 1998
;
USER(IN,OUT) ; from FSCRPX (RPCUserDefaults)
N USER
S USER=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I 'USER Q
S ^TMP("FSCRPC",$J,"OUTPUT",1)=USER_U_$P($G(^VA(200,+USER,0)),U)
Q
;
DUZ(IN,OUT) ; from FSCRPX (RPCCurrentUser)
N PFUNC,PMOD,PPRI,PSPEC,PTASK,SPEC,PREF,NAME,PHONE
S (PFUNC,PMOD,PPRI,PSPEC,PTASK)=0
S SPEC=$$ACCESS^FSCU(DUZ,"SPEC")
S PPRI=+$O(^FSC("PRI","B","ROUTINE",0))
S NAME=$P($G(^VA(200,+DUZ,0)),U),PHONE=$P($G(^(.13)),U,2)
I SPEC D
.S PREF=$$FUNC^FSCEUD(DUZ) I $P(PREF,U)'="I" D
..I $L($P(PREF,U,2)) S PFUNC=+$O(^FSC("FUNC","B",$P(PREF,U,2),0))
.S PREF=$$TASK^FSCEUD(DUZ) I $P(PREF,U)'="I" D
..I $L($P(PREF,U,2)) S PTASK=+$O(^FSC("TASK","B",$P(PREF,U,2),0))
.S PREF=$$PRIORITY^FSCEUD(DUZ) I $P(PREF,U)'="I" D
..I $L($P(PREF,U,2)) S PPRI=+$O(^FSC("PRI","B",$P(PREF,U,2),0))
.S PREF=$$MOD^FSCEUD(DUZ) I $P(PREF,U)'="I" D
..I $L($P(PREF,U,2)) S PMOD=+$O(^FSC("MOD","B",$P(PREF,U,2),0))
.S PREF=$$SPEC^FSCEUD(DUZ) I $P(PREF,U)'="I" D
..S PSPEC=DUZ
S ^TMP("FSCRPC",$J,"OUTPUT",1)=DUZ_U_NAME_U_SPEC_U_PFUNC_U_PPRI_U_PSPEC_U_PTASK_U_PMOD_U_PHONE
Q
;
DUZTEMP(IN,OUT) ; from FSCRPX (RPCUserTempFiles)
N CNT,NUM,ZERO
S CNT=0
S NUM=0 F S NUM=$O(^FSC("LIST","C",DUZ,NUM)) Q:NUM<1 S ZERO=$G(^FSC("LIST",NUM,0)) I $L(ZERO) D
.I $P(ZERO,U,3)'="S" Q
.S CNT=CNT+1
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=NUM_U_ZERO
Q
;
NEWTEMP(IN,OUT) ; from FSCRPX (RPCNewTempList)
N CNT,DA,DIC,DIE,DLAYGO,DR,LISTNAME,NEWNAME,X,Y K DIC,DLAYGO
S LISTNAME="TEMP-"_$P($P(^VA(200,DUZ,0),U),",")
S LISTNAME=$E(LISTNAME,1,28)
S NEWNAME=LISTNAME
S CNT=0
F Q:'$O(^FSC("LIST","B",NEWNAME,0)) S CNT=CNT+1,NEWNAME=LISTNAME_CNT
S (DIC,DLAYGO)=7107.1,DIC(0)="XL",X=NEWNAME
D ^DIC K DIC,DLAYGO
I '$P(Y,U,3) Q
S DA=+Y,DIE=7107.1,DR="1///`"_DUZ_";2///S"
D ^DIE
S ^TMP("FSCRPC",$J,"OUTPUT",1)=DA_U_^FSC("LIST",DA,0)
Q
;
CONTACT(IN,OUT) ; from FSCRPX (RPCContact)
N CONTACT,PHONE,SITE
S SITE=+$G(^TMP("FSCRPC",$J,"INPUT",1))
S CONTACT=+$P($G(^FSC("SITE",SITE,0)),U,6)
S PHONE=$$PH(SITE,CONTACT)
I 'CONTACT,'$L(PHONE) Q
S ^TMP("FSCRPC",$J,"OUTPUT",1)=CONTACT_U_PHONE
Q
;
PHONE(IN,OUT) ; from FSCRPX (RPCPhone)
N PHONE,SITE,USER
S SITE=$P($G(^TMP("FSCRPC",$J,"INPUT",1)),U),USER=$P($G(^(1)),U,2)
S PHONE=$$PH(SITE,USER)
S ^TMP("FSCRPC",$J,"OUTPUT",1)=PHONE
Q
;
PH(SITE,USER) ; $$(site,user) -> phone #
N PHONE S PHONE=""
I USER S PHONE=$P($G(^VA(200,USER,.13)),U,2)
I $L(PHONE) Q PHONE
I 'SITE Q ""
S PHONE=$P($G(^FSC("SITE",SITE,0)),U,7)
I $L(PHONE) Q PHONE
Q $P($G(^FSC("SITE",SITE,0)),U,8)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCUD 2679 printed Apr 09, 2024@21:23:39 Page 2
FSCRPCUD ;SLC/STAFF-NOIS RPC User Defaults ;4/16/98 15:18
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
USER(IN,OUT) ; from FSCRPX (RPCUserDefaults)
+1 NEW USER
+2 SET USER=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF 'USER
QUIT
+4 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=USER_U_$PIECE($GET(^VA(200,+USER,0)),U)
+5 QUIT
+6 ;
DUZ(IN,OUT) ; from FSCRPX (RPCCurrentUser)
+1 NEW PFUNC,PMOD,PPRI,PSPEC,PTASK,SPEC,PREF,NAME,PHONE
+2 SET (PFUNC,PMOD,PPRI,PSPEC,PTASK)=0
+3 SET SPEC=$$ACCESS^FSCU(DUZ,"SPEC")
+4 SET PPRI=+$ORDER(^FSC("PRI","B","ROUTINE",0))
+5 SET NAME=$PIECE($GET(^VA(200,+DUZ,0)),U)
SET PHONE=$PIECE($GET(^(.13)),U,2)
+6 IF SPEC
Begin DoDot:1
+7 SET PREF=$$FUNC^FSCEUD(DUZ)
IF $PIECE(PREF,U)'="I"
Begin DoDot:2
+8 IF $LENGTH($PIECE(PREF,U,2))
SET PFUNC=+$ORDER(^FSC("FUNC","B",$PIECE(PREF,U,2),0))
End DoDot:2
+9 SET PREF=$$TASK^FSCEUD(DUZ)
IF $PIECE(PREF,U)'="I"
Begin DoDot:2
+10 IF $LENGTH($PIECE(PREF,U,2))
SET PTASK=+$ORDER(^FSC("TASK","B",$PIECE(PREF,U,2),0))
End DoDot:2
+11 SET PREF=$$PRIORITY^FSCEUD(DUZ)
IF $PIECE(PREF,U)'="I"
Begin DoDot:2
+12 IF $LENGTH($PIECE(PREF,U,2))
SET PPRI=+$ORDER(^FSC("PRI","B",$PIECE(PREF,U,2),0))
End DoDot:2
+13 SET PREF=$$MOD^FSCEUD(DUZ)
IF $PIECE(PREF,U)'="I"
Begin DoDot:2
+14 IF $LENGTH($PIECE(PREF,U,2))
SET PMOD=+$ORDER(^FSC("MOD","B",$PIECE(PREF,U,2),0))
End DoDot:2
+15 SET PREF=$$SPEC^FSCEUD(DUZ)
IF $PIECE(PREF,U)'="I"
Begin DoDot:2
+16 SET PSPEC=DUZ
End DoDot:2
End DoDot:1
+17 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=DUZ_U_NAME_U_SPEC_U_PFUNC_U_PPRI_U_PSPEC_U_PTASK_U_PMOD_U_PHONE
+18 QUIT
+19 ;
DUZTEMP(IN,OUT) ; from FSCRPX (RPCUserTempFiles)
+1 NEW CNT,NUM,ZERO
+2 SET CNT=0
+3 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("LIST","C",DUZ,NUM))
if NUM<1
QUIT
SET ZERO=$GET(^FSC("LIST",NUM,0))
IF $LENGTH(ZERO)
Begin DoDot:1
+4 IF $PIECE(ZERO,U,3)'="S"
QUIT
+5 SET CNT=CNT+1
+6 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=NUM_U_ZERO
End DoDot:1
+7 QUIT
+8 ;
NEWTEMP(IN,OUT) ; from FSCRPX (RPCNewTempList)
+1 NEW CNT,DA,DIC,DIE,DLAYGO,DR,LISTNAME,NEWNAME,X,Y
KILL DIC,DLAYGO
+2 SET LISTNAME="TEMP-"_$PIECE($PIECE(^VA(200,DUZ,0),U),",")
+3 SET LISTNAME=$EXTRACT(LISTNAME,1,28)
+4 SET NEWNAME=LISTNAME
+5 SET CNT=0
+6 FOR
if '$ORDER(^FSC("LIST","B",NEWNAME,0))
QUIT
SET CNT=CNT+1
SET NEWNAME=LISTNAME_CNT
+7 SET (DIC,DLAYGO)=7107.1
SET DIC(0)="XL"
SET X=NEWNAME
+8 DO ^DIC
KILL DIC,DLAYGO
+9 IF '$PIECE(Y,U,3)
QUIT
+10 SET DA=+Y
SET DIE=7107.1
SET DR="1///`"_DUZ_";2///S"
+11 DO ^DIE
+12 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=DA_U_^FSC("LIST",DA,0)
+13 QUIT
+14 ;
CONTACT(IN,OUT) ; from FSCRPX (RPCContact)
+1 NEW CONTACT,PHONE,SITE
+2 SET SITE=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 SET CONTACT=+$PIECE($GET(^FSC("SITE",SITE,0)),U,6)
+4 SET PHONE=$$PH(SITE,CONTACT)
+5 IF 'CONTACT
IF '$LENGTH(PHONE)
QUIT
+6 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=CONTACT_U_PHONE
+7 QUIT
+8 ;
PHONE(IN,OUT) ; from FSCRPX (RPCPhone)
+1 NEW PHONE,SITE,USER
+2 SET SITE=$PIECE($GET(^TMP("FSCRPC",$JOB,"INPUT",1)),U)
SET USER=$PIECE($GET(^(1)),U,2)
+3 SET PHONE=$$PH(SITE,USER)
+4 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=PHONE
+5 QUIT
+6 ;
PH(SITE,USER) ; $$(site,user) -> phone #
+1 NEW PHONE
SET PHONE=""
+2 IF USER
SET PHONE=$PIECE($GET(^VA(200,USER,.13)),U,2)
+3 IF $LENGTH(PHONE)
QUIT PHONE
+4 IF 'SITE
QUIT ""
+5 SET PHONE=$PIECE($GET(^FSC("SITE",SITE,0)),U,7)
+6 IF $LENGTH(PHONE)
QUIT PHONE
+7 QUIT $PIECE($GET(^FSC("SITE",SITE,0)),U,8)
