XQORM1 ; SLC/KCM - Display selections & prompt ;12/22/93 14:43
;;8.0;KERNEL;;Jul 10, 1995
DISP ;From: XQORM
N L,M,N,T
I $E(X)="?" W ! S (DX,DY)=0 X ^%ZOSF("XY")
S T=1 S:$D(^XUTL("XQORM",XQORM,"COL")) T=^("COL") S:'T T=1 S T=IOM\T
S M=5 I $D(XQORM("M")),+XQORM("M"),XQORM("M")'>T S M=XQORM("M")
N X S L=0 F I=0:0 S I=$O(^XUTL("XQORM",XQORM,I)) Q:I'>0 I $D(^(I,0)) S X=^(0),J=($P(I,".",2)-1)*T D:$P(I,".")>L RD Q:N D
. D:$D(XQORM("S")) SCRN
. W ?(J),$P(X,"^",4),?(J+M)
. I '$D(XQORM("W")) W $P(X,"^",3)
. E X XQORM("W")
. S L=$P(I,".")
Q
SCRN Q:$D(XQORM("S"))[0 Q:'$L(XQORM("S")) Q:'+X D SCRN1
Q:$T S $P(X,"^",3)="("_$P(X,"^",3)_")"
Q
SCRN1 N DA S DA=+X,DA(1)=+XQORM N I,J,L,M,T,X,Y X XQORM("S") Q
PRMT ;From: XQORM
S ORUPRMT=$S($D(XQORM("A"))[0:"Select Item(s): ",1:XQORM("A"))
F ORU=0:0 D PRMT1 I Y D:(X'=" ")&(X?.ANP) EAT S:X="^^" DIROUT=1 D:X'?.ANP CC^XQORM4 D:$L(X)>80 LL^XQORM4 Q:($E(X)'="?")&(X?.ANP)&($L(X)'>80) D:$E(X)="?" HELP^XQORM4 I $D(DIROUT) S X="^^" Q
K ORUPRMT Q
PRMT1 S Y=0 W:XQORM(0)'["\" ! W ORUPRMT,$S($D(XQORM("B"))'[0:XQORM("B")_"// ",1:"")
I '$L($T(INITKB^XGF)) D
. R X:$S($D(DTIME):DTIME,1:300) S:'$T DTOUT=1,X="^"
E D ; allow function key use
. D INITKB^XGF()
. S X=$$READ^XGF()
. I $L(XGRT),XGRT'="CR" S X=XGRT S:$D(XQORM("XLATE",X)) X=XQORM("XLATE",X)
. D RESETKB^XGF
S:'$L(X)&($D(XQORM("B"))'[0) X=XQORM("B")
I $D(XQORM("NO^")),X["^"!(X=""),X'?1"^^"1E.E D NU^XQORM4 Q
S Y=1 Q
UP S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
EAT F I=0:0 Q:$E(X)]" " Q:'$L(X) S X=$E(X,2,999)
F I=0:0 Q:$E(X,$L(X))]" " Q:'$L(X) S X=$E(X,1,$L(X)-1)
Q
RD S N=0 W ! Q:$Y<(IOSL-2) W !,"Press RETURN to continue or '^' to exit: "
N X R X:$S($D(DTIME):DTIME,1:300) S:'$T X="^" S:$E(X)="^" N=1
S (DX,DY)=0 X ^%ZOSF("XY") W !!
Q
INHI() ; Switch to highlighted video (IOINHI must be defined by caller)
S DX=$X#81,DY=$Y#25 W IOINHI X ^%ZOSF("XY")
Q ""
INLO() ; Switch to lowlighted video (IOINLOW must be defined by caller)
S DX=$X#81,DY=$Y#25 W IOINLOW X ^%ZOSF("XY")
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQORM1 2098 printed Oct 16, 2024@18:07:06 Page 2
XQORM1 ; SLC/KCM - Display selections & prompt ;12/22/93 14:43
+1 ;;8.0;KERNEL;;Jul 10, 1995
DISP ;From: XQORM
+1 NEW L,M,N,T
+2 IF $EXTRACT(X)="?"
WRITE !
SET (DX,DY)=0
XECUTE ^%ZOSF("XY")
+3 SET T=1
if $DATA(^XUTL("XQORM",XQORM,"COL"))
SET T=^("COL")
if 'T
SET T=1
SET T=IOM\T
+4 SET M=5
IF $DATA(XQORM("M"))
IF +XQORM("M")
IF XQORM("M")'>T
SET M=XQORM("M")
+5 NEW X
SET L=0
FOR I=0:0
SET I=$ORDER(^XUTL("XQORM",XQORM,I))
if I'>0
QUIT
IF $DATA(^(I,0))
SET X=^(0)
SET J=($PIECE(I,".",2)-1)*T
if $PIECE(I,".")>L
DO RD
if N
QUIT
Begin DoDot:1
+6 if $DATA(XQORM("S"))
DO SCRN
+7 WRITE ?(J),$PIECE(X,"^",4),?(J+M)
+8 IF '$DATA(XQORM("W"))
WRITE $PIECE(X,"^",3)
+9 IF '$TEST
XECUTE XQORM("W")
+10 SET L=$PIECE(I,".")
End DoDot:1
+11 QUIT
SCRN if $DATA(XQORM("S"))[0
QUIT
if '$LENGTH(XQORM("S"))
QUIT
if '+X
QUIT
DO SCRN1
+1 if $TEST
QUIT
SET $PIECE(X,"^",3)="("_$PIECE(X,"^",3)_")"
+2 QUIT
SCRN1 NEW DA
SET DA=+X
SET DA(1)=+XQORM
NEW I,J,L,M,T,X,Y
XECUTE XQORM("S")
QUIT
PRMT ;From: XQORM
+1 SET ORUPRMT=$SELECT($DATA(XQORM("A"))[0:"Select Item(s): ",1:XQORM("A"))
+2 FOR ORU=0:0
DO PRMT1
IF Y
if (X'=" ")&(X?.ANP)
DO EAT
if X="^^"
SET DIROUT=1
if X'?.ANP
DO CC^XQORM4
if $LENGTH(X)>80
DO LL^XQORM4
if ($EXTRACT(X)'="?")&(X?.ANP)&($LENGTH(X)'>80)
QUIT
if $EXTRACT(X)="?"
DO HELP^XQORM4
IF $DATA(DIROUT)
SET X="^^"
QUIT
+3 KILL ORUPRMT
QUIT
PRMT1 SET Y=0
if XQORM(0)'["\"
WRITE !
WRITE ORUPRMT,$SELECT($DATA(XQORM("B"))'[0:XQORM("B")_"// ",1:"")
+1 IF '$LENGTH($TEXT(INITKB^XGF))
Begin DoDot:1
+2 READ X:$SELECT($DATA(DTIME):DTIME,1:300)
if '$TEST
SET DTOUT=1
SET X="^"
End DoDot:1
+3 ; allow function key use
IF '$TEST
Begin DoDot:1
+4 DO INITKB^XGF()
+5 SET X=$$READ^XGF()
+6 IF $LENGTH(XGRT)
IF XGRT'="CR"
SET X=XGRT
if $DATA(XQORM("XLATE",X))
SET X=XQORM("XLATE",X)
+7 DO RESETKB^XGF
End DoDot:1
+8 if '$LENGTH(X)&($DATA(XQORM("B"))'[0)
SET X=XQORM("B")
+9 IF $DATA(XQORM("NO^"))
IF X["^"!(X="")
IF X'?1"^^"1E.E
DO NU^XQORM4
QUIT
+10 SET Y=1
QUIT
UP SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+1 QUIT
EAT FOR I=0:0
if $EXTRACT(X)]" "
QUIT
if '$LENGTH(X)
QUIT
SET X=$EXTRACT(X,2,999)
+1 FOR I=0:0
if $EXTRACT(X,$LENGTH(X))]" "
QUIT
if '$LENGTH(X)
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+2 QUIT
RD SET N=0
WRITE !
if $Y<(IOSL-2)
QUIT
WRITE !,"Press RETURN to continue or '^' to exit: "
+1 NEW X
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
if '$TEST
SET X="^"
if $EXTRACT(X)="^"
SET N=1
+2 SET (DX,DY)=0
XECUTE ^%ZOSF("XY")
WRITE !!
+3 QUIT
INHI() ; Switch to highlighted video (IOINHI must be defined by caller)
+1 SET DX=$X#81
SET DY=$Y#25
WRITE IOINHI
XECUTE ^%ZOSF("XY")
+2 QUIT ""
INLO() ; Switch to lowlighted video (IOINLOW must be defined by caller)
+1 SET DX=$X#81
SET DY=$Y#25
WRITE IOINLOW
XECUTE ^%ZOSF("XY")
+2 QUIT ""
