- XQORM ; SLC/KCM - Menu Utility ;2/25/92 16:42
- ;;8.0;KERNEL;**56**;Jul 10, 1995
- ;From: XQOR Entry: XQORM,{X} Exit: X,Y,XQORM,{DIROUT}
- EN I $D(XQORM("HIJACK")) S XQORM=XQORM("HIJACK") K XQORM("HIJACK")
- 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 I (XQORM(0)["A")!(XQORM(0)["D") 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 -^XUTL("XQORM",XQORM,"XQORM PROTECT",$J)
- 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_+XQORM_")")):ORULT E S Y=-1 Q
- D ^DIE S Y=1 K D,D0,DI,DQ
- L -(^XUTL("XQORM",XQORM),@(DIE_+XQORM_")"))
- 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 -(^XUTL("XQORM",XQORM),^DIC(19,+XQORM))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQORM 1536 printed Jan 18, 2025@03:07:28 Page 2
- XQORM ; SLC/KCM - Menu Utility ;2/25/92 16:42
- +1 ;;8.0;KERNEL;**56**;Jul 10, 1995
- +2 ;From: XQOR Entry: XQORM,{X} Exit: X,Y,XQORM,{DIROUT}
- EN IF $DATA(XQORM("HIJACK"))
- SET XQORM=XQORM("HIJACK")
- KILL XQORM("HIJACK")
- +1 ;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
- +2 IF XQORM(0)'["h"
- IF $DATA(^XUTL("XQORM",XQORM,0))
- IF $PIECE(^(0),"^",1)'=$PIECE(@("^"_$PIECE(XQORM,";",2)_+XQORM_",99)"),"^",1)
- DO XREF
- +3 IF XQORM(0)'["h"
- IF '$DATA(^XUTL("XQORM",XQORM,0))
- DO XREF
- if Y<0
- QUIT
- +4 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
- +5 if $DATA(XQORM("X"))
- SET X=XQORM("X")
- if $DATA(X)[0
- SET X=""
- SET ORUSV=X
- +6 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
- +7 SET (DX,DY)=0
- XECUTE ^%ZOSF("XY")
- IF $DATA(XQORM("H"))
- IF $LENGTH(XQORM("H"))
- XECUTE XQORM("H")
- +8 SET X=ORUSV
- if XQORM(0)["D"
- DO DISP^XQORM1
- IF (XQORM(0)["A")!(XQORM(0)["D")
- WRITE !
- +9 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
- +10 LOCK -^XUTL("XQORM",XQORM,"XQORM PROTECT",$JOB)
- +11 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_+XQORM_")")):ORULT
- IF '$TEST
- SET Y=-1
- QUIT
- +5 DO ^DIE
- SET Y=1
- KILL D,D0,DI,DQ
- +6 LOCK -(^XUTL("XQORM",XQORM),@(DIE_+XQORM_")"))
- +7 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 -(^XUTL("XQORM",XQORM),^DIC(19,+XQORM))
- +3 QUIT