GMTSXQ10 ; SLC/JER - XQORM4 for Export w/Health Summary ;1/10/92 15:06
;;2.5;Health Summary;;Dec 16, 1992
XQORM4 ; SLC/KCM - Menu Messages ;10/19/90 14:31 ;
;;6.52;Copyright 1990, DVA;
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
SHO I $D(^XUTL("XQORM",XQORM,ORUDA,0)) W $P(^(0),"^",3)
Q
ALL ;From: XQORM2
N X K ^UTILITY("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),^UTILITY("XQORM",$J,ORUB)=ORUDA
S ORUB=0 F I=0:0 S ORUB=$O(^UTILITY("XQORM",$J,ORUB)) Q:ORUB'>0 S ORUDA=+^(ORUB) D UPD^XQORM3
K ^UTILITY("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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXQ10 1859 printed Sep 23, 2025@19:37:17 Page 2
GMTSXQ10 ; SLC/JER - XQORM4 for Export w/Health Summary ;1/10/92 15:06
+1 ;;2.5;Health Summary;;Dec 16, 1992
XQORM4 ; SLC/KCM - Menu Messages ;10/19/90 14:31 ;
+1 ;;6.52;Copyright 1990, DVA;
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
SHO IF $DATA(^XUTL("XQORM",XQORM,ORUDA,0))
WRITE $PIECE(^(0),"^",3)
+1 QUIT
ALL ;From: XQORM2
+1 NEW X
KILL ^UTILITY("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 ^UTILITY("XQORM",$JOB,ORUB)=ORUDA
+3 SET ORUB=0
FOR I=0:0
SET ORUB=$ORDER(^UTILITY("XQORM",$JOB,ORUB))
if ORUB'>0
QUIT
SET ORUDA=+^(ORUB)
DO UPD^XQORM3
+4 KILL ^UTILITY("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
