DDSCOM ;SFISC/MLH - COMMAND UTILS ;23JUN2017
;;22.2;VA FileMan;**5,13**;Jan 05, 2016;Build 4
;;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.
;;GFT;**999,1003,1004,1007,1045,1055,1057**
;
COM ;Command line prompt
D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
N DDSCOM,DIR K DTOUT
D SETUP(.DDSCOM,.X,.DIR)
S DIR("?",1)=X
S DIR("A")=$$EZBLD^DIALOG(8000),DIR("?",2)=" ",DIR("?")=$$EZBLD^DIALOG($S($G(DDSMOUSY):8000.101,1:8000.1)) ;'COMMAND' LINE & 'Enter a COMMAND'
S DIR("??")="^D CHLP^DDSCOM"
D:'$G(DDSKM)
.K DDH,DDQ
.F DDH=1:1:IOSL-DDSHBX-6 S DDH(DDH,"T")=" " ;ERASE EVERYTHING IN HELP AREA...
.S DDH=DDH+1,DDH(DDH,"T")=DIR("?",1)
.S DDH=DDH+1,DDH(DDH,"T")=DIR("?",2)
.S DDH=DDH+1,DDH(DDH,"T")=DIR("?")
.D SC^DDSU
S DDM=1 K DDSKM
S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^30^"_(IOSL-1)_"^0"
D ^DIR K DUOUT,DIROUT,DIRUT
TRANS S:X?1A.E (X,Y,Y(0))=$E("ECSNRPQ",$F(DIR("X"),$E($$UP^DILIBF(X)))-1)
M DDSMOUSE(IOSL-5)=DDSCOM ;...DOWN TO 'Exit Save....' REMEMBER WHERE THESE SHOW FOR MOUSE
D:X="C"
. S:DDACT="N" Y="c"
. S Y(0)="CLOSE"
. S:DDACT'="N" (X,Y,Y(0))=""
Q
;
BOT ;from DIR0 & DIR02
I DDS?.N1"^MSCXQSCR" Q ;!!!!!!
N X,XVIS,I,DIR,M,DIREPLIN
S DY=IOSL-1,DX=0,$X=0 X IOXY W $P(DDGLCLR,DDGLDEL) ;Clear the bottom line
S DIREPLIN=$P($$EZBLD^DIALOG(7002),U,$S($G(DIR0("REP")):2,1:1)) ;INSERT/REPLACE
I '$G(DDSMOUSY) D
.I DDO,'$G(DDM) W $$EZBLD^DIALOG(8000) ;**'COMMAND:'
E I DDO D
.D SETUP(.M,.X,.DIR)
.K DDSMOUSE(DY) M DDSMOUSE(DY)=M S DX=0 W X
S X=$$EZBLD^DIALOG($G(DDSMOUSY)/10+8074),DX=IOM-$L(DIREPLIN)-3-$L(X) I DX>$X D ;'F1-H FOR HELP' or 'HELP' if we have room
. X IOXY
. W $P(DDGLVID,DDGLDEL,10)_$P(DDGLVID,DDGLDEL,6)_X_$P(DDGLVID,DDGLDEL,10)
.S DDSMOUSE(DY,DX,DX+$L(X)-1)="H^DIR0H"
S DX=IOM-$L(DIREPLIN)-1 X IOXY
W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_DIREPLIN_$P(DDGLVID,DDGLDEL,10) ;INSERT/REPLACE
S DDSMOUSE(DY,DX,DX+$L(DIREPLIN)-1)="RPM^DIR01" ;Make 'REPLACE' clickable
Q
;
;
;
SETUP(DDSM,X,DIR) ;DDSM, DIR, & X are return variables
;DDSM shows mouse positions
;DIR is array
;X is writeable string
K DDSM,DIR("X") N DDSCH,DDSPP,XVIS
F X=1:1:7 S DDSCH(X)=$$EZBLD^DIALOG(X/100+8000),$E(DIR("X"),X)=$C($A(DDSCH(X))),DDSCH(X,0)=$C($A(DDSCH(X))+32)_":"_$$UP^DILIBF(DDSCH(X)) ;Exit, Close, etc
S DDSPP=$$PP^DDS5(.X) I 'X S DDSPP="" ;Previous Page
S X="" ;This will be the string of COMMANDs, with control sequences to highlight
S XVIS="" ;just visible chars
S DIR(0)="SO^"
I DDSSC>1!($P(^DIST(.403,+DDS,40,+$G(DDSPG),0),U,6)&$G(DDSATOP))!($G(DDSSEL)&'$$MULSELPG^DDSRUN(+DDS)) D ;)POP-UP PAGE. DO THIS FOR OLD-STYLE (but not new-style) SELECTION PAGE
.D EXSANEXR(2,"CL"),EXSANEXR(5,"RF") ;"Close" & "Refresh" in Command Line
.S DIR("B")=DDSCH(2) ;Prompt 'Close' on pop-up page
E D ;NON-POP-UP PAGE
.D EXSANEXR(1,"EX") D:$D(DDSFDO)[0 EXSANEXR(3,"SV") D:DDSNP]"" EXSANEXR(4,"NP^DDS2") D:DDSPP]"" EXSANEXR(6,"PP") D EXSANEXR(5,"RF") D EXSANEXR(7,"QT")
.;S DIR("B")=DDSCH(1) ;Prompt 'Exit' on non-pop-up page **DKA**
S X=$E(X,1,$L(X)-4)
Q
EXSANEXR(N,JUMP) S DIR(0)=DIR(0)_DDSCH(N,0)_";",N=DDSCH(N),DDSM=$L(XVIS)
S XVIS=XVIS_N_" " ;BUILD 'Exit Save ...' STRING
I $G(DDSMOUSY) S X=X_$$HIGH^DDSU(N)_" "
E S X=XVIS
S DDSM(DDSM,DDSM+$L(N)-1)=JUMP ;Mouse positions for each character of displayed text
Q
;
;
;
CHLP ;
K DDH,DDQ
S DDH=0,DDS3CD=$P(DIR(0),U,2)
F DDS3PC=1:1:$L(DDS3CD,";") D
. S DDS3C=$C($A($P($P(DDS3CD,";",DDS3PC),":"))-32)
. I "^E^C^S^N^R^P^Q^"[(U_DDS3C_U) D
.. S DDH=DDH+1
.. S DDH(DDH,"T")=$E($P($T(@("H"_DDS3C)),";",3)_" ",1,14)_"- "_$$EZBLD^DIALOG($P($T(@("H"_DDS3C)),";",4)) ;THE DIFFERENT COMMAND-LINE RESPONSES
D:DDH>0 SC^DDSU
K DDS3C,DDS3CD,DDS3PC
Q
HE ;;Exit;8000.11;**CCO/NI CHANGED THRU BOTTOM OF ROUTINE
HC ;;Close;8000.12
HS ;;Save;8000.13
HN ;;Next Page;8000.14
HR ;;Refresh;8000.15
HP ;;Previous Page;8000.16
HQ ;;Quit;8000.17
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSCOM 4162 printed Apr 09, 2024@21:56:39 Page 2
DDSCOM ;SFISC/MLH - COMMAND UTILS ;23JUN2017
+1 ;;22.2;VA FileMan;**5,13**;Jan 05, 2016;Build 4
+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 ;;GFT;**999,1003,1004,1007,1045,1055,1057**
+7 ;
COM ;Command line prompt
+1 if $GET(@DDSREFT@("HLP"))>0
DO HLP^DDSMSG()
+2 NEW DDSCOM,DIR
KILL DTOUT
+3 DO SETUP(.DDSCOM,.X,.DIR)
+4 SET DIR("?",1)=X
+5 ;'COMMAND' LINE & 'Enter a COMMAND'
SET DIR("A")=$$EZBLD^DIALOG(8000)
SET DIR("?",2)=" "
SET DIR("?")=$$EZBLD^DIALOG($SELECT($GET(DDSMOUSY):8000.101,1:8000.1))
+6 SET DIR("??")="^D CHLP^DDSCOM"
+7 if '$GET(DDSKM)
Begin DoDot:1
+8 KILL DDH,DDQ
+9 ;ERASE EVERYTHING IN HELP AREA...
FOR DDH=1:1:IOSL-DDSHBX-6
SET DDH(DDH,"T")=" "
+10 SET DDH=DDH+1
SET DDH(DDH,"T")=DIR("?",1)
+11 SET DDH=DDH+1
SET DDH(DDH,"T")=DIR("?",2)
+12 SET DDH=DDH+1
SET DDH(DDH,"T")=DIR("?")
+13 DO SC^DDSU
End DoDot:1
+14 SET DDM=1
KILL DDSKM
+15 SET DIR0=IOSL-1_U_($LENGTH(DIR("A"))+1)_"^30^"_(IOSL-1)_"^0"
+16 DO ^DIR
KILL DUOUT,DIROUT,DIRUT
TRANS if X?1A.E
SET (X,Y,Y(0))=$EXTRACT("ECSNRPQ",$FIND(DIR("X"),$EXTRACT($$UP^DILIBF(X)))-1)
+1 ;...DOWN TO 'Exit Save....' REMEMBER WHERE THESE SHOW FOR MOUSE
MERGE DDSMOUSE(IOSL-5)=DDSCOM
+2 if X="C"
Begin DoDot:1
+3 if DDACT="N"
SET Y="c"
+4 SET Y(0)="CLOSE"
+5 if DDACT'="N"
SET (X,Y,Y(0))=""
End DoDot:1
+6 QUIT
+7 ;
BOT ;from DIR0 & DIR02
+1 ;!!!!!!
IF DDS?.N1"^MSCXQSCR"
QUIT
+2 NEW X,XVIS,I,DIR,M,DIREPLIN
+3 ;Clear the bottom line
SET DY=IOSL-1
SET DX=0
SET $X=0
XECUTE IOXY
WRITE $PIECE(DDGLCLR,DDGLDEL)
+4 ;INSERT/REPLACE
SET DIREPLIN=$PIECE($$EZBLD^DIALOG(7002),U,$SELECT($GET(DIR0("REP")):2,1:1))
+5 IF '$GET(DDSMOUSY)
Begin DoDot:1
+6 ;**'COMMAND:'
IF DDO
IF '$GET(DDM)
WRITE $$EZBLD^DIALOG(8000)
End DoDot:1
+7 IF '$TEST
IF DDO
Begin DoDot:1
+8 DO SETUP(.M,.X,.DIR)
+9 KILL DDSMOUSE(DY)
MERGE DDSMOUSE(DY)=M
SET DX=0
WRITE X
End DoDot:1
+10 ;'F1-H FOR HELP' or 'HELP' if we have room
SET X=$$EZBLD^DIALOG($GET(DDSMOUSY)/10+8074)
SET DX=IOM-$LENGTH(DIREPLIN)-3-$LENGTH(X)
IF DX>$X
Begin DoDot:1
+11 XECUTE IOXY
+12 WRITE $PIECE(DDGLVID,DDGLDEL,10)_$PIECE(DDGLVID,DDGLDEL,6)_X_$PIECE(DDGLVID,DDGLDEL,10)
+13 SET DDSMOUSE(DY,DX,DX+$LENGTH(X)-1)="H^DIR0H"
End DoDot:1
+14 SET DX=IOM-$LENGTH(DIREPLIN)-1
XECUTE IOXY
+15 ;INSERT/REPLACE
WRITE $SELECT('$DATA(DDGLVAN):$PIECE(DDGLVID,DDGLDEL,6),1:"")_DIREPLIN_$PIECE(DDGLVID,DDGLDEL,10)
+16 ;Make 'REPLACE' clickable
SET DDSMOUSE(DY,DX,DX+$LENGTH(DIREPLIN)-1)="RPM^DIR01"
+17 QUIT
+18 ;
+19 ;
+20 ;
SETUP(DDSM,X,DIR) ;DDSM, DIR, & X are return variables
+1 ;DDSM shows mouse positions
+2 ;DIR is array
+3 ;X is writeable string
+4 KILL DDSM,DIR("X")
NEW DDSCH,DDSPP,XVIS
+5 ;Exit, Close, etc
FOR X=1:1:7
SET DDSCH(X)=$$EZBLD^DIALOG(X/100+8000)
SET $EXTRACT(DIR("X"),X)=$CHAR($ASCII(DDSCH(X)))
SET DDSCH(X,0)=$CHAR($ASCII(DDSCH(X))+32)_":"_$$UP^DILIBF(DDSCH(X))
+6 ;Previous Page
SET DDSPP=$$PP^DDS5(.X)
IF 'X
SET DDSPP=""
+7 ;This will be the string of COMMANDs, with control sequences to highlight
SET X=""
+8 ;just visible chars
SET XVIS=""
+9 SET DIR(0)="SO^"
+10 ;)POP-UP PAGE. DO THIS FOR OLD-STYLE (but not new-style) SELECTION PAGE
IF DDSSC>1!($PIECE(^DIST(.403,+DDS,40,+$GET(DDSPG),0),U,6)&$GET(DDSATOP))!($GET(DDSSEL)&'$$MULSELPG^DDSRUN(+DDS))
Begin DoDot:1
+11 ;"Close" & "Refresh" in Command Line
DO EXSANEXR(2,"CL")
DO EXSANEXR(5,"RF")
+12 ;Prompt 'Close' on pop-up page
SET DIR("B")=DDSCH(2)
End DoDot:1
+13 ;NON-POP-UP PAGE
IF '$TEST
Begin DoDot:1
+14 DO EXSANEXR(1,"EX")
if $DATA(DDSFDO)[0
DO EXSANEXR(3,"SV")
if DDSNP]""
DO EXSANEXR(4,"NP^DDS2")
if DDSPP]""
DO EXSANEXR(6,"PP")
DO EXSANEXR(5,"RF")
DO EXSANEXR(7,"QT")
+15 ;S DIR("B")=DDSCH(1) ;Prompt 'Exit' on non-pop-up page **DKA**
End DoDot:1
+16 SET X=$EXTRACT(X,1,$LENGTH(X)-4)
+17 QUIT
EXSANEXR(N,JUMP) SET DIR(0)=DIR(0)_DDSCH(N,0)_";"
SET N=DDSCH(N)
SET DDSM=$LENGTH(XVIS)
+1 ;BUILD 'Exit Save ...' STRING
SET XVIS=XVIS_N_" "
+2 IF $GET(DDSMOUSY)
SET X=X_$$HIGH^DDSU(N)_" "
+3 IF '$TEST
SET X=XVIS
+4 ;Mouse positions for each character of displayed text
SET DDSM(DDSM,DDSM+$LENGTH(N)-1)=JUMP
+5 QUIT
+6 ;
+7 ;
+8 ;
CHLP ;
+1 KILL DDH,DDQ
+2 SET DDH=0
SET DDS3CD=$PIECE(DIR(0),U,2)
+3 FOR DDS3PC=1:1:$LENGTH(DDS3CD,";")
Begin DoDot:1
+4 SET DDS3C=$CHAR($ASCII($PIECE($PIECE(DDS3CD,";",DDS3PC),":"))-32)
+5 IF "^E^C^S^N^R^P^Q^"[(U_DDS3C_U)
Begin DoDot:2
+6 SET DDH=DDH+1
+7 ;THE DIFFERENT COMMAND-LINE RESPONSES
SET DDH(DDH,"T")=$EXTRACT($PIECE($TEXT(@("H"_DDS3C)),";",3)_" ",1,14)_"- "_$$EZBLD^DIALOG($PIECE($TEXT(@("H"_DDS3C)),";",4))
End DoDot:2
End DoDot:1
+8 if DDH>0
DO SC^DDSU
+9 KILL DDS3C,DDS3CD,DDS3PC
+10 QUIT
HE ;;Exit;8000.11;**CCO/NI CHANGED THRU BOTTOM OF ROUTINE
HC ;;Close;8000.12
HS ;;Save;8000.13
HN ;;Next Page;8000.14
HR ;;Refresh;8000.15
HP ;;Previous Page;8000.16
HQ ;;Quit;8000.17
