freem_fileman/USER/DDGLIBH.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DDGLIBH.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

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"