- 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 Feb 19, 2025@00:09:29 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