source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQORM1.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1XQORM1 ; SLC/KCM - Display selections & prompt ;12/22/93 14:43
2 ;;8.0;KERNEL;;Jul 10, 1995
3DISP ;From: XQORM
4 N L,M,N,T
5 I $E(X)="?" W ! S (DX,DY)=0 X ^%ZOSF("XY")
6 S T=1 S:$D(^XUTL("XQORM",XQORM,"COL")) T=^("COL") S:'T T=1 S T=IOM\T
7 S M=5 I $D(XQORM("M")),+XQORM("M"),XQORM("M")'>T S M=XQORM("M")
8 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
9 . D:$D(XQORM("S")) SCRN
10 . W ?(J),$P(X,"^",4),?(J+M)
11 . I '$D(XQORM("W")) W $P(X,"^",3)
12 . E X XQORM("W")
13 . S L=$P(I,".")
14 Q
15SCRN Q:$D(XQORM("S"))[0 Q:'$L(XQORM("S")) Q:'+X D SCRN1
16 Q:$T S $P(X,"^",3)="("_$P(X,"^",3)_")"
17 Q
18SCRN1 N DA S DA=+X,DA(1)=+XQORM N I,J,L,M,T,X,Y X XQORM("S") Q
19PRMT ;From: XQORM
20 S ORUPRMT=$S($D(XQORM("A"))[0:"Select Item(s): ",1:XQORM("A"))
21 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
22 K ORUPRMT Q
23PRMT1 S Y=0 W:XQORM(0)'["\" ! W ORUPRMT,$S($D(XQORM("B"))'[0:XQORM("B")_"// ",1:"")
24 I '$L($T(INITKB^XGF)) D
25 . R X:$S($D(DTIME):DTIME,1:300) S:'$T DTOUT=1,X="^"
26 E D ; allow function key use
27 . D INITKB^XGF()
28 . S X=$$READ^XGF()
29 . I $L(XGRT),XGRT'="CR" S X=XGRT S:$D(XQORM("XLATE",X)) X=XQORM("XLATE",X)
30 . D RESETKB^XGF
31 S:'$L(X)&($D(XQORM("B"))'[0) X=XQORM("B")
32 I $D(XQORM("NO^")),X["^"!(X=""),X'?1"^^"1E.E D NU^XQORM4 Q
33 S Y=1 Q
34UP S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
35 Q
36EAT F I=0:0 Q:$E(X)]" " Q:'$L(X) S X=$E(X,2,999)
37 F I=0:0 Q:$E(X,$L(X))]" " Q:'$L(X) S X=$E(X,1,$L(X)-1)
38 Q
39RD S N=0 W ! Q:$Y<(IOSL-2) W !,"Press RETURN to continue or '^' to exit: "
40 N X R X:$S($D(DTIME):DTIME,1:300) S:'$T X="^" S:$E(X)="^" N=1
41 S (DX,DY)=0 X ^%ZOSF("XY") W !!
42 Q
43INHI() ; Switch to highlighted video (IOINHI must be defined by caller)
44 S DX=$X#81,DY=$Y#25 W IOINHI X ^%ZOSF("XY")
45 Q ""
46INLO() ; Switch to lowlighted video (IOINLOW must be defined by caller)
47 S DX=$X#81,DY=$Y#25 W IOINLOW X ^%ZOSF("XY")
48 Q ""
Note: See TracBrowser for help on using the repository browser.