- DDSOPT ;SFISC/MLH,MKO-SCREENMAN OPTIONS ;18JAN2012
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;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.
- ;
- 0 S DIC="^DOPT(""DDS"","
- G OPT:$D(^DOPT("DDS",7)) S ^(0)="SCREENMAN OPTION^1.01" K ^("B")
- F X=1:1:7 S ^DOPT("DDS",X,0)=$P($T(@X),";;",2)
- S DIK=DIC D IXALL^DIK
- OPT ;
- S DIC(0)="AEQIZ" D ^DIC G Q:Y<0 S DI=+Y D EN G 0
- ;
- EN ;Entry point for all screenman options
- D @DI W !!
- Q K %,DI,DIC,DIK,X,Y Q
- ;
- 1 ;;EDIT/CREATE A FORM
- CREATE G ^DDGF
- ;
- 2 ;;RUN A FORM
- G ^DDSRUN
- ;
- 3 ;;DELETE A FORM
- G ^DDSDFRM
- ;
- 4 ;;PURGE UNUSED BLOCKS
- G ^DDSDBLK
- ;
- 5 ;;PRINT A FORM
- G PRINT^DDS
- ;
- 6 ;;CUSTOMIZE COLORS
- I $G(^XTV(8989.5,0))'?1"PARAM".E W !,"PARAMETERS SYSTEM IS NOT INSTALLED HERE" Q
- D EDITPAR^XPAREDIT("DI SCREENMAN COLORS") Q
- ;
- 7 ;;CLONE A FORM
- D ^DDSCLONE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSOPT 1052 printed Mar 13, 2025@21:48:09 Page 2
- DDSOPT ;SFISC/MLH,MKO-SCREENMAN OPTIONS ;18JAN2012
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +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 ;
- 0 SET DIC="^DOPT(""DDS"","
- +1 if $DATA(^DOPT("DDS",7))
- GOTO OPT
- SET ^(0)="SCREENMAN OPTION^1.01"
- KILL ^("B")
- +2 FOR X=1:1:7
- SET ^DOPT("DDS",X,0)=$PIECE($TEXT(@X),";;",2)
- +3 SET DIK=DIC
- DO IXALL^DIK
- OPT ;
- +1 SET DIC(0)="AEQIZ"
- DO ^DIC
- if Y<0
- GOTO Q
- SET DI=+Y
- DO EN
- GOTO 0
- +2 ;
- EN ;Entry point for all screenman options
- +1 DO @DI
- WRITE !!
- Q KILL %,DI,DIC,DIK,X,Y
- QUIT
- +1 ;
- 1 ;;EDIT/CREATE A FORM
- CREATE GOTO ^DDGF
- +1 ;
- 2 ;;RUN A FORM
- +1 GOTO ^DDSRUN
- +2 ;
- 3 ;;DELETE A FORM
- +1 GOTO ^DDSDFRM
- +2 ;
- 4 ;;PURGE UNUSED BLOCKS
- +1 GOTO ^DDSDBLK
- +2 ;
- 5 ;;PRINT A FORM
- +1 GOTO PRINT^DDS
- +2 ;
- 6 ;;CUSTOMIZE COLORS
- +1 IF $GET(^XTV(8989.5,0))'?1"PARAM".E
- WRITE !,"PARAMETERS SYSTEM IS NOT INSTALLED HERE"
- QUIT
- +2 DO EDITPAR^XPAREDIT("DI SCREENMAN COLORS")
- QUIT
- +3 ;
- 7 ;;CLONE A FORM
- +1 DO ^DDSCLONE
