VALM2 ;ALB/MJK - List Manager Utilities;08:52 PM 17 Jan 1993
;;1;List Manager;;Aug 13, 1993
;
SEL ; -- select w/XQORNOD(0) defined
D EN(XQORNOD(0)) Q
;
EN(VALMNOD,VALMDIR) ; -- generic selector
; input passed: VALMNOD := var in XQORNOD(0) format
K VALMY
I '$D(VALMDIR) N VALMDIR S VALMDIR=""
S BG=+$O(@VALMAR@("IDX",VALMBG,0))
S LST=+$O(@VALMAR@("IDX",VALMLST,0))
I BG,BG=LST,$P($P(VALMNOD,U,4),"=",2)="",VALMDIR'["O" S VALMY(BG)="" G ENQ ; -- only one entry
I 'BG W !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR D OUT G ENQ
S Y=$$PARSE(.VALMNOD,.BG,.LST)
I 'Y S DIR(0)=$S(VALMDIR'["S":"L",1:"N")_$S(VALMDIR["O":"O",1:"")_"^"_BG_":"_LST,DIR("A")="Select "_VALM("ENTITY")_$S(VALMDIR["S":"",1:"(s)") D ^DIR K DIR I $D(DIRUT) D OUT G ENQ
;
; -- check was valid entries
S VALMERR=0
F I=1:1 S X=$P(Y,",",I) Q:'X D
.I '$O(@VALMAR@("IDX",X,0))!(X<BG)!(X>LST) D
..W !,*7,">>> Selection '",X,"' is not a valid choice."
..S VALMERR=1
I VALMERR D PAUSE^VALM1 G ENQ
;
F I=1:1 S X=$P(Y,",",I) Q:'X S VALMY(X)=""
ENQ K Y,X,BG,VALMERR,LST,DIRUT,DTOUT,DUOUT,DIROUT Q
;
PARSE(VALMNOD,BEG,END) ; -- split out pre-answers from user
N Y,J,L,X
S Y=$TR($P($P(VALMNOD,U,4),"=",2),"/\; .",",,,,,")
I Y["-" S X=Y,Y="" F I=1:1 S J=$P(X,",",I) Q:J']"" I +J>(BEG-1),+J<(END+1) S:J'["-" Y=Y_J_"," I J["-",+J,+J<+$P(J,"-",2) F L=+J:1:+$P(J,"-",2) I L>(BEG-1),L<(END+1) S Y=Y_L_","
Q Y
;
OUT ; -- set variables to quit
S VALMBCK=$S(VALMCC:"",1:"R")
Q
;
N VALMX
S VALMX=$G(^DISV($S($D(DUZ)#2:DUZ,1:0),"VALMMENU",VALM("PROTOCOL"))) S:VALMX="" (VALMX,^(VALM("PROTOCOL")))=1
W ! S DIR(0)="Y",DIR("A")="Do you wish to turn auto-display "_$S(VALMX:"'OFF'",1:"'ON'")_" for this menu",DIR("B")="NO" D ^DIR K DIR
I Y S (VALMMENU,^DISV($S($D(DUZ)#2:DUZ,1:0),"VALMMENU",VALM("PROTOCOL")))='VALMX
D FINISH^VALM4
Q
;
HELP ; -- help entry point
N VALMANS,VALMHLP
S VALMANS=X N X ; save answer
S VALMHLP=$G(^TMP("VALM DATA",$J,VALMEVL,"HLP")),X=VALMANS
I VALMHLP]"" X VALMHLP
I VALMHLP="",VALM("TYPE")=2 S VALMANS="??"
I VALMHLP="",VALM("TYPE")'=2 S X="?" D DISP^XQORM1,PAUSE^VALM1
I $P($G(VALMKEY),U,2)]"",VALMANS["??" D FULL^VALM1,KEYS,PAUSE^VALM1 S VALMBCK="R"
D:$G(VALMBCK)="R" REFRESH^VALM K VALMBCK
D:VALMCC RESET^VALM4
D SHOW^VALM W !
Q
;
KEYS ; -- hidden key help
W !,"The following actions are also available:"
N XQORM,ORULT S XQORM=$O(^ORD(101,"B",$P(VALMKEY,U,2),0))_";ORD(101,"
I '$D(^XUTL("XQORM",XQORM)) D XREF^XQORM K ORULT ; build ^XUTL nodes
D DISP^XQORM1:XQORM
Q
VALM2 ;ALB/MJK - List Manager Utilities;08:52 PM 17 Jan 1993
+1 ;;1;List Manager;;Aug 13, 1993
+2 ;
SEL ; -- select w/XQORNOD(0) defined
+1 DO EN(XQORNOD(0))
QUIT
+2 ;
EN(VALMNOD,VALMDIR) ; -- generic selector
+1 ; input passed: VALMNOD := var in XQORNOD(0) format
+2 KILL VALMY
+3 IF '$DATA(VALMDIR)
NEW VALMDIR
SET VALMDIR=""
+4 SET BG=+$ORDER(@VALMAR@("IDX",VALMBG,0))
+5 SET LST=+$ORDER(@VALMAR@("IDX",VALMLST,0))
+6 ; -- only one entry
IF BG
IF BG=LST
IF $PIECE($PIECE(VALMNOD,U,4),"=",2)=""
IF VALMDIR'["O"
SET VALMY(BG)=""
GOTO ENQ
+7 IF 'BG
WRITE !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
DO OUT
GOTO ENQ
+8 SET Y=$$PARSE(.VALMNOD,.BG,.LST)
+9 IF 'Y
SET DIR(0)=$SELECT(VALMDIR'["S":"L",1:"N")_$SELECT(VALMDIR["O":"O",1:"")_"^"_BG_":"_LST
SET DIR("A")="Select "_VALM("ENTITY")_$SELECT(VALMDIR["S":"",1:"(s)")
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
DO OUT
GOTO ENQ
+10 ;
+11 ; -- check was valid entries
+12 SET VALMERR=0
+13 FOR I=1:1
SET X=$PIECE(Y,",",I)
IF 'X
QUIT
Begin DoDot:1
+14 IF '$ORDER(@VALMAR@("IDX",X,0))!(X<BG)!(X>LST)
Begin DoDot:2
+15 WRITE !,*7,">>> Selection '",X,"' is not a valid choice."
+16 SET VALMERR=1
End DoDot:2
End DoDot:1
+17 IF VALMERR
DO PAUSE^VALM1
GOTO ENQ
+18 ;
+19 FOR I=1:1
SET X=$PIECE(Y,",",I)
IF 'X
QUIT
SET VALMY(X)=""
ENQ KILL Y,X,BG,VALMERR,LST,DIRUT,DTOUT,DUOUT,DIROUT
QUIT
+1 ;
PARSE(VALMNOD,BEG,END) ; -- split out pre-answers from user
+1 NEW Y,J,L,X
+2 SET Y=$TRANSLATE($PIECE($PIECE(VALMNOD,U,4),"=",2),"/\; .",",,,,,")
+3 IF Y["-"
SET X=Y
SET Y=""
FOR I=1:1
SET J=$PIECE(X,",",I)
IF J']""
QUIT
IF +J>(BEG-1)
IF +J<(END+1)
IF J'["-"
SET Y=Y_J_","
IF J["-"
IF +J
IF +J<+$PIECE(J,"-",2)
FOR L=+J:1:+$PIECE(J,"-",2)
IF L>(BEG-1)
IF L<(END+1)
SET Y=Y_L_","
+4 QUIT Y
+5 ;
OUT ; -- set variables to quit
+1 SET VALMBCK=$SELECT(VALMCC:"",1:"R")
+2 QUIT
+3 ;
+1 NEW VALMX
+2 SET VALMX=$GET(^DISV($SELECT($DATA(DUZ)#2:DUZ,1:0),"VALMMENU",VALM("PROTOCOL")))
IF VALMX=""
SET (VALMX,^(VALM("PROTOCOL")))=1
+3 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you wish to turn auto-display "_$SELECT(VALMX:"'OFF'",1:"'ON'")_" for this menu"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+4 IF Y
SET (VALMMENU,^DISV($SELECT($DATA(DUZ)#2:DUZ,1:0),"VALMMENU",VALM("PROTOCOL")))='VALMX
+5 DO FINISH^VALM4
+6 QUIT
+7 ;
HELP ; -- help entry point
+1 NEW VALMANS,VALMHLP
+2 ; save answer
SET VALMANS=X
NEW X
+3 SET VALMHLP=$GET(^TMP("VALM DATA",$JOB,VALMEVL,"HLP"))
SET X=VALMANS
+4 IF VALMHLP]""
XECUTE VALMHLP
+5 IF VALMHLP=""
IF VALM("TYPE")=2
SET VALMANS="??"
+6 IF VALMHLP=""
IF VALM("TYPE")'=2
SET X="?"
DO DISP^XQORM1
DO PAUSE^VALM1
+7 IF $PIECE($GET(VALMKEY),U,2)]""
IF VALMANS["??"
DO FULL^VALM1
DO KEYS
DO PAUSE^VALM1
SET VALMBCK="R"
+8 IF $GET(VALMBCK)="R"
DO REFRESH^VALM
KILL VALMBCK
+9 IF VALMCC
DO RESET^VALM4
+10 DO SHOW^VALM
WRITE !
+11 QUIT
+12 ;
KEYS ; -- hidden key help
+1 WRITE !,"The following actions are also available:"
+2 NEW XQORM,ORULT
SET XQORM=$ORDER(^ORD(101,"B",$PIECE(VALMKEY,U,2),0))_";ORD(101,"
+3 ; build ^XUTL nodes
IF '$DATA(^XUTL("XQORM",XQORM))
DO XREF^XQORM
KILL ORULT
+4 IF XQORM
DO DISP^XQORM1
+5 QUIT
