| 1 | VALM2 ;ALB/MJK - List Manager Utilities;08:52 PM 17 Jan 1993 ;02/01/2001 11:43
|
|---|
| 2 | ;;1.0;List Manager;**6**;Aug 13, 1993
|
|---|
| 3 | SEL ; -- select w/XQORNOD(0) defined
|
|---|
| 4 | D EN(XQORNOD(0)) Q
|
|---|
| 5 | EN(VALMNOD,VALMDIR) ; -- generic selector
|
|---|
| 6 | ; input passed: VALMNOD := var in XQORNOD(0) format
|
|---|
| 7 | N Y,BG,LST,VALMOUT
|
|---|
| 8 | K VALMY
|
|---|
| 9 | I '$D(VALMDIR) N VALMDIR S VALMDIR=""
|
|---|
| 10 | S BG=+$O(@VALMAR@("IDX",VALMBG,0))
|
|---|
| 11 | S LST=+$O(@VALMAR@("IDX",VALMLST,0))
|
|---|
| 12 | I BG,BG=LST,$P($P(VALMNOD,U,4),"=",2)="",VALMDIR'["O" S VALMY(BG)="" Q ; -- only one entry
|
|---|
| 13 | I 'BG D Q
|
|---|
| 14 | . W !!,$C(7),"There are no '",VALM("ENTITY"),"s' to select.",!
|
|---|
| 15 | . D WAIT^VALM1
|
|---|
| 16 | . D OUT
|
|---|
| 17 | S Y=$$PARSE(.VALMNOD,.BG,.LST)
|
|---|
| 18 | I 'Y D Q:$G(VALMOUT)
|
|---|
| 19 | . N DIR,X,DIRUT,DTOUT,DUOUT,DIROUT
|
|---|
| 20 | . S DIR(0)=$S(VALMDIR'["S":"L",1:"N")_$S(VALMDIR["O":"O",1:"")_"^"_BG_":"_LST
|
|---|
| 21 | . S DIR("A")="Select "_VALM("ENTITY")_$S(VALMDIR["S":"",1:"(s)")
|
|---|
| 22 | . D ^DIR I $D(DIRUT) D OUT S VALMOUT=1
|
|---|
| 23 | ; -- check was valid entries
|
|---|
| 24 | F I=1:1 S X=$P(Y,",",I) Q:'X D
|
|---|
| 25 | . I '$O(@VALMAR@("IDX",X,0))!(X<BG)!(X>LST) D
|
|---|
| 26 | . . W !,$C(7),">>> Selection '",X,"' is not a valid choice."
|
|---|
| 27 | . . S VALMOUT=1
|
|---|
| 28 | I $G(VALMOUT) D WAIT^VALM1 Q
|
|---|
| 29 | F I=1:1 S X=$P(Y,",",I) Q:'X S VALMY(X)=""
|
|---|
| 30 | Q
|
|---|
| 31 | PARSE(VALMNOD,BEG,END) ; -- split out pre-answers from user
|
|---|
| 32 | N Y,J,L,X
|
|---|
| 33 | S Y=$TR($P($P(VALMNOD,U,4),"=",2),"/\; .",",,,,,")
|
|---|
| 34 | 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_","
|
|---|
| 35 | Q Y
|
|---|
| 36 | OUT ; -- set variables to quit
|
|---|
| 37 | S VALMBCK=$S(VALMCC:"",1:"R")
|
|---|
| 38 | Q
|
|---|
| 39 | MENU ; -- entry point for 'turn' protocol
|
|---|
| 40 | N VALMX,DIR,X ;,Y,DIRUT,DUOUT,DTOUT,DIROUT calling app may check?
|
|---|
| 41 | S VALMX=$G(^DISV($S($D(DUZ)#2:DUZ,1:0),"VALMMENU",VALM("PROTOCOL"))) S:VALMX="" (VALMX,^(VALM("PROTOCOL")))=1
|
|---|
| 42 | 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"
|
|---|
| 43 | D ^DIR
|
|---|
| 44 | I Y S (VALMMENU,^DISV($S($D(DUZ)#2:DUZ,1:0),"VALMMENU",VALM("PROTOCOL")))='VALMX
|
|---|
| 45 | D FINISH^VALM4
|
|---|
| 46 | Q
|
|---|
| 47 | HELP ; -- help entry point
|
|---|
| 48 | N VALMANS,VALMHLP,DIR,DIRUT,DUOUT,DTOUT ; ^XQORM1 checks DIROUT
|
|---|
| 49 | S VALMANS=X N X ; save answer
|
|---|
| 50 | S VALMHLP=$G(^TMP("VALM DATA",$J,VALMEVL,"HLP")),X=VALMANS
|
|---|
| 51 | I VALMHLP="" D
|
|---|
| 52 | . I VALM("TYPE")=2 S VALMANS="??" Q
|
|---|
| 53 | . S X="?" D DISP^XQORM1,PAUSE^VALM1
|
|---|
| 54 | E D
|
|---|
| 55 | . X VALMHLP
|
|---|
| 56 | I $P($G(VALMKEY),U,2)]"",VALMANS["??" D:'$D(DIRUT) FULL^VALM1,KEYS,PAUSE^VALM1 S VALMBCK="R"
|
|---|
| 57 | D:$G(VALMBCK)="R" REFRESH^VALM K VALMBCK
|
|---|
| 58 | D:VALMCC RESET^VALM4
|
|---|
| 59 | D SHOW^VALM W !
|
|---|
| 60 | Q
|
|---|
| 61 | KEYS ; -- hidden key help
|
|---|
| 62 | W !,"The following actions are also available:"
|
|---|
| 63 | N XQORM,ORULT S XQORM=$O(^ORD(101,"B",$P(VALMKEY,U,2),0))_";ORD(101,"
|
|---|
| 64 | I '$D(^XUTL("XQORM",XQORM)) D XREF^XQORM K ORULT ; build ^XUTL nodes
|
|---|
| 65 | D DISP^XQORM1:XQORM
|
|---|
| 66 | Q
|
|---|
