KMPRP2 ;OAK/KAK - RUM Hourly Occurrences Distribution ;11/29/04 11:57
;;2.0;CAPACITY MANAGEMENT - RUM;**1**;May 28, 2003
;
EN ;-- entry point
;
N %ZIS,CONT,DATA,DIR,HR,KMPRDATE,KMPROPR,KMPROPT,OUT,POP
N STRT,USER,X,Y
;
S OUT=0
F D Q:OUT
.D HDR^KMPDUTL4(" Hourly Occurrence Distribution ") W !
.S KMPROPR=$$OPR
.I 'KMPROPR S OUT=1 Q
.;
.; select option, protocol or rpc entry
.S KMPROPT=$$OPRSEL(KMPROPR) Q:'KMPROPT
.;
.; determine date from file 8971.1
.S STRT=$O(^KMPR(8971.1,"B",0))
.S DIR(0)="DO^"_STRT_":"_DT
.S DIR("A")="Select DATE ",DIR("?")=" ",DIR("?",1)="Enter a date."
.W !
.D ^DIR
.I $D(DIRUT) Q
.S KMPRDATE=Y
.S $P(KMPRDATE,U,2)=$$FMTE^XLFDT(Y)
.;
.; select output device
.S %ZIS="Q",%ZIS("A")="Device: "
.W ! D ^%ZIS I POP W !,"No action taken." Q
.; if queued
.I $D(IO("Q")) D Q
..N ZTDESC,ZTRTN,ZTSAVE
..K IO("Q")
..S ZTDESC="RUM Hourly Occurrence Distribution"
..S ZTRTN="EN1^KMPRP2"
..S ZTSAVE("KMPRDATE")="",ZTSAVE("KMPROPR")="",ZTSAVE("KMPROPT")=""
..D ^%ZTLOAD
..W:$G(ZTSK) !,"Task #",ZTSK
..D EXIT
.;
.D EN1
Q
;
EN1 ;-- entry point from taskman
;
Q:'$G(KMPRDATE)
Q:'$G(KMPROPR)
Q:$G(KMPROPT)=""
;
D DATA,PRINT,EXIT
;
Q
;
DATA ;-- set data
Q:'$G(KMPRDATE)
Q:'$G(KMPROPR)
Q:$G(KMPROPT)=""
;
N DATA,DOT,END,I,IEN,JOB,NODE,OCCUR,OPT,OPT1,OPTION,PT
K ^TMP($J)
;
S CONT=1,DOT=0
W:$E(IOST,1,2)="C-" !?2,"Compiling data..."
;
I +KMPRDATE=DT D TODAY,EXIT Q
;
S IEN=0
F S IEN=$O(^KMPR(8971.1,"B",+KMPRDATE,IEN)) Q:'IEN D
.S DOT=DOT+1
.W:'(DOT#100)&($E(IOST,1,2)="C-") "."
.;
.Q:'$D(^KMPR(8971.1,IEN,0))
.;
.S DATA(0)=^KMPR(8971.1,IEN,0),NODE=$P(DATA(0),U,3)
.;I DATA(0)["SCMC PCMM GUI WORKSTATION" W DATA(0),!
.S OPTION=$$OPRCHK(KMPROPR,KMPROPT,DATA(0))
.Q:OPTION=""
.;
.S DATA(1.1)=$G(^KMPR(8971.1,IEN,1.1)),DATA(1.2)=$G(^(1.2)),DATA(2.1)=$G(^(2.1)),DATA(2.2)=$G(^(2.2))
.;I DATA(0)["SCMC PCMM GUI WORKSTATION" W DATA(0),!
.;
.F I=1:1:24 D
..S $P(^TMP($J,"HR",NODE),U,I)=$P($G(^TMP($J,"HR",NODE)),U,I)+$P(DATA(1.1),U,I)+$P(DATA(2.1),U,I)
..S $P(^TMP($J,"HR",NODE,"USER"),U,I)=$P($G(^TMP($J,"HR",NODE,"USER")),U,I)+$P(DATA(1.2),U,I)+$P(DATA(2.2),U,I)
;
Q
;
TODAY ;
; 1 - option, 2 - protocol, 3 - rpc
I +KMPROPR=1 S OPT1=$P(KMPROPT,U,2)_"***"
I +KMPROPR=2 S OPT1="***"_$P(KMPROPT,U,2)
I +KMPROPR=3 S OPT1="`"_$P(KMPROPT,U,2)_"***"
;
S NODE=""
F S NODE=$O(^KMPTMP("KMPR","DLY",NODE)) Q:NODE="" D
.S ^TMP($J,"HR",NODE)=""
.S OPT=""
.F S OPT=$O(^KMPTMP("KMPR","DLY",NODE,+$H,OPT)) Q:OPT="" D
..S DOT=DOT+1
..W:'(DOT#100)&($E(IOST,1,2)="C-") "."
..;
..I OPT[OPT1!((+KMPROPR=1)&(OPT[("!"_OPT1))) D
...;W OPT,!
...; if searching options do not count option***protocol
...I (+KMPROPR=1)&($P(OPT,"***",2)'="") Q
...;
...S JOB=""
...F S JOB=$O(^KMPTMP("KMPR","DLY",NODE,+$H,OPT,JOB)) Q:JOB="" D
....S PT=""
....F S PT=$O(^KMPTMP("KMPR","DLY",NODE,+$H,OPT,JOB,PT)) Q:PT="" S DATA=^(PT) D
.....F I=10:1:33 S OCCUR=$P(DATA,U,I) I +OCCUR D
......S $P(^TMP($J,"HR",NODE),U,I-9)=$P(^TMP($J,"HR",NODE),U,I-9)+OCCUR
......S $P(^TMP($J,"HR",NODE,"USER"),U,I-9)=$P($G(^TMP($J,"HR",NODE,"USER")),U,I-9)+1
;
Q
;
EXIT ;
S:$D(ZTQUEUED) ZTREQ="@"
D ^%ZISC
K ^TMP($J)
;
Q
;
PRINT ;-- print data
;
U IO
;
N LINE,NODE,NOWFM,NOWHR,OCCUR,SITE,TIME,TOTOCC,TOTUSR,USER
;
; facility name
S SITE=$$SITE^VASITE
S SITE=$P(SITE,U,2)_" ("_$P(SITE,U,3)_")"
;
S $P(LINE,"=",IOM)="="
;
D HDR
;
I '$D(^TMP($J,"HR")) D Q
.W !,?28,"<<<No Data to Report>>>",!!
.D CONTINUE^KMPDUTL4("Press RETURN to continue",1,.CONT)
;
I +KMPRDATE=DT D
.S NOWFM=$$HTFM^XLFDT($H)
.S NOWHR=+$E($P(NOWFM,".",2),1,2)
F TIME=0:1:23 D Q:'CONT
.W ?2,$S(TIME<10:"0",1:""),TIME,?7
.I +KMPRDATE=DT I TIME>NOWHR D Q
..W ?10,"<<<No Data>>>",!
..I $Y>(IOSL-3) D
...D CONTINUE^KMPDUTL4("Press RETURN to continue or '^' to exit",1,.CONT)
...D:CONT HDR
.S NODE="",(TOTOCC,TOTUSR)=0
.F S NODE=$O(^TMP($J,"HR",NODE)) Q:NODE="" D
..S OCCUR=$P(^TMP($J,"HR",NODE),U,TIME+1),TOTOCC=TOTOCC+OCCUR
..S USER=$P($G(^TMP($J,"HR",NODE,"USER")),U,TIME+1),TOTUSR=TOTUSR+USER
..W $J($FN(OCCUR,",",0),9)
.W $J($FN(TOTOCC,",",0),9),$J($FN(TOTUSR,",",0),9)
.I +KMPRDATE=DT I TIME=NOWHR W " <<<Partial Data>>>"
.W !
.I $Y>(IOSL-3) D
..D CONTINUE^KMPDUTL4("Press RETURN to continue or '^' to exit",1,.CONT)
..D:CONT HDR
;
D:CONT CONTINUE^KMPDUTL4("Press RETURN to continue",1,.CONT)
Q
;
HDR ;
N NODE,TITLE,X
S TITLE="Hourly Occurrence Distribution for "_$P(KMPROPT,U,2)
W:$Y @IOF W !
W ?(80-$L($G(SITE))\2),$G(SITE),!
W ?(80-$L(TITLE)\2),TITLE,!
W ?31,"For "_$P($G(KMPRDATE),U,2),!!
W LINE,!," Hour",?10
S NODE=""
F S NODE=$O(^TMP($J,"HR",NODE)) Q:NODE="" D
.W " ",$S($E(NODE,1,3)=+NODE:" "_$E(NODE,$L(NODE)-2,$L(NODE)),1:$E(NODE,$L(NODE)-3,$L(NODE)))," "
S X=$X
W " Total Total",!
W ?X," Occ User",!,LINE,!
;
Q
;
OPR() ;-- extrinsic function - select option, protocol or rpc
;-----------------------------------------------------------------------
; Return: 1 - Option
; 2 - Protocol
; 3 - RPC
; "" - No selection made
;-----------------------------------------------------------------------
N DIR,X,Y
;
S DIR(0)="SO^1:Option/Task;2:Protocol;3:RPC"
D ^DIR
;
Q $S(Y:Y_"^"_$G(Y(0)),1:"")
;
OPRCHK(OPR,OPT,DATA) ;-- extrinsic function
;- check to see if option, protocol or rpc matches
;-----------------------------------------------------------------------
; OPR.... Results from $$OPR above
; OPT.... Option, protocol or rpc name to be matched
; DATA... Zero node of file 8971.1 (RESOURCE USAGE MONITOR)
;
; Return: OptionName - match
; "" - no match
;-----------------------------------------------------------------------
Q:$G(OPR)="" ""
Q:'OPR!($P(OPR,U,2)="") ""
Q:'$D(DATA) ""
Q:(+OPR)<1!((+OPR)>3) ""
;
N OPTION
;
; option - piece 4, protocol - piece 5, rpc - piece 7
S OPTION=$S((+OPR=1):$P(DATA,U,4),(+OPR=2):$P(DATA,U,5),1:$P(DATA,U,7))
;
Q $S(OPTION="":"",OPTION'=$P(OPT,U,2):"",(+OPR=1)&($P(DATA,U,5)'=""):"",1:OPTION)
;
OPRSEL(OPR) ;-- extrinsic function - select entry
;-----------------------------------------------------------------------
; OPT.... Results from $$OPR above
;
; Return: IEN^Name - this will be from the Option file, Protocol file,
; or RPC file, depending on the value of OPR
; "" - no selection made
;-----------------------------------------------------------------------
Q:'$G(OPR) ""
Q:OPR<1!(OPR>3) ""
;
N DIC,X,Y
;
W !
; 1 - option, 2 - protocol, 3 - rpc
S DIC=$S((+OPR)=1:19,(+OPR)=2:101,1:8994)
S DIC(0)="AEMQZ",DIC("A")="Select "_$P(OPR,U,2)_": "
D ^DIC
;
Q $S(Y<0:"",1:+Y_"^"_Y(0,0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPRP2 6912 printed Apr 09, 2024@20:46:05 Page 2
KMPRP2 ;OAK/KAK - RUM Hourly Occurrences Distribution ;11/29/04 11:57
+1 ;;2.0;CAPACITY MANAGEMENT - RUM;**1**;May 28, 2003
+2 ;
EN ;-- entry point
+1 ;
+2 NEW %ZIS,CONT,DATA,DIR,HR,KMPRDATE,KMPROPR,KMPROPT,OUT,POP
+3 NEW STRT,USER,X,Y
+4 ;
+5 SET OUT=0
+6 FOR
Begin DoDot:1
+7 DO HDR^KMPDUTL4(" Hourly Occurrence Distribution ")
WRITE !
+8 SET KMPROPR=$$OPR
+9 IF 'KMPROPR
SET OUT=1
QUIT
+10 ;
+11 ; select option, protocol or rpc entry
+12 SET KMPROPT=$$OPRSEL(KMPROPR)
if 'KMPROPT
QUIT
+13 ;
+14 ; determine date from file 8971.1
+15 SET STRT=$ORDER(^KMPR(8971.1,"B",0))
+16 SET DIR(0)="DO^"_STRT_":"_DT
+17 SET DIR("A")="Select DATE "
SET DIR("?")=" "
SET DIR("?",1)="Enter a date."
+18 WRITE !
+19 DO ^DIR
+20 IF $DATA(DIRUT)
QUIT
+21 SET KMPRDATE=Y
+22 SET $PIECE(KMPRDATE,U,2)=$$FMTE^XLFDT(Y)
+23 ;
+24 ; select output device
+25 SET %ZIS="Q"
SET %ZIS("A")="Device: "
+26 WRITE !
DO ^%ZIS
IF POP
WRITE !,"No action taken."
QUIT
+27 ; if queued
+28 IF $DATA(IO("Q"))
Begin DoDot:2
+29 NEW ZTDESC,ZTRTN,ZTSAVE
+30 KILL IO("Q")
+31 SET ZTDESC="RUM Hourly Occurrence Distribution"
+32 SET ZTRTN="EN1^KMPRP2"
+33 SET ZTSAVE("KMPRDATE")=""
SET ZTSAVE("KMPROPR")=""
SET ZTSAVE("KMPROPT")=""
+34 DO ^%ZTLOAD
+35 if $GET(ZTSK)
WRITE !,"Task #",ZTSK
+36 DO EXIT
End DoDot:2
QUIT
+37 ;
+38 DO EN1
End DoDot:1
if OUT
QUIT
+39 QUIT
+40 ;
EN1 ;-- entry point from taskman
+1 ;
+2 if '$GET(KMPRDATE)
QUIT
+3 if '$GET(KMPROPR)
QUIT
+4 if $GET(KMPROPT)=""
QUIT
+5 ;
+6 DO DATA
DO PRINT
DO EXIT
+7 ;
+8 QUIT
+9 ;
DATA ;-- set data
+1 if '$GET(KMPRDATE)
QUIT
+2 if '$GET(KMPROPR)
QUIT
+3 if $GET(KMPROPT)=""
QUIT
+4 ;
+5 NEW DATA,DOT,END,I,IEN,JOB,NODE,OCCUR,OPT,OPT1,OPTION,PT
+6 KILL ^TMP($JOB)
+7 ;
+8 SET CONT=1
SET DOT=0
+9 if $EXTRACT(IOST,1,2)="C-"
WRITE !?2,"Compiling data..."
+10 ;
+11 IF +KMPRDATE=DT
DO TODAY
DO EXIT
QUIT
+12 ;
+13 SET IEN=0
+14 FOR
SET IEN=$ORDER(^KMPR(8971.1,"B",+KMPRDATE,IEN))
if 'IEN
QUIT
Begin DoDot:1
+15 SET DOT=DOT+1
+16 if '(DOT#100)&($EXTRACT(IOST,1,2)="C-")
WRITE "."
+17 ;
+18 if '$DATA(^KMPR(8971.1,IEN,0))
QUIT
+19 ;
+20 SET DATA(0)=^KMPR(8971.1,IEN,0)
SET NODE=$PIECE(DATA(0),U,3)
+21 ;I DATA(0)["SCMC PCMM GUI WORKSTATION" W DATA(0),!
+22 SET OPTION=$$OPRCHK(KMPROPR,KMPROPT,DATA(0))
+23 if OPTION=""
QUIT
+24 ;
+25 SET DATA(1.1)=$GET(^KMPR(8971.1,IEN,1.1))
SET DATA(1.2)=$GET(^(1.2))
SET DATA(2.1)=$GET(^(2.1))
SET DATA(2.2)=$GET(^(2.2))
+26 ;I DATA(0)["SCMC PCMM GUI WORKSTATION" W DATA(0),!
+27 ;
+28 FOR I=1:1:24
Begin DoDot:2
+29 SET $PIECE(^TMP($JOB,"HR",NODE),U,I)=$PIECE($GET(^TMP($JOB,"HR",NODE)),U,I)+$PIECE(DATA(1.1),U,I)+$PIECE(DATA(2.1),U,I)
+30 SET $PIECE(^TMP($JOB,"HR",NODE,"USER"),U,I)=$PIECE($GET(^TMP($JOB,"HR",NODE,"USER")),U,I)+$PIECE(DATA(1.2),U,I)+$PIECE(DATA(2.2),U,I)
End DoDot:2
End DoDot:1
+31 ;
+32 QUIT
+33 ;
TODAY ;
+1 ; 1 - option, 2 - protocol, 3 - rpc
+2 IF +KMPROPR=1
SET OPT1=$PIECE(KMPROPT,U,2)_"***"
+3 IF +KMPROPR=2
SET OPT1="***"_$PIECE(KMPROPT,U,2)
+4 IF +KMPROPR=3
SET OPT1="`"_$PIECE(KMPROPT,U,2)_"***"
+5 ;
+6 SET NODE=""
+7 FOR
SET NODE=$ORDER(^KMPTMP("KMPR","DLY",NODE))
if NODE=""
QUIT
Begin DoDot:1
+8 SET ^TMP($JOB,"HR",NODE)=""
+9 SET OPT=""
+10 FOR
SET OPT=$ORDER(^KMPTMP("KMPR","DLY",NODE,+$HOROLOG,OPT))
if OPT=""
QUIT
Begin DoDot:2
+11 SET DOT=DOT+1
+12 if '(DOT#100)&($EXTRACT(IOST,1,2)="C-")
WRITE "."
+13 ;
+14 IF OPT[OPT1!((+KMPROPR=1)&(OPT[("!"_OPT1)))
Begin DoDot:3
+15 ;W OPT,!
+16 ; if searching options do not count option***protocol
+17 IF (+KMPROPR=1)&($PIECE(OPT,"***",2)'="")
QUIT
+18 ;
+19 SET JOB=""
+20 FOR
SET JOB=$ORDER(^KMPTMP("KMPR","DLY",NODE,+$HOROLOG,OPT,JOB))
if JOB=""
QUIT
Begin DoDot:4
+21 SET PT=""
+22 FOR
SET PT=$ORDER(^KMPTMP("KMPR","DLY",NODE,+$HOROLOG,OPT,JOB,PT))
if PT=""
QUIT
SET DATA=^(PT)
Begin DoDot:5
+23 FOR I=10:1:33
SET OCCUR=$PIECE(DATA,U,I)
IF +OCCUR
Begin DoDot:6
+24 SET $PIECE(^TMP($JOB,"HR",NODE),U,I-9)=$PIECE(^TMP($JOB,"HR",NODE),U,I-9)+OCCUR
+25 SET $PIECE(^TMP($JOB,"HR",NODE,"USER"),U,I-9)=$PIECE($GET(^TMP($JOB,"HR",NODE,"USER")),U,I-9)+1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 QUIT
+28 ;
EXIT ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO ^%ZISC
+3 KILL ^TMP($JOB)
+4 ;
+5 QUIT
+6 ;
PRINT ;-- print data
+1 ;
+2 USE IO
+3 ;
+4 NEW LINE,NODE,NOWFM,NOWHR,OCCUR,SITE,TIME,TOTOCC,TOTUSR,USER
+5 ;
+6 ; facility name
+7 SET SITE=$$SITE^VASITE
+8 SET SITE=$PIECE(SITE,U,2)_" ("_$PIECE(SITE,U,3)_")"
+9 ;
+10 SET $PIECE(LINE,"=",IOM)="="
+11 ;
+12 DO HDR
+13 ;
+14 IF '$DATA(^TMP($JOB,"HR"))
Begin DoDot:1
+15 WRITE !,?28,"<<<No Data to Report>>>",!!
+16 DO CONTINUE^KMPDUTL4("Press RETURN to continue",1,.CONT)
End DoDot:1
QUIT
+17 ;
+18 IF +KMPRDATE=DT
Begin DoDot:1
+19 SET NOWFM=$$HTFM^XLFDT($HOROLOG)
+20 SET NOWHR=+$EXTRACT($PIECE(NOWFM,".",2),1,2)
End DoDot:1
+21 FOR TIME=0:1:23
Begin DoDot:1
+22 WRITE ?2,$SELECT(TIME<10:"0",1:""),TIME,?7
+23 IF +KMPRDATE=DT
IF TIME>NOWHR
Begin DoDot:2
+24 WRITE ?10,"<<<No Data>>>",!
+25 IF $Y>(IOSL-3)
Begin DoDot:3
+26 DO CONTINUE^KMPDUTL4("Press RETURN to continue or '^' to exit",1,.CONT)
+27 if CONT
DO HDR
End DoDot:3
End DoDot:2
QUIT
+28 SET NODE=""
SET (TOTOCC,TOTUSR)=0
+29 FOR
SET NODE=$ORDER(^TMP($JOB,"HR",NODE))
if NODE=""
QUIT
Begin DoDot:2
+30 SET OCCUR=$PIECE(^TMP($JOB,"HR",NODE),U,TIME+1)
SET TOTOCC=TOTOCC+OCCUR
+31 SET USER=$PIECE($GET(^TMP($JOB,"HR",NODE,"USER")),U,TIME+1)
SET TOTUSR=TOTUSR+USER
+32 WRITE $JUSTIFY($FNUMBER(OCCUR,",",0),9)
End DoDot:2
+33 WRITE $JUSTIFY($FNUMBER(TOTOCC,",",0),9),$JUSTIFY($FNUMBER(TOTUSR,",",0),9)
+34 IF +KMPRDATE=DT
IF TIME=NOWHR
WRITE " <<<Partial Data>>>"
+35 WRITE !
+36 IF $Y>(IOSL-3)
Begin DoDot:2
+37 DO CONTINUE^KMPDUTL4("Press RETURN to continue or '^' to exit",1,.CONT)
+38 if CONT
DO HDR
End DoDot:2
End DoDot:1
if 'CONT
QUIT
+39 ;
+40 if CONT
DO CONTINUE^KMPDUTL4("Press RETURN to continue",1,.CONT)
+41 QUIT
+42 ;
HDR ;
+1 NEW NODE,TITLE,X
+2 SET TITLE="Hourly Occurrence Distribution for "_$PIECE(KMPROPT,U,2)
+3 if $Y
WRITE @IOF
WRITE !
+4 WRITE ?(80-$LENGTH($GET(SITE))\2),$GET(SITE),!
+5 WRITE ?(80-$LENGTH(TITLE)\2),TITLE,!
+6 WRITE ?31,"For "_$PIECE($GET(KMPRDATE),U,2),!!
+7 WRITE LINE,!," Hour",?10
+8 SET NODE=""
+9 FOR
SET NODE=$ORDER(^TMP($JOB,"HR",NODE))
if NODE=""
QUIT
Begin DoDot:1
+10 WRITE " ",$SELECT($EXTRACT(NODE,1,3)=+NODE:" "_$EXTRACT(NODE,$LENGTH(NODE)-2,$LENGTH(NODE)),1:$EXTRACT(NODE,$LENGTH(NODE)-3,$LENGTH(NODE)))," "
End DoDot:1
+11 SET X=$X
+12 WRITE " Total Total",!
+13 WRITE ?X," Occ User",!,LINE,!
+14 ;
+15 QUIT
+16 ;
OPR() ;-- extrinsic function - select option, protocol or rpc
+1 ;-----------------------------------------------------------------------
+2 ; Return: 1 - Option
+3 ; 2 - Protocol
+4 ; 3 - RPC
+5 ; "" - No selection made
+6 ;-----------------------------------------------------------------------
+7 NEW DIR,X,Y
+8 ;
+9 SET DIR(0)="SO^1:Option/Task;2:Protocol;3:RPC"
+10 DO ^DIR
+11 ;
+12 QUIT $SELECT(Y:Y_"^"_$GET(Y(0)),1:"")
+13 ;
OPRCHK(OPR,OPT,DATA) ;-- extrinsic function
+1 ;- check to see if option, protocol or rpc matches
+2 ;-----------------------------------------------------------------------
+3 ; OPR.... Results from $$OPR above
+4 ; OPT.... Option, protocol or rpc name to be matched
+5 ; DATA... Zero node of file 8971.1 (RESOURCE USAGE MONITOR)
+6 ;
+7 ; Return: OptionName - match
+8 ; "" - no match
+9 ;-----------------------------------------------------------------------
+10 if $GET(OPR)=""
QUIT ""
+11 if 'OPR!($PIECE(OPR,U,2)="")
QUIT ""
+12 if '$DATA(DATA)
QUIT ""
+13 if (+OPR)<1!((+OPR)>3)
QUIT ""
+14 ;
+15 NEW OPTION
+16 ;
+17 ; option - piece 4, protocol - piece 5, rpc - piece 7
+18 SET OPTION=$SELECT((+OPR=1):$PIECE(DATA,U,4),(+OPR=2):$PIECE(DATA,U,5),1:$PIECE(DATA,U,7))
+19 ;
+20 QUIT $SELECT(OPTION="":"",OPTION'=$PIECE(OPT,U,2):"",(+OPR=1)&($PIECE(DATA,U,5)'=""):"",1:OPTION)
+21 ;
OPRSEL(OPR) ;-- extrinsic function - select entry
+1 ;-----------------------------------------------------------------------
+2 ; OPT.... Results from $$OPR above
+3 ;
+4 ; Return: IEN^Name - this will be from the Option file, Protocol file,
+5 ; or RPC file, depending on the value of OPR
+6 ; "" - no selection made
+7 ;-----------------------------------------------------------------------
+8 if '$GET(OPR)
QUIT ""
+9 if OPR<1!(OPR>3)
QUIT ""
+10 ;
+11 NEW DIC,X,Y
+12 ;
+13 WRITE !
+14 ; 1 - option, 2 - protocol, 3 - rpc
+15 SET DIC=$SELECT((+OPR)=1:19,(+OPR)=2:101,1:8994)
+16 SET DIC(0)="AEMQZ"
SET DIC("A")="Select "_$PIECE(OPR,U,2)_": "
+17 DO ^DIC
+18 ;
+19 QUIT $SELECT(Y<0:"",1:+Y_"^"_Y(0,0))
