- XQORM1 ; SLC/KCM - Display selections & prompt ;12/22/93 14:43 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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 ""
- XQORM1 ; SLC/KCM - Display selections & prompt ;12/22/93 14:43 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;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 ""
