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

DDSCOM.m

Go to the documentation of this file.
  1. DDSCOM ;SFISC/MLH - COMMAND UTILS ;23JUN2017
  1. ;;22.2;VA FileMan;**5,13**;Jan 05, 2016;Build 4
  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. ;;GFT;**999,1003,1004,1007,1045,1055,1057**
  1. ;
  1. COM ;Command line prompt
  1. D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
  1. N DDSCOM,DIR K DTOUT
  1. D SETUP(.DDSCOM,.X,.DIR)
  1. S DIR("?",1)=X
  1. S DIR("A")=$$EZBLD^DIALOG(8000),DIR("?",2)=" ",DIR("?")=$$EZBLD^DIALOG($S($G(DDSMOUSY):8000.101,1:8000.1)) ;'COMMAND' LINE & 'Enter a COMMAND'
  1. S DIR("??")="^D CHLP^DDSCOM"
  1. D:'$G(DDSKM)
  1. .K DDH,DDQ
  1. .F DDH=1:1:IOSL-DDSHBX-6 S DDH(DDH,"T")=" " ;ERASE EVERYTHING IN HELP AREA...
  1. .S DDH=DDH+1,DDH(DDH,"T")=DIR("?",1)
  1. .S DDH=DDH+1,DDH(DDH,"T")=DIR("?",2)
  1. .S DDH=DDH+1,DDH(DDH,"T")=DIR("?")
  1. .D SC^DDSU
  1. S DDM=1 K DDSKM
  1. S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^30^"_(IOSL-1)_"^0"
  1. D ^DIR K DUOUT,DIROUT,DIRUT
  1. TRANS S:X?1A.E (X,Y,Y(0))=$E("ECSNRPQ",$F(DIR("X"),$E($$UP^DILIBF(X)))-1)
  1. M DDSMOUSE(IOSL-5)=DDSCOM ;...DOWN TO 'Exit Save....' REMEMBER WHERE THESE SHOW FOR MOUSE
  1. D:X="C"
  1. . S:DDACT="N" Y="c"
  1. . S Y(0)="CLOSE"
  1. . S:DDACT'="N" (X,Y,Y(0))=""
  1. Q
  1. ;
  1. BOT ;from DIR0 & DIR02
  1. I DDS?.N1"^MSCXQSCR" Q ;!!!!!!
  1. N X,XVIS,I,DIR,M,DIREPLIN
  1. S DY=IOSL-1,DX=0,$X=0 X IOXY W $P(DDGLCLR,DDGLDEL) ;Clear the bottom line
  1. S DIREPLIN=$P($$EZBLD^DIALOG(7002),U,$S($G(DIR0("REP")):2,1:1)) ;INSERT/REPLACE
  1. I '$G(DDSMOUSY) D
  1. .I DDO,'$G(DDM) W $$EZBLD^DIALOG(8000) ;**'COMMAND:'
  1. E I DDO D
  1. .D SETUP(.M,.X,.DIR)
  1. .K DDSMOUSE(DY) M DDSMOUSE(DY)=M S DX=0 W X
  1. 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
  1. . X IOXY
  1. . W $P(DDGLVID,DDGLDEL,10)_$P(DDGLVID,DDGLDEL,6)_X_$P(DDGLVID,DDGLDEL,10)
  1. .S DDSMOUSE(DY,DX,DX+$L(X)-1)="H^DIR0H"
  1. S DX=IOM-$L(DIREPLIN)-1 X IOXY
  1. W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_DIREPLIN_$P(DDGLVID,DDGLDEL,10) ;INSERT/REPLACE
  1. S DDSMOUSE(DY,DX,DX+$L(DIREPLIN)-1)="RPM^DIR01" ;Make 'REPLACE' clickable
  1. Q
  1. ;
  1. ;
  1. ;
  1. SETUP(DDSM,X,DIR) ;DDSM, DIR, & X are return variables
  1. ;DDSM shows mouse positions
  1. ;DIR is array
  1. ;X is writeable string
  1. K DDSM,DIR("X") N DDSCH,DDSPP,XVIS
  1. 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
  1. S DDSPP=$$PP^DDS5(.X) I 'X S DDSPP="" ;Previous Page
  1. S X="" ;This will be the string of COMMANDs, with control sequences to highlight
  1. S XVIS="" ;just visible chars
  1. S DIR(0)="SO^"
  1. 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
  1. .D EXSANEXR(2,"CL"),EXSANEXR(5,"RF") ;"Close" & "Refresh" in Command Line
  1. .S DIR("B")=DDSCH(2) ;Prompt 'Close' on pop-up page
  1. E D ;NON-POP-UP PAGE
  1. .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")
  1. .;S DIR("B")=DDSCH(1) ;Prompt 'Exit' on non-pop-up page **DKA**
  1. S X=$E(X,1,$L(X)-4)
  1. Q
  1. EXSANEXR(N,JUMP) S DIR(0)=DIR(0)_DDSCH(N,0)_";",N=DDSCH(N),DDSM=$L(XVIS)
  1. S XVIS=XVIS_N_" " ;BUILD 'Exit Save ...' STRING
  1. I $G(DDSMOUSY) S X=X_$$HIGH^DDSU(N)_" "
  1. E S X=XVIS
  1. S DDSM(DDSM,DDSM+$L(N)-1)=JUMP ;Mouse positions for each character of displayed text
  1. Q
  1. ;
  1. ;
  1. ;
  1. CHLP ;
  1. K DDH,DDQ
  1. S DDH=0,DDS3CD=$P(DIR(0),U,2)
  1. F DDS3PC=1:1:$L(DDS3CD,";") D
  1. . S DDS3C=$C($A($P($P(DDS3CD,";",DDS3PC),":"))-32)
  1. . I "^E^C^S^N^R^P^Q^"[(U_DDS3C_U) D
  1. .. S DDH=DDH+1
  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
  1. D:DDH>0 SC^DDSU
  1. K DDS3C,DDS3CD,DDS3PC
  1. Q
  1. HE ;;Exit;8000.11;**CCO/NI CHANGED THRU BOTTOM OF ROUTINE
  1. HC ;;Close;8000.12
  1. HS ;;Save;8000.13
  1. HN ;;Next Page;8000.14
  1. HR ;;Refresh;8000.15
  1. HP ;;Previous Page;8000.16
  1. HQ ;;Quit;8000.17