FSCRPXU ;SLC/STAFF-NOIS RPC Process Utility ;8/8/98 00:39
;;1.1;NOIS;;Sep 06, 1998
;
USERS ; display users
N USER,VERSION,CNT,NCNT
S CNT=0,NCNT=0
S USER=0 F S USER=$O(^XTMP("FSCRPC","<VERSION>",USER)) Q:USER<1 S VERSION=^(USER) D
.W !,USER,?10,VERSION,?20 W:$$ACCESS^FSCU(USER,"SPEC") "* " W $P($G(^VA(200,USER,0)),U)
.S CNT=CNT+1 I '$L(VERSION) S NCNT=NCNT+1
W !,CNT," ",NCNT
Q
;
TODAY ; display todays users
N TIME,USER
S TIME="" F S TIME=$O(^XTMP("FSCRPC","<STARTUP>",TIME)) Q:TIME="" D
.I -TIME<DT Q ;(DT-1) Q
.S USER=0 F S USER=$O(^XTMP("FSCRPC","<STARTUP>",TIME,USER)) Q:USER<1 D
..W !,$$FMTE^XLFDT(-TIME) W:$$ACCESS^FSCU(USER,"SPEC") ?25,"*",$E($P($G(^FSC("SPEC",USER,0)),U,4)) W ?30,$P($G(^VA(200,USER,0)),U)
..W ?50,$G(^XTMP("FSCRPC","<VERSION>",USER))
..W ?60,$P($G(^DIC(4,+$P($G(^VA(200,USER,120000)),U,2),0)),U)
Q
;
DAYS ;
N CNT,DAY,TIME,USER K ^TMP($J)
S TIME="" F S TIME=$O(^XTMP("FSCRPC","<STARTUP>",TIME)) Q:TIME="" D
.;I -TIME<DT Q
.S DAY=-TIME\1
.S USER=0 F S USER=$O(^XTMP("FSCRPC","<STARTUP>",TIME,USER)) Q:USER<1 D
..S ^TMP($J,DAY,USER)=""
S DAY=0 F S DAY=$O(^TMP($J,DAY)) Q:DAY<1 D
.W !,DAY
.S CNT=0
.S USER=0 F S USER=$O(^TMP($J,DAY,USER)) Q:USER<1 S CNT=CNT+1
.W ?20,CNT
K ^TMP($J)
Q
;
PROF ;
N CNT,RTN,USER
S DIC=200,DIC(0)="AEMOQZ",DIC("A")="User: "
D ^DIC I Y<1 Q
S USER=+Y
S RTN="" F S RTN=$O(^XTMP("FSCRPC","ZZUSER",USER,RTN)) Q:RTN="" S CNT=+^(RTN) D
.W !,RTN,?20,CNT
Q
;
ROU ;
N CNT,RTN,TCNT,USER K ^TMP("FSCTEST",$J)
W !,"Enter routine: " R X:30 I $L(X)'>6 Q
S RTN=X
S USER=0 F S USER=$O(^XTMP("FSCRPC","ZZUSER",USER)) Q:USER<1 D
.S CNT=+$G(^XTMP("FSCRPC","ZZUSER",USER,RTN)) I 'CNT Q
.S NAME=$P(^VA(200,+USER,0),U) I $$ACCESS^FSCU(+USER,"SPEC") S NAME="* "_NAME
.S ^TMP("FSCTEST",$J,CNT,NAME,USER)=""
S CNT=0 F S CNT=$O(^TMP("FSCTEST",$J,CNT)) Q:CNT<1 D
.S NAME="" F S NAME=$O(^TMP("FSCTEST",$J,CNT,NAME)) Q:NAME="" D
..S USER=0 F S USER=$O(^TMP("FSCTEST",$J,CNT,NAME,USER)) Q:USER<1 D
...W !,CNT,?10,NAME
K ^TMP("FSCTEST",$J)
Q
;
RTN ;
N CNT,RTN K ^TMP("FSCRPC",$J)
S RTN="" F S RTN=$O(^XTMP("FSCRPC",RTN)) Q:RTN="" D
.I RTN=0 Q
.I RTN="<STARTUP>" Q
.I RTN="<VERSION>" Q
.I RTN="ZZUSER" Q
.S CNT=+^XTMP("FSCRPC",RTN)
.S ^TMP("FSCRPC",$J,CNT,RTN)=""
S CNT="" F S CNT=$O(^TMP("FSCRPC",$J,CNT)) Q:CNT="" D
.S RTN="" F S RTN=$O(^TMP("FSCRPC",$J,CNT,RTN)) Q:RTN="" D
..W !,CNT,?10,RTN
K ^TMP("FSCRPC",$J)
Q
EPTYPE ;
K ^FSCD("CALL","AET")
S CNT=0
S CALL=0 F S CALL=$O(^FSCD("CALL",CALL)) Q:CALL<1 S NODE=$G(^(CALL,120)) D
.S EPTYPE=$P(NODE,U,21)
.I 'EPTYPE W !,CALL Q
.S CNT=CNT+1
.I CNT#1000=0 W !,"*",CNT
.I EPTYPE=1 S EPTYPE=3
.S $P(^FSCD("CALL",CALL,120),U,21)=EPTYPE
.S ^FSCD("CALL","AET",EPTYPE,CALL)=""
Q
TEST ;
S CALL=60000 F S CALL=$O(^FSCD("STATUS HIST","B",CALL)) Q:CALL<1 D
.S COUNT=0
.S NUM=0 F S NUM=$O(^FSCD("STATUS HIST","B",CALL,NUM)) Q:NUM<1 D
..S ZERO=$G(^FSCD("STATUS HIST",NUM,0)) I '$L(ZERO) Q
..I $P(ZERO,U,4)=1,$P(ZERO,U,5)="" S COUNT=COUNT+1
.I COUNT>1 W !,CALL," ",COUNT," ",$P(^FSCD("CALL",CALL,0),U)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPXU 3181 printed Nov 22, 2024@17:30:05 Page 2
FSCRPXU ;SLC/STAFF-NOIS RPC Process Utility ;8/8/98 00:39
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
USERS ; display users
+1 NEW USER,VERSION,CNT,NCNT
+2 SET CNT=0
SET NCNT=0
+3 SET USER=0
FOR
SET USER=$ORDER(^XTMP("FSCRPC","<VERSION>",USER))
if USER<1
QUIT
SET VERSION=^(USER)
Begin DoDot:1
+4 WRITE !,USER,?10,VERSION,?20
if $$ACCESS^FSCU(USER,"SPEC")
WRITE "* "
WRITE $PIECE($GET(^VA(200,USER,0)),U)
+5 SET CNT=CNT+1
IF '$LENGTH(VERSION)
SET NCNT=NCNT+1
End DoDot:1
+6 WRITE !,CNT," ",NCNT
+7 QUIT
+8 ;
TODAY ; display todays users
+1 NEW TIME,USER
+2 SET TIME=""
FOR
SET TIME=$ORDER(^XTMP("FSCRPC","<STARTUP>",TIME))
if TIME=""
QUIT
Begin DoDot:1
+3 ;(DT-1) Q
IF -TIME<DT
QUIT
+4 SET USER=0
FOR
SET USER=$ORDER(^XTMP("FSCRPC","<STARTUP>",TIME,USER))
if USER<1
QUIT
Begin DoDot:2
+5 WRITE !,$$FMTE^XLFDT(-TIME)
if $$ACCESS^FSCU(USER,"SPEC")
WRITE ?25,"*",$EXTRACT($PIECE($GET(^FSC("SPEC",USER,0)),U,4))
WRITE ?30,$PIECE($GET(^VA(200,USER,0)),U)
+6 WRITE ?50,$GET(^XTMP("FSCRPC","<VERSION>",USER))
+7 WRITE ?60,$PIECE($GET(^DIC(4,+$PIECE($GET(^VA(200,USER,120000)),U,2),0)),U)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
DAYS ;
+1 NEW CNT,DAY,TIME,USER
KILL ^TMP($JOB)
+2 SET TIME=""
FOR
SET TIME=$ORDER(^XTMP("FSCRPC","<STARTUP>",TIME))
if TIME=""
QUIT
Begin DoDot:1
+3 ;I -TIME<DT Q
+4 SET DAY=-TIME\1
+5 SET USER=0
FOR
SET USER=$ORDER(^XTMP("FSCRPC","<STARTUP>",TIME,USER))
if USER<1
QUIT
Begin DoDot:2
+6 SET ^TMP($JOB,DAY,USER)=""
End DoDot:2
End DoDot:1
+7 SET DAY=0
FOR
SET DAY=$ORDER(^TMP($JOB,DAY))
if DAY<1
QUIT
Begin DoDot:1
+8 WRITE !,DAY
+9 SET CNT=0
+10 SET USER=0
FOR
SET USER=$ORDER(^TMP($JOB,DAY,USER))
if USER<1
QUIT
SET CNT=CNT+1
+11 WRITE ?20,CNT
End DoDot:1
+12 KILL ^TMP($JOB)
+13 QUIT
+14 ;
PROF ;
+1 NEW CNT,RTN,USER
+2 SET DIC=200
SET DIC(0)="AEMOQZ"
SET DIC("A")="User: "
+3 DO ^DIC
IF Y<1
QUIT
+4 SET USER=+Y
+5 SET RTN=""
FOR
SET RTN=$ORDER(^XTMP("FSCRPC","ZZUSER",USER,RTN))
if RTN=""
QUIT
SET CNT=+^(RTN)
Begin DoDot:1
+6 WRITE !,RTN,?20,CNT
End DoDot:1
+7 QUIT
+8 ;
ROU ;
+1 NEW CNT,RTN,TCNT,USER
KILL ^TMP("FSCTEST",$JOB)
+2 WRITE !,"Enter routine: "
READ X:30
IF $LENGTH(X)'>6
QUIT
+3 SET RTN=X
+4 SET USER=0
FOR
SET USER=$ORDER(^XTMP("FSCRPC","ZZUSER",USER))
if USER<1
QUIT
Begin DoDot:1
+5 SET CNT=+$GET(^XTMP("FSCRPC","ZZUSER",USER,RTN))
IF 'CNT
QUIT
+6 SET NAME=$PIECE(^VA(200,+USER,0),U)
IF $$ACCESS^FSCU(+USER,"SPEC")
SET NAME="* "_NAME
+7 SET ^TMP("FSCTEST",$JOB,CNT,NAME,USER)=""
End DoDot:1
+8 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("FSCTEST",$JOB,CNT))
if CNT<1
QUIT
Begin DoDot:1
+9 SET NAME=""
FOR
SET NAME=$ORDER(^TMP("FSCTEST",$JOB,CNT,NAME))
if NAME=""
QUIT
Begin DoDot:2
+10 SET USER=0
FOR
SET USER=$ORDER(^TMP("FSCTEST",$JOB,CNT,NAME,USER))
if USER<1
QUIT
Begin DoDot:3
+11 WRITE !,CNT,?10,NAME
End DoDot:3
End DoDot:2
End DoDot:1
+12 KILL ^TMP("FSCTEST",$JOB)
+13 QUIT
+14 ;
RTN ;
+1 NEW CNT,RTN
KILL ^TMP("FSCRPC",$JOB)
+2 SET RTN=""
FOR
SET RTN=$ORDER(^XTMP("FSCRPC",RTN))
if RTN=""
QUIT
Begin DoDot:1
+3 IF RTN=0
QUIT
+4 IF RTN="<STARTUP>"
QUIT
+5 IF RTN="<VERSION>"
QUIT
+6 IF RTN="ZZUSER"
QUIT
+7 SET CNT=+^XTMP("FSCRPC",RTN)
+8 SET ^TMP("FSCRPC",$JOB,CNT,RTN)=""
End DoDot:1
+9 SET CNT=""
FOR
SET CNT=$ORDER(^TMP("FSCRPC",$JOB,CNT))
if CNT=""
QUIT
Begin DoDot:1
+10 SET RTN=""
FOR
SET RTN=$ORDER(^TMP("FSCRPC",$JOB,CNT,RTN))
if RTN=""
QUIT
Begin DoDot:2
+11 WRITE !,CNT,?10,RTN
End DoDot:2
End DoDot:1
+12 KILL ^TMP("FSCRPC",$JOB)
+13 QUIT
EPTYPE ;
+1 KILL ^FSCD("CALL","AET")
+2 SET CNT=0
+3 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL",CALL))
if CALL<1
QUIT
SET NODE=$GET(^(CALL,120))
Begin DoDot:1
+4 SET EPTYPE=$PIECE(NODE,U,21)
+5 IF 'EPTYPE
WRITE !,CALL
QUIT
+6 SET CNT=CNT+1
+7 IF CNT#1000=0
WRITE !,"*",CNT
+8 IF EPTYPE=1
SET EPTYPE=3
+9 SET $PIECE(^FSCD("CALL",CALL,120),U,21)=EPTYPE
+10 SET ^FSCD("CALL","AET",EPTYPE,CALL)=""
End DoDot:1
+11 QUIT
TEST ;
+1 SET CALL=60000
FOR
SET CALL=$ORDER(^FSCD("STATUS HIST","B",CALL))
if CALL<1
QUIT
Begin DoDot:1
+2 SET COUNT=0
+3 SET NUM=0
FOR
SET NUM=$ORDER(^FSCD("STATUS HIST","B",CALL,NUM))
if NUM<1
QUIT
Begin DoDot:2
+4 SET ZERO=$GET(^FSCD("STATUS HIST",NUM,0))
IF '$LENGTH(ZERO)
QUIT
+5 IF $PIECE(ZERO,U,4)=1
IF $PIECE(ZERO,U,5)=""
SET COUNT=COUNT+1
End DoDot:2
+6 IF COUNT>1
WRITE !,CALL," ",COUNT," ",$PIECE(^FSCD("CALL",CALL,0),U)
End DoDot:1
+7 QUIT
