source: WorldVistAEHR/trunk/r/LIST_MANAGER-VALM/VALM2.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1VALM2 ;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
3SEL ; -- select w/XQORNOD(0) defined
4 D EN(XQORNOD(0)) Q
5EN(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
31PARSE(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
36OUT ; -- set variables to quit
37 S VALMBCK=$S(VALMCC:"",1:"R")
38 Q
39MENU ; -- 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
47HELP ; -- 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
61KEYS ; -- 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
Note: See TracBrowser for help on using the repository browser.