Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDGLIBH

DDGLIBH.m

Go to the documentation of this file. 
  1. DDGLIBH ;SFISC/MKO-SCREEN EDITOR HELP ;15NOV2012
  1.  ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1.  ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1.  ;;Licensed under the terms of the Apache License, Version 2.0.
  1.  ;
  1. HLP(DDGLHN1,DDGLHN2,DDGLSUB,DDGLPLN) ;
  1.  ;DDGLHN1  = Entry number in Dialog file of first help screen
  1.  ;DDGLHN2  = Entry number of last help screen
  1.  ;DDGLSUB  = Subscript in ^TMP to copy help to
  1.  ;DDGLPLN  = $Y to print prompt
  1.  ;
  1.  N DX,DY,DDGLI,DDGLJ,DDGLSC,DDGLTX,DDGLX,DIHELP,DDGL0
  1.  S DDGL0=$C(31)
  1.  D:'$D(DDGLH) GETKEY
  1.  I $D(IOTM)[0 N IOTM S IOTM=1
  1.  I $D(IOBM)[0 N IOBM S IOBM=IOSL
  1.  I '$G(DDGLPLN) S DDGLPLN=IOBM-1
  1.  S DDGLSC=DDGLHN1
  1.  ;
  1.  D DISP(DDGLHN1)
  1.  ;
  1.  F  S DDGLX=$$READ D @DDGLX Q:DDGLX=U
  1.  Q
  1.  ;
  1. UP I DDGLSC>DDGLHN1 S DDGLSC=DDGLSC-1 D DISP(DDGLSC)
  1.  Q
  1.  ;
  1. DN I DDGLSC<DDGLHN2 S DDGLSC=DDGLSC+1 D DISP(DDGLSC)
  1.  Q
  1.  ;
  1. TO W $C(7)
  1. QT S DDGLX=U
  1.  Q
  1.  ;
  1. PT ;Prompt for device and print
  1.  ;Clear screen
  1.  N POP
  1.  N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%K,%M,%N
  1.  N %P,%S,%T,%W,%X,%Y
  1.  N %A0,%D1,%D2,%DT,%J1,%W0
  1.  ;
  1.  S DY=IOTM-1,DX=0 X IOXY
  1.  W $P(DDGLVID,DDGLDEL)_"PRINT THE HELP SCREENS"_$P(DDGLVID,DDGLDEL,10)_$P(DDGLCLR,DDGLDEL)
  1.  F DDGLI=1:1:IOBM-IOTM W $C(13,10)_$P(DDGLCLR,DDGLDEL)
  1.  S DY=IOTM+1,DX=0 X IOXY
  1.  ;
  1.  X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
  1.  S X=$G(IOM,80) X DDGLZOSF("RM") ; VEN/SMH changed.
  1.  W $P(DDGLVID,DDGLDEL,9)
  1.  ;
  1. DEVICE ;Device prompt
  1.  N IOF,IOSL
  1.  S IOF="#",IOSL=IOBM-IOTM+1 ;In case help frames are invoked
  1.  S %ZIS=$S($D(^%ZTSK):"Q",1:""),%ZIS("B")=""
  1.  D ^%ZIS K %ZIS
  1.  ;
  1.  I POP D
  1.  . W !!,"Report canceled!"
  1.  . H 2
  1.  ;
  1.  ;Queue report
  1.  E  I $D(IO("Q")),$D(^%ZTSK) D
  1.  . S ZTRTN="PRINT^DDGLIBH"
  1.  . S ZTDESC="Help screen printout."
  1.  . N I F I="DDGLHN1","DDGLHN2" S ZTSAVE(I)=""
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_ZTSK,!
  1.  . E  W !,"Report canceled!",!
  1.  . K ZTSK
  1.  . S IOP="HOME" D ^%ZIS
  1.  ;
  1.  E  I $E(IOST,1,2)="C-" D
  1.  . W !,$C(7)_"You cannot print the help screens on a CRT.",!
  1.  . H 2
  1.  ;
  1.  ;Non-queued report
  1.  E  D
  1.  . W !,"Printing ..."
  1.  . U IO
  1.  . D PRINT
  1.  . X $G(^%ZIS("C"))
  1.  ;
  1.  ;Repaint help screen
  1.  X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
  1.  S X=0 X DDGLZOSF("RM") ; VEN/SMH changed.
  1.  W $P(DDGLVID,DDGLDEL,8)
  1.  D DISP(DDGLSC)
  1.  Q
  1.  ;
  1. PRINT ;
  1.  N DDGLJ,DDGLL,DDGLP
  1.  F DDGLI=DDGLHN1:1:DDGLHN2 D
  1.  . I DDGLI'=DDGLHN1 D
  1.  .. I $Y+$O(^DI(.84,DDGLI,2," "),-1)+2'<IOSL W @IOF
  1.  .. E  W !!
  1.  . S DDGLJ=0
  1.  . F  S DDGLJ=$O(^DI(.84,DDGLI,2,DDGLJ)) Q:'DDGLJ  D
  1.  .. S DDGLL=$G(^DI(.84,DDGLI,2,DDGLJ,0))
  1.  .. F  Q:DDGLL'["\"  D
  1.  ... S DDGLP=$F(DDGLL,"\") Q:$E(DDGLL,DDGLP)="\"
  1.  ... S $E(DDGLL,DDGLP-1,DDGLP)=""
  1.  .. W !,DDGLL
  1.  ;
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. DISP(DDGLHN) ;Print help screen DDGLHN
  1.  N DDGLHARR
  1.  S DDGLHARR=$NA(^TMP(DDGLSUB,$J,DDGLHN))
  1.  D:'$D(@DDGLHARR) BLD^DIALOG(DDGLHN,"","",DDGLHARR)
  1.  ;
  1.  S DY=IOTM-1,DX=0 X IOXY
  1.  F DDGLI=1:1 Q:'$D(@DDGLHARR@(DDGLI))  S DDGLTX=^(DDGLI) D
  1.  . I DDGLTX["\B" F  S DDGLJ=$F(DDGLTX,"\B") Q:'DDGLJ  D
  1.  .. S $E(DDGLTX,DDGLJ-2,DDGLJ-1)=$P(DDGLVID,DDGLDEL)
  1.  . I DDGLTX["\n" F  S DDGLJ=$F(DDGLTX,"\n") Q:'DDGLJ  D
  1.  .. S $E(DDGLTX,DDGLJ-2,DDGLJ-1)=$P(DDGLVID,DDGLDEL,10)
  1.  . W $S(DDGLI>1:$C(13,10),1:"")_DDGLTX_$P(DDGLCLR,DDGLDEL)
  1.  ;
  1.  F DDGLI=DDGLI:1:IOBM-IOTM+1 W $C(13,10)_$P(DDGLCLR,DDGLDEL)
  1.  Q
  1.  ;
  1. READ() ;
  1.  S DY=DDGLPLN,DX=0 X IOXY
  1.  W $P(DDGLCLR,DDGLDEL)_"Press "
  1.  W:DDGLSC>DDGLHN1 $P(DDGLVID,DDGLDEL)_"<Up>"_$P(DDGLVID,DDGLDEL,10)_" for previous page, "
  1.  W:DDGLSC<DDGLHN2 $P(DDGLVID,DDGLDEL)_"<Down>"_$P(DDGLVID,DDGLDEL,10)_" for next page, "
  1.  W $P(DDGLVID,DDGLDEL)_"P"_$P(DDGLVID,DDGLDEL,10)_" to print, "
  1.  W $P(DDGLVID,DDGLDEL)_"^"_$P(DDGLVID,DDGLDEL,10)_" to exit: "
  1.  D GETCH(DTIME,.DDGLX)
  1.  S DY=DDGLPLN,DX=0 X IOXY W $P(DDGLCLR,DDGLDEL)
  1.  Q DDGLX
  1.  ;
  1. GETCH(DTIME,Y) ;Out: Y = Mnemonic
  1.  F  D  Q:Y'=-1
  1.  . R *Y:DTIME
  1.  . I Y<0 S Y="TO" Q
  1.  . D MNE(.Y)
  1.  Q
  1.  ;
  1. MNE(Y) ;Out: Y = Mnemonic, or -1 if invalid
  1.  N S,F
  1.  S S="",F=0
  1.  F  D MNELOOP Q:F
  1.  Q
  1.  ;
  1. MNELOOP ;Read more
  1.  S S=S_$C(Y)
  1.  I DDGLH("IN")'[(DDGL0_S) D  I Y=-1 D FLUSH Q
  1.  . I $C(Y)'?1L S Y=-1 Q
  1.  . S S=$E(S,1,$L(S)-1)_$C(Y-32)
  1.  . S:DDGLH("IN")'[(DDGL0_S_DDGL0) Y=-1
  1.  ;
  1.  I DDGLH("IN")[(DDGL0_S_DDGL0),S'=$C(27) D  Q
  1.  . S Y=$P(DDGLH("OUT"),DDGL0,$L($P(DDGLH("IN"),DDGL0_S_DDGL0),DDGL0)),F=1
  1.  ;
  1.  R *Y:5 D:Y=-1 FLUSH
  1.  Q
  1.  ;
  1. FLUSH ;
  1.  N DDGLZ
  1.  S F=1 W $C(7) F  R *DDGLZ:0 E  Q
  1.  Q
  1.  ;
  1. GETKEY ;Get key sequences and defaults
  1.  N AU,AD,F1,PREVSC,NEXTSC
  1.  N I,K,N,T
  1.  S AU=$P(DDGLKEY,U,2)
  1.  S AD=$P(DDGLKEY,U,3)
  1.  S F1=$P(DDGLKEY,U,6)
  1.  S PREVSC=$P(DDGLKEY,U,14)
  1.  S NEXTSC=$P(DDGLKEY,U,15)
  1.  ;
  1.  K DDGLH
  1.  S DDGLH("IN")="",DDGLH("OUT")=""
  1.  F I=1:1 S T=$P($T(MAP+I),";;",2,999) Q:T=""  D
  1.  . S @("K="_$P(T,";",2))
  1.  . I DDGLH("IN")'[(DDGL0_K),K]"" D
  1.  .. S DDGLH("IN")=DDGLH("IN")_DDGL0_K
  1.  .. S DDGLH("OUT")=DDGLH("OUT")_$P(T,";")_DDGL0
  1.  S DDGLH("IN")=DDGLH("IN")_DDGL0
  1.  S DDGLH("OUT")=$E(DDGLH("OUT"),1,$L(DDGLH("OUT"))-1)
  1.  Q
  1.  ;
  1. MAP ;Keys
  1.  ;;DN;$C(13)
  1.  ;;DN;AD
  1.  ;;DN;F1_AD
  1.  ;;DN;NEXTSC
  1.  ;;UP;AU
  1.  ;;UP;F1_AU
  1.  ;;UP;PREVSC
  1.  ;;QT;F1_"E"
  1.  ;;QT;F1_"Q"
  1.  ;;QT;"^"
  1.  ;;PT;"P"