- 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
