[613] | 1 | XQORM ; SLC/KCM - Menu Utility ;2/25/92 16:42
|
---|
| 2 | ;;8.0;KERNEL;**56**;Jul 10, 1995
|
---|
| 3 | ;From: XQOR Entry: XQORM,{X} Exit: X,Y,XQORM,{DIROUT}
|
---|
| 4 | EN I $D(XQORM("HIJACK")) S XQORM=XQORM("HIJACK") K XQORM("HIJACK")
|
---|
| 5 | K Y S Y=-1 Q:$D(XQORM)'=11 Q:$D(XQORM(0))[0 Q:XQORM'[";" ;Q:'$D(@("^"_$P(XQORM,";",2)_+XQORM_",99)"))
|
---|
| 6 | I XQORM(0)'["h",$D(^XUTL("XQORM",XQORM,0)),$P(^(0),"^",1)'=$P(@("^"_$P(XQORM,";",2)_+XQORM_",99)"),"^",1) D XREF
|
---|
| 7 | I XQORM(0)'["h",'$D(^XUTL("XQORM",XQORM,0)) D XREF Q:Y<0
|
---|
| 8 | L +^XUTL("XQORM",XQORM,"XQORM PROTECT",$J):30 E W !,"Can't access menu at this time - try again later." S Y=-1 Q
|
---|
| 9 | S:$D(XQORM("X")) X=XQORM("X") S:$D(X)[0 X="" S ORUSV=X
|
---|
| 10 | I $S('$D(IOM):1,'$D(IOF):1,'$D(IOST):1,'IOM:1,1:0) S IOP=$S($D(ORIO):ORIO,1:"HOME") D ^%ZIS S X=ORUSV
|
---|
| 11 | S (DX,DY)=0 X ^%ZOSF("XY") I $D(XQORM("H")),$L(XQORM("H")) X XQORM("H")
|
---|
| 12 | S X=ORUSV D:XQORM(0)["D" DISP^XQORM1 I (XQORM(0)["A")!(XQORM(0)["D") W !
|
---|
| 13 | F ORU=0:0 D:XQORM(0)["A" PRMT^XQORM1 S Y=-1 Q:'$L(X)!(X="^")!(X="^^") D EN^XQORM2 Q:Y'<0!(XQORM(0)'["A")
|
---|
| 14 | L -^XUTL("XQORM",XQORM,"XQORM PROTECT",$J)
|
---|
| 15 | K DX,DY,J,ORU,ORULT,ORUSV Q
|
---|
| 16 | XREF N X,DIC,DIE,DA,DR
|
---|
| 17 | S Y=-1 S:'$D(ORULT) ORULT=2
|
---|
| 18 | I $P(XQORM,";",2)="DIC(19," D X19 Q
|
---|
| 19 | S DIE="^"_$P(XQORM,";",2),DA=+XQORM,DR="99///"_$H
|
---|
| 20 | L +(^XUTL("XQORM",XQORM),@(DIE_+XQORM_")")):ORULT E S Y=-1 Q
|
---|
| 21 | D ^DIE S Y=1 K D,D0,DI,DQ
|
---|
| 22 | L -(^XUTL("XQORM",XQORM),@(DIE_+XQORM_")"))
|
---|
| 23 | Q
|
---|
| 24 | X19 L +(^XUTL("XQORM",XQORM),^DIC(19,+XQORM)):ORULT E S Y=-1 Q
|
---|
| 25 | S DA=+XQORM D SET^XQORMX K DA S Y=1
|
---|
| 26 | L -(^XUTL("XQORM",XQORM),^DIC(19,+XQORM))
|
---|
| 27 | Q
|
---|