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>