XQORM.m

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 ---XQORM   1536     printed  Apr 09, 2024@21:15:07                                                                                                                                                                                                       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