source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQORM2.m@ 1800

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

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1XQORM2 ; SLC/KCM - Lookup for Menu Utility ;11/18/92 15:23
2 ;;8.0;KERNEL;**56,62**;Jul 10, 1995
3EN ;From: XQORM Entry: X,XQORM Exit: X,Y,XQORM
4 N K K Y,OROTHER I X=" " D Q:'$L(X)
5 . I $D(^DISV(DUZ,"XQORM",XQORM,"ALT")),$D(XQORM("ALT")) D S X="" Q
6 . . N XQORMERR,XQORMSAV,XQORMRCL
7 . . S (X,XQORMSAV)=^DISV(DUZ,"XQORM",XQORM,"ALT"),XQORMRCL=""
8 . . X XQORM("ALT") S Y=0
9 . . I $D(XQORMERR) S Y=-1 I XQORM(0)["A" W "??" W:XQORM(0)["\" !
10 . S XQORM(0)=XQORM(0)_"X" D LAST^XQORM4
11 . I '$L(X) S Y=-1 W:XQORM(0)["A" "??" W:XQORM(0)["A"&(XQORM(0)["\") !
12 D UP^XQORM1 K ORUX S ORUX=X,(ORUT,ORUER,Y)=0,XQORMSF=""
13 F J=1:1:$L(ORUX,",") S X=$P(ORUX,",",J) D EAT,SET D:X["-" RNG^XQORM3 Q:ORUER F K=1:1:$L(X,",") I $L($P(X,",",K)) S ORUT=ORUT+1,ORUX(ORUT)=$P(X,",",K) S:$L(ORUFG) ORUX(ORUT,"=")=ORUFG S:ORUSB ORUX(ORUT,"'")=""
14 I 'ORUER S (ORUSQ,ORUT)=0 F I=0:0 S ORUT=$O(ORUX(ORUT)) Q:ORUT="" S X=ORUX(ORUT) D SPCL I $L(X) D LOOK^XQORM3,CHAL Q:ORUER
15 I 'ORUER,+XQORM(0),+Y>XQORM(0) D:XQORM(0)["A" NE^XQORM4 S ORUER=1,Y=-1
16 I 'ORUER S ORUB=0 F I=0:0 S ORUB=$O(Y(ORUB)) Q:ORUB'>0 D SCRN I 'ORUFG D:ORUX["ALL" SUB I ORUX'["ALL" D:XQORM(0)["A" NS^XQORM4 S ORUER=1
17 I 'ORUER,Y>0 W:XQORM(0)["A" " " S ORUFG=$S($X>(IOM-30):9,1:$X) K:XQORM(0)'["F" ^DISV(DUZ,"XQORM",XQORM) F I=0:0 S I=$O(Y(I)) Q:I'>0 D:XQORM(0)["A" ECHO D:XQORM(0)'["F" DISV
18 S X=ORUX I ORUER K Y S Y=-1 I $D(XQORM("ALT")) D
19 . N XQORMERR,XQORMSAV S XQORMSAV=X X XQORM("ALT")
20 . S Y=0 I $D(XQORMERR) S Y=-1 D:XQORM(0)["A" UR^XQORM4
21 . I '$D(XQORMERR),(XQORM(0)'["F") D
22 . . K ^DISV(DUZ,"XQORM",XQORM)
23 . . S ^DISV(DUZ,"XQORM",XQORM,"ALT")=XQORMSAV
24KILL K ORUX,ORUFG,ORUSB,ORUT,ORUER,ORUFD,ORUB,ORUDA,ORUW,ORUSQ,XQORMSF,J,Y("B"),Y("#") Q
25SCRN S ORUFG=1 I $D(XQORM("S"))'[0,$L(XQORM("S")) N DA S DA(1)=+XQORM,DA=+Y(ORUB) I DA N Y X XQORM("S") S ORUFG=$T
26 Q
27SET S ORUSB=0 I $E(X)="-",$L(X)>1 S ORUSB=1,X=$P(X,"-",2,99)
28 S ORUFG="" I $E(X)'="=" S ORUFG=$P(X,"=",2,99),X=$P(X,"=",1)
29 Q
30SPCL S:'$D(XQORSPEW) XQORSPEW=0 I $E(X)="*" S XQORSPEW=$S(XQORSPEW:0,1:1),X=$E(X,2,255) W $S(XQORSPEW:" -RAPID MODE-",1:" -NORMAL MODE-")
31 ;I $D(XQORM("KEY",$P(X," "))) S ORUX(ORUT,"=")=$P(X," ",2,99)_"="_$G(ORUX(ORUT,"=")),X="^^`"_XQORM("KEY",$P(X," "))
32 I '$D(XQORM("NO^^")),$E(X,1,2)="^^" S Y=Y+1,ORUSQ=ORUSQ+1,Y(ORUSQ)="^"_X,X="" S:$D(ORUX(ORUT,"=")) $P(Y(ORUSQ),"=",2)=ORUX(ORUT,"=") Q
33 I XQORM(0)["+","+-"[X S Y=Y+1,ORUSQ=ORUSQ+1,Y(ORUSQ)=X,X="" Q
34 I $E(X)=";" D SC^XQORM4 S X="",ORUER=1 Q
35 S X=$P(X,";",1) D EAT
36 Q
37CHAL ; Q:ORUER I ORUDA,'$D(ORUDA("KEY")),'$D(XQORM("#")) D UPD^XQORM3 Q
38 Q:ORUER I ORUDA?1.N1"."1.N D UPD^XQORM3 Q
39 I $D(XQORM("KEY",$P(ORUDA," "))) D Q
40 . S Y=Y+1,ORUSQ=ORUSQ+1,Y(ORUSQ)="^^"_ORUDA_"^`"_+XQORM("KEY",$P(ORUDA," "))_"="_$P(ORUDA," ",2,99)_"="_$G(ORUX(ORUT,"="))
41 . I $P(XQORM("KEY",$P(ORUDA," ")),"^",2) S $P(Y(ORUSQ),"^",2)=+XQORM("KEY",$P(ORUDA," "))
42 . K ORUDA("KEY")
43 . Q
44 I $D(XQORM("#")),ORUDA?1.N,ORUDA D Q
45 . I '$D(Y("#")) S Y=Y+1,ORUSQ=ORUSQ+1,Y(ORUSQ)="^"_+XQORM("#")_"^^=",Y("#")=ORUSQ
46 . S Y(Y("#"))=Y(Y("#"))_ORUDA_","
47 . Q
48 I ORUDA="ALL" S X="ALL",ORUER=0 D ALL^XQORM4 Q
49 Q
50EAT F I=0:0 Q:$E(X)]" " Q:'$L(X) S X=$E(X,2,999)
51 F I=0:0 Q:$E(X,$L(X))]" " Q:'$L(X) S X=$E(X,1,$L(X)-1)
52 Q
53ECHO W:($X+$L($P(Y(I),"^",3))+4)>IOM !,?ORUFG W $P(Y(I),"^",3)," " Q
54DISV I +Y(I) S ^DISV(DUZ,"XQORM",XQORM,I)=$P(Y(I),"^",3) Q
55 I XQORM(0)["R",$L($P(Y(I),"^",3)) S ^DISV(DUZ,"XQORM",XQORM,I)=$P(Y(I),"^",3) Q
56 I XQORM(0)["r",'$L($P(Y(I),"^",3)) S ^DISV(DUZ,"XQORM",XQORM,I)="^^"_$P(Y(I),"^",4)
57 Q
58SUB K Y(ORUB) S Y=Y-1 Q
Note: See TracBrowser for help on using the repository browser.