VALMXQ08 ; alb/mjk - XQORM for export with LM v1 ; 3/30/93
;;1;List Manager;;Aug 13, 1993
;
;
XQORM ; SLC/KCM - Menu Utility ;2/25/92 16:42
;;6.7;Sidewinder;;Jan 08, 1993
;From: XQOR Entry: XQORM,{X} Exit: X,Y,XQORM,{DIROUT}
EN K Y S Y=-1 Q:$D(XQORM)'=11 Q:$D(XQORM(0))[0 Q:XQORM'[";" ;Q:'$D(@("^"_$P(XQORM,";",2)_+XQORM_",99)"))
I XQORM(0)'["h",$D(^XUTL("XQORM",XQORM,0)),$P(^(0),"^",1)'=$P(@("^"_$P(XQORM,";",2)_+XQORM_",99)"),"^",1) D XREF
I XQORM(0)'["h",'$D(^XUTL("XQORM",XQORM,0)) D XREF Q:Y<0
L ^XUTL("XQORM",XQORM,"XQORM PROTECT",$J):30 E W !,"Can't access menu at this time - try again later." S Y=-1 Q
S:$D(XQORM("X")) X=XQORM("X") S:$D(X)[0 X="" S ORUSV=X
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
S (DX,DY)=0 X ^%ZOSF("XY") I $D(XQORM("H")),$L(XQORM("H")) X XQORM("H")
S X=ORUSV D:XQORM(0)["D" DISP^XQORM1 W !
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")
L K DX,DY,J,ORU,ORULT,ORUSV Q
XREF N X,DIC,DIE,DA,DR
S Y=-1 S:'$D(ORULT) ORULT=2
I $P(XQORM,";",2)="DIC(19," D X19 Q
S DIE="^"_$P(XQORM,";",2),DA=+XQORM,DR="99///"_$H
L (^XUTL("XQORM",XQORM),@(DIE_DA_")")):ORULT E S Y=-1 Q
D ^DIE S Y=1 K D,D0,DI,DQ
L Q
X19 L (^XUTL("XQORM",XQORM),^DIC(19,+XQORM)):ORULT E S Y=-1 Q
S DA=+XQORM D SET^XQORMX K DA S Y=1
L Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVALMXQ08 1404 printed Dec 13, 2024@02:10:26 Page 2
VALMXQ08 ; alb/mjk - XQORM for export with LM v1 ; 3/30/93
+1 ;;1;List Manager;;Aug 13, 1993
+2 ;
+3 ;
XQORM ; SLC/KCM - Menu Utility ;2/25/92 16:42
+1 ;;6.7;Sidewinder;;Jan 08, 1993
+2 ;From: XQOR Entry: XQORM,{X} Exit: X,Y,XQORM,{DIROUT}
EN ;Q:'$D(@("^"_$P(XQORM,";",2)_+XQORM_",99)"))
KILL Y
SET Y=-1
if $DATA(XQORM)'=11
QUIT
if $DATA(XQORM(0))[0
QUIT
if XQORM'[";"
QUIT
+1 IF XQORM(0)'["h"
IF $DATA(^XUTL("XQORM",XQORM,0))
IF $PIECE(^(0),"^",1)'=$PIECE(@("^"_$PIECE(XQORM,";",2)_+XQORM_",99)"),"^",1)
DO XREF
+2 IF XQORM(0)'["h"
IF '$DATA(^XUTL("XQORM",XQORM,0))
DO XREF
if Y<0
QUIT
+3 LOCK ^XUTL("XQORM",XQORM,"XQORM PROTECT",$JOB):30
IF '$TEST
WRITE !,"Can't access menu at this time - try again later."
SET Y=-1
QUIT
+4 if $DATA(XQORM("X"))
SET X=XQORM("X")
if $DATA(X)[0
SET X=""
SET ORUSV=X
+5 IF $SELECT('$DATA(IOM):1,'$DATA(IOF):1,'$DATA(IOST):1,'IOM:1,1:0)
SET IOP=$SELECT($DATA(ORIO):ORIO,1:"HOME")
DO ^%ZIS
SET X=ORUSV
+6 SET (DX,DY)=0
XECUTE ^%ZOSF("XY")
IF $DATA(XQORM("H"))
IF $LENGTH(XQORM("H"))
XECUTE XQORM("H")
+7 SET X=ORUSV
if XQORM(0)["D"
DO DISP^XQORM1
WRITE !
+8 FOR ORU=0:0
if XQORM(0)["A"
DO PRMT^XQORM1
SET Y=-1
if '$LENGTH(X)!(X="^")!(X="^^")
QUIT
DO EN^XQORM2
if Y'<0!(XQORM(0)'["A")
QUIT
+9 LOCK
KILL DX,DY,J,ORU,ORULT,ORUSV
QUIT
XREF NEW X,DIC,DIE,DA,DR
+1 SET Y=-1
if '$DATA(ORULT)
SET ORULT=2
+2 IF $PIECE(XQORM,";",2)="DIC(19,"
DO X19
QUIT
+3 SET DIE="^"_$PIECE(XQORM,";",2)
SET DA=+XQORM
SET DR="99///"_$HOROLOG
+4 LOCK (^XUTL("XQORM",XQORM),@(DIE_DA_")")):ORULT
IF '$TEST
SET Y=-1
QUIT
+5 DO ^DIE
SET Y=1
KILL D,D0,DI,DQ
+6 LOCK
QUIT
X19 LOCK (^XUTL("XQORM",XQORM),^DIC(19,+XQORM)):ORULT
IF '$TEST
SET Y=-1
QUIT
+1 SET DA=+XQORM
DO SET^XQORMX
KILL DA
SET Y=1
+2 LOCK
QUIT
