DDGLIB0 ;SFISC/MKO - SETUP AND CLEANUP FOR WINDOWS ;14JUN2016
;;22.2;VA FileMan;**3**;Jan 05, 2016;Build 17
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
INIT(DDGLBROW) ;Setup required variables
;Set margin to 0
;Turn autowrap off
;Turn type-ahead on
;Variables set:
; DDGLDEL = delimiter for other DDGL variables
; DDGLVID = codes that turn on/off video attributes
; DDGLED = codes for editing
; DDGLCLR = codes to erase characters
; DDGLGRA = codes for graphics characters
; DDGLZOSF = array of code from %ZOSF (as of V22.2 - array comes from OS file)
; DDGLREF = global where window image is stored
; DDGLKEY = codes for non-alphanumeric keys
; DDGLSCR = array containing list of visible windows on screen
;
N X
I $D(DDGLDEL)[0 D SET Q:$G(DIERR)
S X=0 X DDGLZOSF("RM"),DDGLZOSF("TYPE-AHEAD")
W $P(DDGLVID,DDGLDEL,8)
Q
;
SET ;Setup screen handling variables
K DIERR,DDGLSCR
S U="^",DDGLDEL=$C(127)
;
; VEN/SMH - remove reliance on %ZOSF node -- next 3 lines changed v 22.2
D:'$D(DISYS) OS^DII ; garb OS from %ZOSF or Fileman in this sequence
F X="EOFF","EON","TRMOFF","TRMON","TRMRD","RM","TYPE-AHEAD","NO-TYPE-AHEAD" D G:$G(DIERR) ABT
. S DDGLZOSF(X)=$G(^DD("OS",DISYS,X))
;
ZIS N %ZIS,IOP S IOP="HOME" D ^%ZIS I POP D BLD^DIALOG(845) G ABT
I $D(^%ZIS(2)),'$O(^%ZIS(2,+$G(IOST(0)),0)) D BLD^DIALOG(840,"#"_+$G(IOST(0))) G ABT
;
D:$G(IOXY)="" TRMERR("Cursor positioning (XY CRT)")
;
S X="IORVON;IORVOFF;IOELEOL;IOEDEOP;IOUON;IOUOFF;IOSGR0;IOINHI;IOINLOW;IOINORM;IOCUU;IOCUD;IOCUF;IOCUB;IODL;IOIL;IODCH;IOICH;IOEDALL;IOELALL;IORI;IOAWM1;IOAWM0;IOSTBM;IOPF1;IOPF2;IOPF3;IOPF4;IOFIND;IOSELECT;IOINSERT;IOREMOVE;IOPREVSC;IONEXTSC"
N @$TR(X,";",",")
N IOBLC,IOBRC,IOBT,IOG1,IOG0,IOHL,IOLT,IOMT,IORT,IOTLC,IOTRC,IOTT,IOVL
D ENDR^%ZISS,GSET^%ZISS
I $G(IOPREVSC)="" D ;"^C-VT220^C-VT320^"[(U_IOST_U) D IOST MIGHT BE VT-100
. S IOPREVSC=$C(27)_"[5~"
. S IONEXTSC=$C(27)_"[6~"
;
ATT ;GET COLOR ATTRIBUTES FOR SCREENMAN...
N A,B I '$D(DDGLBROW) D ;...BUT NOT FOR THE BROWSER (see INIT+1^DDBR)
.S A(1)=$C(27,91)_"40m",A(2)=$C(27,91)_"41m",A(3)=$C(27,91)_"45m" ;Defaults
.I $G(^XTV(8989.5,0))?1"PARAM".E F X=1,2,3 S A=$$GET^XPAR("ALL","DI SCREENMAN COLORS",X),B=$$GET^XPAR("ALL","DI SCREENMAN COLORS",X+3) S:B]"" A(X)=$C(27,91)_(10+B)_"m" S:A]"" A(X)=A(X)_$C(27,91)_+A_"m"
.S IOUON=IOINHI_A(1) ;REQ CAPTION BACKGROUND (BLACK)
.S IOINHI=IOINHI_A(2) ;DATA BACKGROUND (RED)
.S IORVON=IOINHI_A(3) ;CLICKABLE BACKGROUND (MAGENTA)
.S (IORVOFF,IOUOFF)=IOINORM
S DDGLVID=IOINHI_DDGLDEL_IOINLOW_DDGLDEL_IOINORM_DDGLDEL_IOUON_DDGLDEL_IOUOFF_DDGLDEL_IORVON_DDGLDEL_IORVOFF_DDGLDEL_IOAWM0_DDGLDEL_IOAWM1_DDGLDEL_$G(IOSGR0)
S DDGLED=$G(IORI)_DDGLDEL_$G(IOSTBM)_DDGLDEL_$G(IOIL)_DDGLDEL_$G(IODL)_DDGLDEL_$G(IOICH)_DDGLDEL_$G(IODCH)
S DDGLCLR=IOELEOL_DDGLDEL_IOEDALL_DDGLDEL_IOEDEOP_DDGLDEL_$G(IOELALL)
S DDGLKEY=U_IOCUU_U_IOCUD_U_IOCUF_U_IOCUB_U_IOPF1_U_IOPF2_U_IOPF3_U_IOPF4_U_$G(IOFIND)_U_$G(IOSELECT)_U_$G(IOINSERT)_U_$G(IOREMOVE)_U_$G(IOPREVSC)_U_$G(IONEXTSC)_U
S DDGLGRA=IOG1_DDGLDEL_IOG0_DDGLDEL_IOHL_DDGLDEL_IOVL_DDGLDEL_IOTLC_DDGLDEL_IOTRC_DDGLDEL_IOBLC_DDGLDEL_IOBRC
S:DDGLDEL_$P(DDGLGRA,DDGLDEL,3,999)_DDGLDEL[(DDGLDEL_DDGLDEL) DDGLGRA=DDGLDEL_DDGLDEL_"-"_DDGLDEL_"|"_DDGLDEL_"+"_DDGLDEL_"+"_DDGLDEL_"+"_DDGLDEL_"+"
;
D:$P(DDGLKEY,U,1,5)_U[(U_U) TRMERR("Cursor keys")
D:U_$P(DDGLKEY,U,6,9)_U[(U_U) TRMERR("PF keys")
D:IOELEOL="" TRMERR("Erase to End of Line")
D:IOEDALL="" TRMERR("Erase Entire Page")
D:IOEDEOP="" TRMERR("Erase to End of Page")
G:$G(DIERR) ABT
;
S DDGLREF="^TMP(""DDGL"",$J,""W"")" K @DDGLREF
;
I "^C-QUME^C-QVT102^C-WYSE75^"[(U_$TR(IOST," ","")_U) D
. S DDGLVAN=1
. S $P(DDGLVID,DDGLDEL,4,7)=$S($TR(IOST," ","")="C-WYSE75":IOINHI_DDGLDEL_IOINLOW_DDGLDEL_IOINHI_DDGLDEL_IOINLOW,1:IOINLOW_DDGLDEL_IOINHI_DDGLDEL_IOINLOW_DDGLDEL_IOINHI)
. S $P(DDGLVID,DDGLDEL,10)=IOINORM
;
D:'$D(^%ZTSK)!($D(^%ZOSF("MGR"))[0) KILL^%ZISS
MOUSEON ;I $G(DDS)>0 W *27,"[?1000h" NOW DONE IN DDS0
Q
;
;
ASKIOSL ; not used
;N X
;X ^%ZOSF("EOFF")
R X:0 S XX=""
W $C(27)_7_$C(27)_"[r"_$C(27)_"[999;999H"_$C(27)_"[6n" R X ; R *X:1 R:$T XX S X=$C(X)_XX
;S X=+$E(X,3,5) I X S IOSL=X
Q
;
;
;
TRMERR(DDGLCH) ;Terminal type errors
N P
S P(1)=DDGLCH,P(2)=IOST
D BLD^DIALOG(842,.P)
Q
;
;
;
KILL(DDGLPARM) ;Cleanup variables
;Set margin to IOM
;Turn off type-ahead if New Person file so indicates
;Turn autowrap on
;Reset character attributes
;Turn echo on
;Turn terminators off
N X
D:'$D(DISYS) OS^DII ; garb OS from %ZOSF or Fileman in this sequence
I $G(DDGLPARM)'["W" D
. S X=$S($D(IOM)#2:IOM,1:80) X $G(DDGLZOSF("RM"))
. I $D(DUZ)#2,$D(^VA(200,DUZ,0))#2,$P($G(^(200)),U,9)'="Y" D
.. I '$G(DUZ("BUF"),1) X $G(DDGLZOSF("NO-TYPE-AHEAD"))
. W $P($G(DDGLVID),$G(DDGLDEL),9),$P($G(DDGLVID),$G(DDGLDEL),10)
;
I $G(DDGLPARM)'["T" D
. X $G(DDGLZOSF("EON")),$G(DDGLZOSF("TRMOFF"))
E X $G(DDGLZOSF("EOFF")),$G(DDGLZOSF("TRMON"))
;
MOUSEOFF ;W *27,"[?1000l" NOW DONE IN DDS0
ABT K DX,DY,POP
I '$G(DIERR),$G(DDGLPARM)["K" Q
K:$G(DDGLREF)]"" @DDGLREF
D:'$D(^%ZTSK)!($D(^%ZOSF("MGR"))[0) KILL^%ZISS
;
K DDGLDEL,DDGLVID,DDGLED,DDGLCLR,DDGLGRA,DDGLZOSF,DDGLREF
K DDGLKEY,DDGLSCR,DDGLVAN,DDGLH
;
K DIR0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGLIB0 5544 printed Jan 18, 2025@03:43:34 Page 2
DDGLIB0 ;SFISC/MKO - SETUP AND CLEANUP FOR WINDOWS ;14JUN2016
+1 ;;22.2;VA FileMan;**3**;Jan 05, 2016;Build 17
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
INIT(DDGLBROW) ;Setup required variables
+1 ;Set margin to 0
+2 ;Turn autowrap off
+3 ;Turn type-ahead on
+4 ;Variables set:
+5 ; DDGLDEL = delimiter for other DDGL variables
+6 ; DDGLVID = codes that turn on/off video attributes
+7 ; DDGLED = codes for editing
+8 ; DDGLCLR = codes to erase characters
+9 ; DDGLGRA = codes for graphics characters
+10 ; DDGLZOSF = array of code from %ZOSF (as of V22.2 - array comes from OS file)
+11 ; DDGLREF = global where window image is stored
+12 ; DDGLKEY = codes for non-alphanumeric keys
+13 ; DDGLSCR = array containing list of visible windows on screen
+14 ;
+15 NEW X
+16 IF $DATA(DDGLDEL)[0
DO SET
if $GET(DIERR)
QUIT
+17 SET X=0
XECUTE DDGLZOSF("RM")
XECUTE DDGLZOSF("TYPE-AHEAD")
+18 WRITE $PIECE(DDGLVID,DDGLDEL,8)
+19 QUIT
+20 ;
SET ;Setup screen handling variables
+1 KILL DIERR,DDGLSCR
+2 SET U="^"
SET DDGLDEL=$CHAR(127)
+3 ;
+4 ; VEN/SMH - remove reliance on %ZOSF node -- next 3 lines changed v 22.2
+5 ; garb OS from %ZOSF or Fileman in this sequence
if '$DATA(DISYS)
DO OS^DII
+6 FOR X="EOFF","EON","TRMOFF","TRMON","TRMRD","RM","TYPE-AHEAD","NO-TYPE-AHEAD"
Begin DoDot:1
+7 SET DDGLZOSF(X)=$GET(^DD("OS",DISYS,X))
End DoDot:1
if $GET(DIERR)
GOTO ABT
+8 ;
ZIS NEW %ZIS,IOP
SET IOP="HOME"
DO ^%ZIS
IF POP
DO BLD^DIALOG(845)
GOTO ABT
+1 IF $DATA(^%ZIS(2))
IF '$ORDER(^%ZIS(2,+$GET(IOST(0)),0))
DO BLD^DIALOG(840,"#"_+$GET(IOST(0)))
GOTO ABT
+2 ;
+3 if $GET(IOXY)=""
DO TRMERR("Cursor positioning (XY CRT)")
+4 ;
+5 SET X="IORVON;IORVOFF;IOELEOL;IOEDEOP;IOUON;IOUOFF;IOSGR0;IOINHI;IOINLOW;IOINORM;IOCUU;IOCUD;IOCUF;IOCUB;IODL;IOIL;IODCH;IOICH;IOEDALL;IOELALL;IORI;IOAWM1;IOAWM0;IOSTBM;IOPF1;IOPF2;IOPF3;IOPF4;IOFIND;IOSELECT;IOINSERT;IOREMOVE;IOPREVSC;IONEXTSC
"
+6 NEW @$TRANSLATE(X,";",",")
+7 NEW IOBLC,IOBRC,IOBT,IOG1,IOG0,IOHL,IOLT,IOMT,IORT,IOTLC,IOTRC,IOTT,IOVL
+8 DO ENDR^%ZISS
DO GSET^%ZISS
+9 ;"^C-VT220^C-VT320^"[(U_IOST_U) D IOST MIGHT BE VT-100
IF $GET(IOPREVSC)=""
Begin DoDot:1
+10 SET IOPREVSC=$CHAR(27)_"[5~"
+11 SET IONEXTSC=$CHAR(27)_"[6~"
End DoDot:1
+12 ;
ATT ;GET COLOR ATTRIBUTES FOR SCREENMAN...
+1 ;...BUT NOT FOR THE BROWSER (see INIT+1^DDBR)
NEW A,B
IF '$DATA(DDGLBROW)
Begin DoDot:1
+2 ;Defaults
SET A(1)=$CHAR(27,91)_"40m"
SET A(2)=$CHAR(27,91)_"41m"
SET A(3)=$CHAR(27,91)_"45m"
+3 IF $GET(^XTV(8989.5,0))?1"PARAM".E
FOR X=1,2,3
SET A=$$GET^XPAR("ALL","DI SCREENMAN COLORS",X)
SET B=$$GET^XPAR("ALL","DI SCREENMAN COLORS",X+3)
if B]""
SET A(X)=$CHAR(27,91)_(10+B)_"m"
if A]""
SET A(X)=A(X)_$CHAR(27,91)_+A_"m"
+4 ;REQ CAPTION BACKGROUND (BLACK)
SET IOUON=IOINHI_A(1)
+5 ;DATA BACKGROUND (RED)
SET IOINHI=IOINHI_A(2)
+6 ;CLICKABLE BACKGROUND (MAGENTA)
SET IORVON=IOINHI_A(3)
+7 SET (IORVOFF,IOUOFF)=IOINORM
End DoDot:1
+8 SET DDGLVID=IOINHI_DDGLDEL_IOINLOW_DDGLDEL_IOINORM_DDGLDEL_IOUON_DDGLDEL_IOUOFF_DDGLDEL_IORVON_DDGLDEL_IORVOFF_DDGLDEL_IOAWM0_DDGLDEL_IOAWM1_DDGLDEL_$GET(IOSGR0)
+9 SET DDGLED=$GET(IORI)_DDGLDEL_$GET(IOSTBM)_DDGLDEL_$GET(IOIL)_DDGLDEL_$GET(IODL)_DDGLDEL_$GET(IOICH)_DDGLDEL_$GET(IODCH)
+10 SET DDGLCLR=IOELEOL_DDGLDEL_IOEDALL_DDGLDEL_IOEDEOP_DDGLDEL_$GET(IOELALL)
+11 SET DDGLKEY=U_IOCUU_U_IOCUD_U_IOCUF_U_IOCUB_U_IOPF1_U_IOPF2_U_IOPF3_U_IOPF4_U_$GET(IOFIND)_U_$GET(IOSELECT)_U_$GET(IOINSERT)_U_$GET(IOREMOVE)_U_$GET(IOPREVSC)_U_$GET(IONEXTSC)_U
+12 SET DDGLGRA=IOG1_DDGLDEL_IOG0_DDGLDEL_IOHL_DDGLDEL_IOVL_DDGLDEL_IOTLC_DDGLDEL_IOTRC_DDGLDEL_IOBLC_DDGLDEL_IOBRC
+13 if DDGLDEL_$PIECE(DDGLGRA,DDGLDEL,3,999)_DDGLDEL[(DDGLDEL_DDGLDEL)
SET DDGLGRA=DDGLDEL_DDGLDEL_"-"_DDGLDEL_"|"_DDGLDEL_"+"_DDGLDEL_"+"_DDGLDEL_"+"_DDGLDEL_"+"
+14 ;
+15 if $PIECE(DDGLKEY,U,1,5)_U[(U_U)
DO TRMERR("Cursor keys")
+16 if U_$PIECE(DDGLKEY,U,6,9)_U[(U_U)
DO TRMERR("PF keys")
+17 if IOELEOL=""
DO TRMERR("Erase to End of Line")
+18 if IOEDALL=""
DO TRMERR("Erase Entire Page")
+19 if IOEDEOP=""
DO TRMERR("Erase to End of Page")
+20 if $GET(DIERR)
GOTO ABT
+21 ;
+22 SET DDGLREF="^TMP(""DDGL"",$J,""W"")"
KILL @DDGLREF
+23 ;
+24 IF "^C-QUME^C-QVT102^C-WYSE75^"[(U_$TRANSLATE(IOST," ","")_U)
Begin DoDot:1
+25 SET DDGLVAN=1
+26 SET $PIECE(DDGLVID,DDGLDEL,4,7)=$SELECT($TRANSLATE(IOST," ","")="C-WYSE75":IOINHI_DDGLDEL_IOINLOW_DDGLDEL_IOINHI_DDGLDEL_IOINLOW,1:IOINLOW_DDGLDEL_IOINHI_DDGLDEL_IOINLOW_DDGLDEL_IOINHI)
+27 SET $PIECE(DDGLVID,DDGLDEL,10)=IOINORM
End DoDot:1
+28 ;
+29 if '$DATA(^%ZTSK)!($DATA(^%ZOSF("MGR"))[0)
DO KILL^%ZISS
MOUSEON ;I $G(DDS)>0 W *27,"[?1000h" NOW DONE IN DDS0
+1 QUIT
+2 ;
+3 ;
ASKIOSL ; not used
+1 ;N X
+2 ;X ^%ZOSF("EOFF")
+3 READ X:0
SET XX=""
+4 ; R *X:1 R:$T XX S X=$C(X)_XX
WRITE $CHAR(27)_7_$CHAR(27)_"[r"_$CHAR(27)_"[999;999H"_$CHAR(27)_"[6n"
READ X
+5 ;S X=+$E(X,3,5) I X S IOSL=X
+6 QUIT
+7 ;
+8 ;
+9 ;
TRMERR(DDGLCH) ;Terminal type errors
+1 NEW P
+2 SET P(1)=DDGLCH
SET P(2)=IOST
+3 DO BLD^DIALOG(842,.P)
+4 QUIT
+5 ;
+6 ;
+7 ;
KILL(DDGLPARM) ;Cleanup variables
+1 ;Set margin to IOM
+2 ;Turn off type-ahead if New Person file so indicates
+3 ;Turn autowrap on
+4 ;Reset character attributes
+5 ;Turn echo on
+6 ;Turn terminators off
+7 NEW X
+8 ; garb OS from %ZOSF or Fileman in this sequence
if '$DATA(DISYS)
DO OS^DII
+9 IF $GET(DDGLPARM)'["W"
Begin DoDot:1
+10 SET X=$SELECT($DATA(IOM)#2:IOM,1:80)
XECUTE $GET(DDGLZOSF("RM"))
+11 IF $DATA(DUZ)#2
IF $DATA(^VA(200,DUZ,0))#2
IF $PIECE($GET(^(200)),U,9)'="Y"
Begin DoDot:2
+12 IF '$GET(DUZ("BUF"),1)
XECUTE $GET(DDGLZOSF("NO-TYPE-AHEAD"))
End DoDot:2
+13 WRITE $PIECE($GET(DDGLVID),$GET(DDGLDEL),9),$PIECE($GET(DDGLVID),$GET(DDGLDEL),10)
End DoDot:1
+14 ;
+15 IF $GET(DDGLPARM)'["T"
Begin DoDot:1
+16 XECUTE $GET(DDGLZOSF("EON"))
XECUTE $GET(DDGLZOSF("TRMOFF"))
End DoDot:1
+17 IF '$TEST
XECUTE $GET(DDGLZOSF("EOFF"))
XECUTE $GET(DDGLZOSF("TRMON"))
+18 ;
MOUSEOFF ;W *27,"[?1000l" NOW DONE IN DDS0
ABT KILL DX,DY,POP
+1 IF '$GET(DIERR)
IF $GET(DDGLPARM)["K"
QUIT
+2 if $GET(DDGLREF)]""
KILL @DDGLREF
+3 if '$DATA(^%ZTSK)!($DATA(^%ZOSF("MGR"))[0)
DO KILL^%ZISS
+4 ;
+5 KILL DDGLDEL,DDGLVID,DDGLED,DDGLCLR,DDGLGRA,DDGLZOSF,DDGLREF
+6 KILL DDGLKEY,DDGLSCR,DDGLVAN,DDGLH
+7 ;
+8 KILL DIR0
