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

DICATTD.m

Go to the documentation of this file.
  1. DICATTD ;SFISC/GFT - SCREEN-MODE 'MODIFY FILE ATTRIBUTES' ;22DEC2015
  1. ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
  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. ;
  1. N DG,DLAYGO,DIC,DICATTB,DICATTA,DICATTF,DA,DDA
  1. K ^UTILITY("DICATTD",$J),^UTILITY("DDA",$J) ;auditing
  1. S DLAYGO=1 D D^DICRW Q:Y<0 I $P($G(^DD(+Y,0,"DI")),U)["Y",$P(@(^DIC(+Y,0,"GL")_"0)"),U,4) W !!,$C(7),"DATA DICTIONARY MODIFICATIONS ON ARCHIVE FILES ARE NOT ALLOWED!" Q
  1. I '$D(DIC) D DIE^DIB Q:'$D(DG) S DIC=DG
  1. LOCK S (DA,DICATTB,DICATTA)=+$P(@(DIC_"0)"),U,2) L +^DICATTD(DA):1 E W !!,"SOMEONE ELSE IS EDITING THIS FILE" Q ;N.B.--There is no such Global as ^DICATTD
  1. DDA S DDA="" ;DD auditing
  1. ASKLOOP F K DICATTF D M I $S('$D(DICATTF):1,'$D(^DD(DICATTA)):1,DICATTF-.01:0,1:$P(^DD(DICATTA,DICATTF,0),U,2)["W") Q:DICATTA=DICATTB S DICATTA=DICATTB
  1. END L -^DICATTD(DICATTB) Q
  1. ;
  1. M N DICATTVP,DICATTDK,DICATT2N,DICATTMN,DICATTDW,DDSERROR,DICS,DICATTSC
  1. N DICATT2,DICATT4,DICATT3,DICATT3N,DICATTL,DICATTLN,DICATT5,DICATT5N,DICATT5P
  1. N O,DIU0,I,J,DR,A,DQ
  1. N DDSFILE,DIMSG,DUOUT,DTOUT,DDSPAGE,DDSPARM,DDSSAVE,DICATTNW
  1. FIELD W !!! K DIC,O,^UTILITY("DICATTD",$J) ;clean WP buffer
  1. S DIC(0)="ALEQIZ",DIC="^DD("_DICATTA_"," S:$D(DICS) DIC("S")=DICS
  1. S DIC("W")="S %=$P(^(0),U,2) I % W $P("" (multiple)^ (word-processing)"",U,$P(^DD(+%,.01,0),U,2)[""W""+1)"
  1. I $P(^DD(DICATTA,.01,0),U,2)["W" S DIC(0)="AEQZ",DIC("B")=.01
  1. D ^DIC K DIC I Y<0 K DICATTF Q ;look-up
  1. NEWFIELD I $P(Y,U,3) S DICATTNW=1 S:$D(DDA) DDA="N"
  1. E S DIU0=DICATTA,O(1)=$P(^(0),U,1,2),O(2)=$G(^(.1)) I $D(DDA) D
  1. .N A S A=DIU0 S DDA="E" D SV^DICATTA
  1. S:$D(DDA) DDA(1)=DICATTA
  1. S DICATTF=+Y
  1. D GET
  1. MUL I DICATT2 D Q:'DICATTA!'$D(^DD(DICATTA)) G FIELD ;If it's multiple...
  1. .N DICATT2N,DDSPAGE,DDSPARM,DDSSAVE
  1. .S DDSPARM="S",DDSPAGE=10 D DDS ;...we do Page 10
  1. .I $G(DDSSAVE) S DICATTA=+$G(DICATT2) ;Go down into multiple unless they aborted with F1-Q
  1. DDS K DDSSAVE,DIMSG S DDSPARM="S",DA="",DR="[DICATT]",DDSFILE=1
  1. D ^DDS ;invoke SCREENMAN!
  1. Q:'$D(^DD(DICATTA,DICATTF,0))
  1. S DICATT2N=$P(^(0),U,2) I DICATT2N="",DICATTF-.01 D DELFLD^DICATTDK(DICATTA,DICATTF) Q ;delete field
  1. VERIFY I '$D(DTOUT),'$D(DIMSG),$D(DDSSAVE) D N^DICATTDE I 'DICATT2N,'$G(DICATTNW),$D(DICATTMN) D DIVR^DIUTL(DICATTA,DICATTF) ;re-verify fields
  1. Q
  1. ;
  1. GET ;SET UP THE VARIABLES ABOUT THIS FIELD
  1. K DICATT2N,DICATT3N,DICATT5N,DICATTLN,DICATT5P
  1. S DICATT2=$P(^DD(DICATTA,DICATTF,0),U,2),DICATT3=$P(^(0),U,3),DICATT4=$P(^(0),U,4),DICATT5=$P(^(0),U,5,99)
  1. I $D(^DD(DICATTA,DICATTF,"V")) D GET^DICATTD8 ;Variable-pointer
  1. Q
  1. ;
  1. PRE ;PRE-ACTION of first block
  1. N DIAC,DIFILE
  1. I DICATTF=.01 D REQ^DDSUTL(1,"DICATT",1,1) ;for now
  1. I DICATT2["C" D CUNED^DICATTD6(DICATT2)
  1. I DICATT2["W" F X=18 D UNED(X)
  1. S X=1 I DICATTF=.01,DICATTA-DICATTB S X=2
  1. D UNED^DDSUTL(20.5,"DICATT",1,X) ;2 means REACHABLE but not EDITABLE
  1. S DIAC="AUDIT",DIFILE=DICATTB D ^DIAC I %-1 D UNED(3) ;check AUDIT ACCESS
  1. I DUZ(0)'="@" D ;only programmers can...
  1. .D UNED(4),UNED(99) ; ..edit AUDIT CONDITION, XECUTABLE HELP, or ...
  1. .I DICATT2["X" D X,UNED(1),UNED(2) ;edit LABEL of 'X' field, or ...
  1. .I $$TYPE=9 D UNED(20) ;edit a MUMPS type
  1. .F I=4,5 D UNED^DDSUTL(I,"DICATTVP",8,1) ;build VARIABLE-POINTER SCREEN
  1. .F I=16,17 D UNED^DDSUTL(I,"DICATTM",3,1) ;specify location of
  1. .F I=76,76.1 D UNED^DDSUTL(I,"DICATTS",4,1) ;...data
  1. Q:DICATT2'["X"
  1. X I DICATT2'["F" D UNED(20) D HLP^DDSUTL("NOTE THAT THIS FIELD'S DEFINITION IS NOT EDITABLE") Q
  1. D UNED^DDSUTL(20,"DICATT",1,2) ;FREE-TEXT DATA TYPE REACHABLE BUT NOT EDITABLE
  1. F I=68,70 D UNED^DDSUTL(I,"DICATT4",2.4,1) ;MINIMUM LENGTH & PATTERN MATCH NOT EDITABLE
  1. S DICATT5="$L(X)>"_$$FL^DIQGDDU(DICATTA,DICATTF)
  1. Q
  1. ;
  1. UNED(I) D UNED^DDSUTL(I,"DICATT",1,1) Q
  1. ;
  1. NUMBER ;
  1. D IJ^DIUTL(DICATTA) S Y=" File #"_J(0)
  1. F I=1:1 Q:'$D(J(I)) S Y=" Sub-File #"_J(I)_" of"_Y
  1. S Y="Field #"_DICATTF_" in"_Y
  1. I $P($G(^DD(DICATTA,DICATTF,0)),U,2) S Y="Multiple "_Y
  1. S Y=$J("",78-$L(Y)\2)_Y Q
  1. ;
  1. TYPE() ;Figure out TYPE from the second piece of the zero node
  1. I DICATT2="" Q ""
  1. I DICATT2["t" S N=+$P(DICATT2,"t",2)
  1. E F N=9:-1:5,1:1:4,100 I DICATT2[$E("DNSFWCPVK",N) Q
  1. E S:N=100 N=4
  1. Q N
  1. ;
  1. SCREEN ;
  1. N N
  1. I DICATTF=.001 S DIR("S")="I Y<4!(Y=7)" Q
  1. S N=$$TYPE I N="" S DIR("S")="I Y<10!$O(^(201,0))!$O(^DI(.81,Y,101,0))" S:DUZ(0)'="@" DIR("S")=DIR("S")_",Y-9" Q ;IF FIELD IS NEW, ONLY A PROGRAMMER CAN CREATE 'MUMPS' TYPE
  1. I N=6 S DIR("S")="I Y=6" Q ;can't change a COMPUTED FIELD's type
  1. S DIR("S")="I Y-6,Y-9,Y-99,Y<10!$O(^(201,0))!$O(^DI(.81,Y,101,0))"_$P(",Y-5",U,N\2-2!'$D(^DD(DICATTA,0,"UP"))!(DICATTF-.01)!($O(^DD(DICATTA,DICATTF))>0))_$S(N=7:",Y-8",N=8:",Y-7",1:"")
  1. Q
  1. ;
  1. BRANCH ;given X=TYPE
  1. F I=31,32 D REQ^DDSUTL(I,"DICATT2",2.2,X=2) ;UPPER BOUND & LOWER BOUND if we are doing a NUMERIC
  1. F I=68,69 D REQ^DDSUTL(I,"DICATT4",2.4,X=4&(DICATT2'["X")) ;MAX LENGTH & MIN LENGTH if we are doing a FREE TEXT (but not if UNEDITABLE)
  1. I X=9 G ^DICATTD9
  1. I DICATT4="",DICATTF>.001 D UNED^DDSUTL(20.5,"DICATT",1,X=5) ;W-P doesn't ask MULTIPLE
  1. K DICATTSC
  1. I X>9 S:$G(DICATT2)="" DDSBR=20.5 D Q
  1. .D SCREENMN^DICATTUD ;EXTENSIBLE DATA TYPE
  1. E S DDSSTACK="2."_X Q ;For types 1-8, go to PAGE 2.1 - 2.8
  1. ;
  1. CHNG I DICATT5N=DICATT5 K DICATTMN ;No DICATTMN means no change
  1. D:$D(DICATTMN) PUT^DDSVALF(98,"DICATT",1,DICATTMN) ;HELP-PROMPT prompted
  1. Q
  1. ;