XQORM4.m

XQORM4 ; SLC/KCM - Menu Messages ;10/19/90  14:31 ; [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**62**;Jul 10, 1995

HELP ;From: XQORM1

 Q:XQORM(0)'["A"

 I $D(XQORM("??")) X:$L(XQORM("??")) XQORM("??") Q

 I X="?" D:XQORM(0)'["D" DISP^XQORM1 D HELP1^XQORM5 Q

 D HELP1^XQORM5,HELP2^XQORM5 F I=0:0 W !!,$S(XQORM(0)["D":"Red",1:"D"),"isplay items" S %=1 D YN^DICN Q:%  W !!?4,"Enter a ""Y"" or ""N""."

 D:%=1 DISP^XQORM1 W !

 Q

 ;Error messages  From: XQORM routines

CC W !!,">>>  Control characters and function keys may not be entered.",! Q

LL W !!,">>>  Entry is too long.",! Q

NE W !!,">>>  Only "_+XQORM(0)_$S(+XQORM(0)=1:" entry",1:" entries")_" allowed.",! Q

IR W !!,">>>  Range entered improperly: ",X,".",! Q

LR W !!,">>>  Range too large: ",X,".",! Q

NS W !!,">>>  ",$P(Y(ORUB),"^",3)," may not be selected at this point.",! Q

NN W !!,">>>  The ""-"" may not be used with " D SHO W ".",! Q

NF W !!,ORUW," is not a valid selection.",! Q

SC W !!,">>>  Semi-colon may not be at the front of an item.  To jump, use '^^'.",! Q

NU I $L(XQORM("NO^")),XQORM("NO^")'="OUTOK" W !!,">>>  ",@XQORM("NO^"),! Q

 W !!,">>>  Up-arrow not allowed.",!

 Q

UR W !!,">>>  Unable to resolve ",XQORMSAV,".",! Q

SHO I $D(^XUTL("XQORM",XQORM,ORUDA,0)) W $P(^(0),"^",3)

 Q

ALL ;From: XQORM2

 N X K ^TMP("XQORM",$J)

 S ORUDA=0 F I=0:0 S ORUDA=$O(^XUTL("XQORM",XQORM,ORUDA)) Q:ORUDA'>0  I $D(^(ORUDA,0)),+^(0) S ORUB=1000*$P(ORUDA,".",2)+$P(ORUDA,".",1),^TMP("XQORM",$J,ORUB)=ORUDA

 S ORUB=0 F I=0:0 S ORUB=$O(^TMP("XQORM",$J,ORUB)) Q:ORUB'>0  S ORUDA=+^(ORUB) D UPD^XQORM3

 K ^TMP("XQORM",$J) Q

LAST ;From: XQORM2

 S X="" F I=0:0 S I=$O(^DISV(DUZ,"XQORM",XQORM,I)) Q:I'>0  S X=X_^DISV(DUZ,"XQORM",XQORM,I)_"," I $L(X)>160 K ^DISV(DUZ,"XQORM",XQORM) S X="" Q

 S X=$E(X,1,$L(X)-1) ;I $L(X) W:XQORM(0)["A" X

 Q

XQORM4    ; SLC/KCM - Menu Messages ;10/19/90  14:31 ; [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**62**;Jul 10, 1995

HELP      ;From: XQORM1

 +1        IF XQORM(0)'["A"

               QUIT 

 +2        IF $DATA(XQORM("??"))

               IF $LENGTH(XQORM("??"))

                   XECUTE XQORM("??")

               QUIT 

 +3        IF X="?"

               IF XQORM(0)'["D"

                   DO DISP^XQORM1

               DO HELP1^XQORM5

               QUIT 

 +4        DO HELP1^XQORM5

           DO HELP2^XQORM5

           FOR I=0:0

               WRITE !!,$SELECT(XQORM(0)["D":"Red",1:"D"),"isplay items"

               SET %=1

               DO YN^DICN

               IF %

                   QUIT 

               WRITE !!?4,"Enter a ""Y"" or ""N""."

 +5        IF %=1

               DO DISP^XQORM1

           WRITE !

 +6        QUIT 

 +7       ;Error messages  From: XQORM routines

CC         WRITE !!,">>>  Control characters and function keys may not be entered.",!

           QUIT 

LL         WRITE !!,">>>  Entry is too long.",!

           QUIT 

NE         WRITE !!,">>>  Only "_+XQORM(0)_$SELECT(+XQORM(0)=1:" entry",1:" entries")_" allowed.",!

           QUIT 

IR         WRITE !!,">>>  Range entered improperly: ",X,".",!

           QUIT 

LR         WRITE !!,">>>  Range too large: ",X,".",!

           QUIT 

NS         WRITE !!,">>>  ",$PIECE(Y(ORUB),"^",3)," may not be selected at this point.",!

           QUIT 

NN         WRITE !!,">>>  The ""-"" may not be used with "

           DO SHO

           WRITE ".",!

           QUIT 

NF         WRITE !!,ORUW," is not a valid selection.",!

           QUIT 

SC         WRITE !!,">>>  Semi-colon may not be at the front of an item.  To jump, use '^^'.",!

           QUIT 

NU         IF $LENGTH(XQORM("NO^"))

               IF XQORM("NO^")'="OUTOK"

                   WRITE !!,">>>  ",@XQORM("NO^"),!

                   QUIT 

 +1        WRITE !!,">>>  Up-arrow not allowed.",!

 +2        QUIT 

UR         WRITE !!,">>>  Unable to resolve ",XQORMSAV,".",!

           QUIT 

SHO        IF $DATA(^XUTL("XQORM",XQORM,ORUDA,0))

               WRITE $PIECE(^(0),"^",3)

 +1        QUIT 

ALL       ;From: XQORM2

 +1        NEW X

           KILL ^TMP("XQORM",$JOB)

 +2        SET ORUDA=0

           FOR I=0:0

               SET ORUDA=$ORDER(^XUTL("XQORM",XQORM,ORUDA))

               IF ORUDA'>0

                   QUIT 

               IF $DATA(^(ORUDA,0))

                   IF +^(0)

                       SET ORUB=1000*$PIECE(ORUDA,".",2)+$PIECE(ORUDA,".",1)

                       SET ^TMP("XQORM",$JOB,ORUB)=ORUDA

 +3        SET ORUB=0

           FOR I=0:0

               SET ORUB=$ORDER(^TMP("XQORM",$JOB,ORUB))

               IF ORUB'>0

                   QUIT 

               SET ORUDA=+^(ORUB)

               DO UPD^XQORM3

 +4        KILL ^TMP("XQORM",$JOB)

           QUIT 

LAST      ;From: XQORM2

 +1        SET X=""

           FOR I=0:0

               SET I=$ORDER(^DISV(DUZ,"XQORM",XQORM,I))

               IF I'>0

                   QUIT 

               SET X=X_^DISV(DUZ,"XQORM",XQORM,I)_","

               IF $LENGTH(X)>160

                   KILL ^DISV(DUZ,"XQORM",XQORM)

                   SET X=""

                   QUIT 

 +2       ;I $L(X) W:XQORM(0)["A" X

           SET X=$EXTRACT(X,1,$LENGTH(X)-1)

 +3        QUIT