Annotation of freem_fileman/USER/DDGLIBH.m, revision 1.1
1.1 ! snw 1: DDGLIBH ;SFISC/MKO-SCREEN EDITOR HELP ;09:32 AM 30 Nov 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ;
! 5: HLP(DDGLHN1,DDGLHN2,DDGLSUB,DDGLPLN) ;
! 6: ;DDGLHN1 = Entry number in Dialog file of first help screen
! 7: ;DDGLHN2 = Entry number of last help screen
! 8: ;DDGLSUB = Subscript in ^TMP to copy help to
! 9: ;DDGLPLN = $Y to print prompt
! 10: ;
! 11: N DX,DY,DDGLI,DDGLJ,DDGLSC,DDGLTX,DDGLX,DIHELP,DDGL0
! 12: S DDGL0=$C(31)
! 13: D:'$D(DDGLH) GETKEY
! 14: I $D(IOTM)[0 N IOTM S IOTM=1
! 15: I $D(IOBM)[0 N IOBM S IOBM=IOSL
! 16: I '$G(DDGLPLN) S DDGLPLN=IOBM-1
! 17: S DDGLSC=DDGLHN1
! 18: ;
! 19: D DISP(DDGLHN1)
! 20: ;
! 21: F S DDGLX=$$READ D @DDGLX Q:DDGLX=U
! 22: Q
! 23: ;
! 24: UP I DDGLSC>DDGLHN1 S DDGLSC=DDGLSC-1 D DISP(DDGLSC)
! 25: Q
! 26: ;
! 27: DN I DDGLSC<DDGLHN2 S DDGLSC=DDGLSC+1 D DISP(DDGLSC)
! 28: Q
! 29: ;
! 30: TO W $C(7)
! 31: QT S DDGLX=U
! 32: Q
! 33: ;
! 34: PT ;Prompt for device and print
! 35: ;Clear screen
! 36: N POP
! 37: N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%K,%M,%N
! 38: N %P,%S,%T,%W,%X,%Y
! 39: N %A0,%D1,%D2,%DT,%J1,%W0
! 40: ;
! 41: S DY=IOTM-1,DX=0 X IOXY
! 42: W $P(DDGLVID,DDGLDEL)_"PRINT THE HELP SCREENS"_$P(DDGLVID,DDGLDEL,10)_$P(DDGLCLR,DDGLDEL)
! 43: F DDGLI=1:1:IOBM-IOTM W $C(13,10)_$P(DDGLCLR,DDGLDEL)
! 44: S DY=IOTM+1,DX=0 X IOXY
! 45: ;
! 46: X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
! 47: S X=$G(IOM,80) X ^%ZOSF("RM")
! 48: W $P(DDGLVID,DDGLDEL,9)
! 49: ;
! 50: DEVICE ;Device prompt
! 51: S %ZIS=$S($D(^%ZTSK):"Q",1:""),%ZIS("B")=""
! 52: D ^%ZIS K %ZIS
! 53: ;
! 54: I POP D
! 55: . W !!,"Report canceled!"
! 56: . H 2
! 57: ;
! 58: ;Queue report
! 59: E I $D(IO("Q")),$D(^%ZTSK) D
! 60: . S ZTRTN="PRINT^DDGLIBH"
! 61: . S ZTDESC="Help screen printout."
! 62: . N I F I="DDGLHN1","DDGLHN2" S ZTSAVE(I)=""
! 63: . D ^%ZTLOAD
! 64: . I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_ZTSK,!
! 65: . E W !,"Report canceled!",!
! 66: . K ZTSK
! 67: . S IOP="HOME" D ^%ZIS
! 68: ;
! 69: E I $E(IOST,1,2)="C-" D G DEVICE
! 70: . W !,$C(7)_"You cannot print the help screens on a CRT.",!
! 71: ;
! 72: ;Non-queued report
! 73: E D
! 74: . W !,"Printing ..."
! 75: . U IO
! 76: . D PRINT
! 77: . X $G(^%ZIS("C"))
! 78: ;
! 79: ;Repaint help screen
! 80: X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
! 81: S X=0 X ^%ZOSF("RM")
! 82: W $P(DDGLVID,DDGLDEL,8)
! 83: D DISP(DDGLSC)
! 84: Q
! 85: ;
! 86: PRINT ;
! 87: N DDGLJ,DDGLL,DDGLP
! 88: F DDGLI=DDGLHN1:1:DDGLHN2 D
! 89: . W:DDGLI'=DDGLHN1 @IOF
! 90: . S DDGLJ=0
! 91: . F S DDGLJ=$O(^DI(.84,DDGLI,2,DDGLJ)) Q:'DDGLJ D
! 92: .. S DDGLL=$G(^DI(.84,DDGLI,2,DDGLJ,0))
! 93: .. F Q:DDGLL'["\" D
! 94: ... S DDGLP=$F(DDGLL,"\") Q:$E(DDGLL,DDGLP)="\"
! 95: ... S $E(DDGLL,DDGLP-1,DDGLP)=""
! 96: .. W !,DDGLL
! 97: ;
! 98: S:$D(ZTQUEUED) ZTREQ="@"
! 99: Q
! 100: ;
! 101: DISP(DDGLHN) ;Print help screen DDGLHN
! 102: N DDGLHARR
! 103: S DDGLHARR=$NA(^TMP(DDGLSUB,$J,DDGLHN))
! 104: D:'$D(@DDGLHARR) BLD^DIALOG(DDGLHN,"","",DDGLHARR)
! 105: ;
! 106: S DY=IOTM-1,DX=0 X IOXY
! 107: F DDGLI=1:1 Q:'$D(@DDGLHARR@(DDGLI)) S DDGLTX=^(DDGLI) D
! 108: . I DDGLTX["\B" F S DDGLJ=$F(DDGLTX,"\B") Q:'DDGLJ D
! 109: .. S $E(DDGLTX,DDGLJ-2,DDGLJ-1)=$P(DDGLVID,DDGLDEL)
! 110: . I DDGLTX["\n" F S DDGLJ=$F(DDGLTX,"\n") Q:'DDGLJ D
! 111: .. S $E(DDGLTX,DDGLJ-2,DDGLJ-1)=$P(DDGLVID,DDGLDEL,10)
! 112: . W $S(DDGLI>1:$C(13,10),1:"")_DDGLTX_$P(DDGLCLR,DDGLDEL)
! 113: ;
! 114: F DDGLI=DDGLI:1:IOBM-IOTM+1 W $C(13,10)_$P(DDGLCLR,DDGLDEL)
! 115: Q
! 116: ;
! 117: READ() ;
! 118: S DY=DDGLPLN,DX=0 X IOXY
! 119: W $P(DDGLCLR,DDGLDEL)_"Press "
! 120: W:DDGLSC>DDGLHN1 $P(DDGLVID,DDGLDEL)_"<Up>"_$P(DDGLVID,DDGLDEL,10)_" for previous page, "
! 121: W:DDGLSC<DDGLHN2 $P(DDGLVID,DDGLDEL)_"<Down>"_$P(DDGLVID,DDGLDEL,10)_" for next page, "
! 122: W $P(DDGLVID,DDGLDEL)_"P"_$P(DDGLVID,DDGLDEL,10)_" to print, "
! 123: W $P(DDGLVID,DDGLDEL)_"^"_$P(DDGLVID,DDGLDEL,10)_" to exit: "
! 124: D GETCH(DTIME,.DDGLX)
! 125: S DY=DDGLPLN,DX=0 X IOXY W $P(DDGLCLR,DDGLDEL)
! 126: Q DDGLX
! 127: ;
! 128: GETCH(DTIME,Y) ;Out: Y = Mnemonic
! 129: F D Q:Y'=-1
! 130: . R *Y:DTIME
! 131: . I Y<0 S Y="TO" Q
! 132: . D MNE(.Y)
! 133: Q
! 134: ;
! 135: MNE(Y) ;Out: Y = Mnemonic, or -1 if invalid
! 136: N S,F
! 137: S S="",F=0
! 138: F D MNELOOP Q:F
! 139: Q
! 140: ;
! 141: MNELOOP ;Read more
! 142: S S=S_$C(Y)
! 143: I DDGLH("IN")'[(DDGL0_S) D I Y=-1 D FLUSH Q
! 144: . I $C(Y)'?1L S Y=-1 Q
! 145: . S S=$E(S,1,$L(S)-1)_$C(Y-32)
! 146: . S:DDGLH("IN")'[(DDGL0_S_DDGL0) Y=-1
! 147: ;
! 148: I DDGLH("IN")[(DDGL0_S_DDGL0),S'=$C(27) D Q
! 149: . S Y=$P(DDGLH("OUT"),DDGL0,$L($P(DDGLH("IN"),DDGL0_S_DDGL0),DDGL0)),F=1
! 150: ;
! 151: R *Y:5 D:Y=-1 FLUSH
! 152: Q
! 153: ;
! 154: FLUSH ;
! 155: N DDGLZ
! 156: S F=1 W $C(7) F R *DDGLZ:0 E Q
! 157: Q
! 158: ;
! 159: GETKEY ;Get key sequences and defaults
! 160: N AU,AD,F1,PREVSC,NEXTSC
! 161: N I,K,N,T
! 162: S AU=$P(DDGLKEY,U,2)
! 163: S AD=$P(DDGLKEY,U,3)
! 164: S F1=$P(DDGLKEY,U,6)
! 165: S PREVSC=$P(DDGLKEY,U,14)
! 166: S NEXTSC=$P(DDGLKEY,U,15)
! 167: ;
! 168: K DDGLH
! 169: S DDGLH("IN")="",DDGLH("OUT")=""
! 170: F I=1:1 S T=$P($T(MAP+I),";;",2,999) Q:T="" D
! 171: . S @("K="_$P(T,";",2))
! 172: . I DDGLH("IN")'[(DDGL0_K),K]"" D
! 173: .. S DDGLH("IN")=DDGLH("IN")_DDGL0_K
! 174: .. S DDGLH("OUT")=DDGLH("OUT")_$P(T,";")_DDGL0
! 175: S DDGLH("IN")=DDGLH("IN")_DDGL0
! 176: S DDGLH("OUT")=$E(DDGLH("OUT"),1,$L(DDGLH("OUT"))-1)
! 177: Q
! 178: ;
! 179: MAP ;Keys
! 180: ;;DN;$C(13)
! 181: ;;DN;AD
! 182: ;;DN;F1_AD
! 183: ;;DN;NEXTSC
! 184: ;;UP;AU
! 185: ;;UP;F1_AU
! 186: ;;UP;PREVSC
! 187: ;;QT;F1_"E"
! 188: ;;QT;F1_"Q"
! 189: ;;QT;"^"
! 190: ;;PT;"P"
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>