Routine: FSCRPCUD

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)

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

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

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)

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

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

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  Feb 18, 2025@23:46:19                                                                                                                                                                                                    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)

FSCRPCUD.m