DICATTUD ;SFISC/MKO - USER DEFINED DATA TYPES ;24JUN2017
;;22.2;VA FileMan;**2,5,13**;Jan 05, 2016;Build 4
;;Per VA Directive 6402, this routine should not be modified.
;
BEGIN D EN(A,DA,N,O) I $G(DTOUT) K DTOUT G CHECK^DICATT ;Come from DICATT (roll-and-scroll mode)
G ^DICATT1
;
;
;
SCREENMN ;Come from DICATTD (ScreenMan mode)
N L,M,C,Z,DIZ,DIALLVAL,DIVAL,DTOUT,IOTM,IOBT
D D CLRMSG^DDS ;Set the scrolling region in the command area
.N X S IOTM=19,IOBM=$G(IOSL,24)-1,X="IOSTBM" D ENDR^%ZISS I $G(IOSTBM)]"" W @IOSTBM
D EN(DICATTA,DICATTF,X,DICATT4]"")
I $G(IOSTBM)]"" S IOTM=1,IOBM=$G(IOSL,24) W @IOSTBM
I $G(DTOUT) QUIT
S DICATT2N=$P(DIZ,U),DICATT3N="" I $$ESTORE^DICATT1(DICATT2N) D UNED^DDSUTL(20.5,"DICATT",1,2) ;don't allow 'MULTIPLE'
S DICATT5N=C,DICATTLN=L
S DICATTMN="" D PUT^DDSVALF(98,"DICATT",1,DICATTMN) ;HERE IS THE HELP-PROMPT, NULLED OUT FOR NOW
QUIT
;
;
;
;
;
;In: N = data type number
; O = 0 : if new field
; A = file #
; DA = field #
;
;Out: DICATTPM array (to be merged into ^DD(file#,field#)
; e.g., DICATTPM(101,4,0)="4^", DICATTPM(101,4,31)="DPT(" says that POINTER property is "DPT("
; L = Maximum internal length
; M = Help text
; M(2) = 1 : user changed a default on an old field
; C = Old input transform (5-99)
; DIZ,Z = dataTypeAbbrev_t#, where # is the data type number
;
;Variables used:
; DIVAL = obtained property value
; DIVALS(abbrev) = array of property values (already obtained)
; DIVALS("DIDEF") = default property value presented to user
; DICHANGE = 1 : if user changed a default value (set in PROP)
;
EN(A,DA,N,O) ;
K DICATTPM,M(2),DTOUT
N DIMETH,DIORD,DIPROP,DIVALS,DICHANGE,DDS
M DICATTPM(101)=^DD(A,DA,101),DICATTPM(201)=^DD(A,DA,201) ;GRAB THE EXISTING VALUES OF THE PROPERTIES AND METHODS
;
;Loop through properties in Data Type file, by ORDER, and get values
S DIORD=""
F S DIORD=$O(^DI(.81,N,101,"AC",DIORD)) Q:'DIORD!$D(DUOUT)!$D(DTOUT) D
.S DIPROP=$O(^DI(.81,N,101,"AC",DIORD,"")) Q:'DIPROP D PROPMETH("P",N,DIPROP,.DIVALS)
;If user ^-d or timed out, go back to delete field and reprompt
I $D(DUOUT)!$D(DTOUT) K DUOUT,DICATTPM S DTOUT=1 Q
;Loop through methods in Data Type file
S DIMETH=0
I DUZ(0)="@" F S DIMETH=$O(^DI(.81,N,201,DIMETH)) Q:'DIMETH D:$G(^(DIMETH,31))="" PROPMETH("M",N,DIMETH,.DIVALS)
DONE ;
;Set L and M
K M
S L=$$PROP4TYP^DIETLIBF("INTERNAL LENGTH",N) S:'L L=30 ;$G(DIVALS("MAXL"),30)
;S:$G(DIVALS("HELP"))]"" M=DIVALS("HELP")
;I $G(DICHANGE),O S M(2)=1
;
;Put input transform in C; don't need to store in ^DD(file#,field#,201)
;Set Z and DIZ
S C="Q" ;$G(DICAT201(1,1),"Q") K DICAT201(1)
S Z=$$GET1^DIQ(.81,N,"INTERNAL REPRESENTATION") S:Z="" Z="F"
S (DIZ,Z)=Z_"t"_N_U
QUIT
;
;
;
PROPMETH(PROPMETH,N,DIPROP,DIVALS) ;For DATA TYPE N, get a PROPERTY (PROPMETH="P") or METHOD
N DIPROMPT,DIVAL,DIEXEC,DIDD,DIGL
K DIVALS("DIDEF")
S DIDD=$S(PROPMETH="M":.87,1:.86),DIGL=$S(PROPMETH="M":201,1:101) ;CHANGED FROM '102'
;If there's an Executable Default, get value
I $G(^DI(.81,N,DIGL,DIPROP,31.2))'?."^" D
. S DIEXEC=1
. S DIVAL=$G(^DD(A,DA,DIGL,DIPROP,2)) ;DIGL WILL BE 201, NOT 102
. ;I 'O!$G(DICHANGE),^DI(.81,N,101,DIPROP,31.2)["|" S DIVAL=$$PARSE^DIETLIB(^(31.2),.DIVALS)
. S DIVALS("DIDEF")=DIVAL
;
;Otherwise, get regular default
E S (DIVAL,DIVALS("DIDEF"))=$$GETDEF(N,DIPROP,.DIVALS)
;
;Should user be prompted for value?
S DIPROMPT=$G(^DI(.81,N,DIGL,DIPROP,31))="" ;PROMPT IF THERE IS NO VALUE
I $G(^DI(.81,N,DIGL,DIPROP,10))'?."^" X $$PARSE^DIETLIB(^(10)) S DIPROMPT=$T
;
;If so, prompt for DIVAL
I DIPROMPT D
. ;If there's Get Code, execute it
. I $G(^DI(DIDD,DIPROP,51))'?."^" D
.. D XCODEM^DIETLIB(^DI(DIDD,DIPROP,51),.DIVALS,.DIVAL)
.. S:$D(DIVAL)[0 DUOUT=1
. ;
. ;Otherwise, use ^DIR to get value of property
. E S DIVAL=$$DIR(DIPROP,.DIVALS)
. Q:$D(DUOUT)!$D(DTOUT)
. S:DIVAL'=DIVALS("DIDEF") DICHANGE=1
;
Q:$D(DUOUT)!$D(DTOUT)
D SAVE(DIPROP,.DIVAL,.DIVALS,.DIGL,$G(DIEXEC))
Q
;
DIR(DIPROP,DIVALS) ;Do a ^DIR read to get value for property or method
N I,J,X,Y,DIR,DIRUT,DIROUT
;
;Get DIR(0) from the PROPERTY or METHOD, (convert |abbr| to values)
S DIR(0)=$$PARSE^DIETLIB($G(^DI(DIDD,DIPROP,42)),.DIVALS)
Q:DIR(0)="" ""
A ;Put Prompt into DIR("A")
S I=0
S J=1,DIR("A",1)=$P($G(^DI(DIDD,DIPROP,0)),U)
F S I=$O(^DI(DIDD,DIPROP,43,I)) Q:'I D:$D(^(I,0))#2
. S J=J+1
. S DIR("A",J)=^DI(DIDD,DIPROP,43,I,0)
I J S DIR("A")=DIR("A",J) K DIR("A",J)
H ;Put Help into DIR("?")
S (I,J)=0
I $G(^DI(DIDD,DIPROP,11))]"" S J=1,DIR("?",1)=^(11)
F S I=$O(^DI(DIDD,DIPROP,44,I)) Q:'I D:$D(^(I,0))#2
. S J=J+1
. S DIR("?",J)=^DI(DIDD,DIPROP,44,I,0)
I J S DIR("?")=DIR("?",J) K DIR("?",J)
B ;Put default into DIR("B")
S I=$G(DICATTPM(DIGL,DIPROP,31)) ;get the current VALUE
I I="" S I=$G(DIVALS("DIDEF")) ;or get the DEFAULT from node 33 of the PROPERTY for this DATA TYPE
I I]"" D S DIR("B")=I
.I DIGL=101 D
..N T S T=+$G(^DI(.86,DIPROP,41)) ;get the TYPE
..I T=1 S I=$$DATE^DIUTL(I)
..I T=3 S I=$P($P($P(DIR(0),U,2),I_":",2),";")
;S:$G(DIVALS("DIDEF"))]"" DIR("B")=DIVALS("DIDEF")
S:$G(^DI(DIDD,DIPROP,45))]"" DIR("S")=^(45)
S:$G(^DI(DIDD,DIPROP,46))]"" DIR("T")=^(46)
D ^DIR
Q Y
;
;
SAVE(DIPROP,DIVAL,DIVALS,DICAT101,DIEXEC) ;Save the value of the property
; in DIVALS(abbr) and DICAT101
;DIVAL is the value of the property
;DIEXEC = 1 : if value is an executable
;
;Returns:
; DIVALS(abbr)= array property values
; DICATTPM(DIGL,prop#,0)=prop#^abbrev
; DICATTPM(DIGL,prop#,31)=value
; or 2)=executable value
; DICATTPM(DIGL,prop#,3,n,0) = descendent node n of DIVAL
;
N DIABBR
;
;Set the DIVALS array
S DIABBR=$P(^DI(DIDD,DIPROP,0),U,2)
S:DIABBR]"" DIVALS(DIABBR)=DIVAL
;
;Set the DICATTPM array
I DIVAL]"" D
.N I,Z S Z=0 F I=1:1 S Z=$O(DICATTPM(DIGL,Z)) Q:'Z
.S DICATTPM(DIGL,0)="^."_DIGL_"01P^"_DIPROP_"^"_I ;remember that DIGL=101 or 201
. S DICATTPM(DIGL,DIPROP,0)=DIPROP_U_DIABBR
. S DICATTPM(DIGL,DIPROP,31+$G(DIEXEC))=DIVAL
. I $D(DIVAL)>9 S I="" F S I=$O(DIVAL(I)) Q:I="" D
.. I $D(DIVAL(I))#2 S DICATTPM(DIGL,DIPROP,3,I,0)=DIVAL(I)
.. E I $D(DIVAL(I,0))#2 S DICATTPM(DIGL,DIPROP,3,I,0)=DIVAL(I,0)
.. E Q
;
;Execute the post action
;X:$G(^DI(.81,N,101,DIPROP,61))'?."^" $$PARSE^DIETLIB(^(61))
Q
;
;
GETDEF(N,DIPROP,DIVALS) ;Get defaults for a property.
;May come from the ^DD or the data type file.
N DIDEF
;
;Get value from ^DD
S DIDEF=$S(DIPROP=3:$G(^DD(A,DA,3)),1:$G(^DD(A,DA,101,DIPROP,31)))
;
;For existing fields, return default from ^DD(file#,field#)
;if the user hasn't changed any property values
I O,'$G(DICHANGE) Q DIDEF
;
;Otherwise, look at default from Data Type file.
;For existing fields where default contains no |abbr|,
;return value from DD.
;
;Default
S DIDEF=$G(^DI(.81,N,101,DIPROP,33))
;Q:$G(^DI(.81,N,101,DIPROP,31))]"" $S(^(31)'["|"&O:DIDEF,1:$$PARSE^DIETLIB(^(31),.DIVALS))
;
;Build Default
;Q:$G(^DI(.81,N,101,DIPROP,31.1))]"" $S(^(31.1)'["|"&O:DIDEF,1:$$XCODE^DIETLIB(^(31.1),.DIVALS)) ;NOT THERE ANY MORE
;
Q DIDEF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICATTUD 7266 printed Dec 13, 2024@02:45:51 Page 2
DICATTUD ;SFISC/MKO - USER DEFINED DATA TYPES ;24JUN2017
+1 ;;22.2;VA FileMan;**2,5,13**;Jan 05, 2016;Build 4
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
BEGIN ;Come from DICATT (roll-and-scroll mode)
DO EN(A,DA,N,O)
IF $GET(DTOUT)
KILL DTOUT
GOTO CHECK^DICATT
+1 GOTO ^DICATT1
+2 ;
+3 ;
+4 ;
SCREENMN ;Come from DICATTD (ScreenMan mode)
+1 NEW L,M,C,Z,DIZ,DIALLVAL,DIVAL,DTOUT,IOTM,IOBT
+2 ;Set the scrolling region in the command area
Begin DoDot:1
+3 NEW X
SET IOTM=19
SET IOBM=$GET(IOSL,24)-1
SET X="IOSTBM"
DO ENDR^%ZISS
IF $GET(IOSTBM)]""
WRITE @IOSTBM
End DoDot:1
DO CLRMSG^DDS
+4 DO EN(DICATTA,DICATTF,X,DICATT4]"")
+5 IF $GET(IOSTBM)]""
SET IOTM=1
SET IOBM=$GET(IOSL,24)
WRITE @IOSTBM
+6 IF $GET(DTOUT)
QUIT
+7 ;don't allow 'MULTIPLE'
SET DICATT2N=$PIECE(DIZ,U)
SET DICATT3N=""
IF $$ESTORE^DICATT1(DICATT2N)
DO UNED^DDSUTL(20.5,"DICATT",1,2)
+8 SET DICATT5N=C
SET DICATTLN=L
+9 ;HERE IS THE HELP-PROMPT, NULLED OUT FOR NOW
SET DICATTMN=""
DO PUT^DDSVALF(98,"DICATT",1,DICATTMN)
+10 QUIT
+11 ;
+12 ;
+13 ;
+14 ;
+15 ;
+16 ;In: N = data type number
+17 ; O = 0 : if new field
+18 ; A = file #
+19 ; DA = field #
+20 ;
+21 ;Out: DICATTPM array (to be merged into ^DD(file#,field#)
+22 ; e.g., DICATTPM(101,4,0)="4^", DICATTPM(101,4,31)="DPT(" says that POINTER property is "DPT("
+23 ; L = Maximum internal length
+24 ; M = Help text
+25 ; M(2) = 1 : user changed a default on an old field
+26 ; C = Old input transform (5-99)
+27 ; DIZ,Z = dataTypeAbbrev_t#, where # is the data type number
+28 ;
+29 ;Variables used:
+30 ; DIVAL = obtained property value
+31 ; DIVALS(abbrev) = array of property values (already obtained)
+32 ; DIVALS("DIDEF") = default property value presented to user
+33 ; DICHANGE = 1 : if user changed a default value (set in PROP)
+34 ;
EN(A,DA,N,O) ;
+1 KILL DICATTPM,M(2),DTOUT
+2 NEW DIMETH,DIORD,DIPROP,DIVALS,DICHANGE,DDS
+3 ;GRAB THE EXISTING VALUES OF THE PROPERTIES AND METHODS
MERGE DICATTPM(101)=^DD(A,DA,101),DICATTPM(201)=^DD(A,DA,201)
+4 ;
+5 ;Loop through properties in Data Type file, by ORDER, and get values
+6 SET DIORD=""
+7 FOR
SET DIORD=$ORDER(^DI(.81,N,101,"AC",DIORD))
if 'DIORD!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
Begin DoDot:1
+8 SET DIPROP=$ORDER(^DI(.81,N,101,"AC",DIORD,""))
if 'DIPROP
QUIT
DO PROPMETH("P",N,DIPROP,.DIVALS)
End DoDot:1
+9 ;If user ^-d or timed out, go back to delete field and reprompt
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DICATTPM
SET DTOUT=1
QUIT
+11 ;Loop through methods in Data Type file
+12 SET DIMETH=0
+13 IF DUZ(0)="@"
FOR
SET DIMETH=$ORDER(^DI(.81,N,201,DIMETH))
if 'DIMETH
QUIT
if $GET(^(DIMETH,31))=""
DO PROPMETH("M",N,DIMETH,.DIVALS)
DONE ;
+1 ;Set L and M
+2 KILL M
+3 ;$G(DIVALS("MAXL"),30)
SET L=$$PROP4TYP^DIETLIBF("INTERNAL LENGTH",N)
if 'L
SET L=30
+4 ;S:$G(DIVALS("HELP"))]"" M=DIVALS("HELP")
+5 ;I $G(DICHANGE),O S M(2)=1
+6 ;
+7 ;Put input transform in C; don't need to store in ^DD(file#,field#,201)
+8 ;Set Z and DIZ
+9 ;$G(DICAT201(1,1),"Q") K DICAT201(1)
SET C="Q"
+10 SET Z=$$GET1^DIQ(.81,N,"INTERNAL REPRESENTATION")
if Z=""
SET Z="F"
+11 SET (DIZ,Z)=Z_"t"_N_U
+12 QUIT
+13 ;
+14 ;
+15 ;
PROPMETH(PROPMETH,N,DIPROP,DIVALS) ;For DATA TYPE N, get a PROPERTY (PROPMETH="P") or METHOD
+1 NEW DIPROMPT,DIVAL,DIEXEC,DIDD,DIGL
+2 KILL DIVALS("DIDEF")
+3 ;CHANGED FROM '102'
SET DIDD=$SELECT(PROPMETH="M":.87,1:.86)
SET DIGL=$SELECT(PROPMETH="M":201,1:101)
+4 ;If there's an Executable Default, get value
+5 IF $GET(^DI(.81,N,DIGL,DIPROP,31.2))'?."^"
Begin DoDot:1
+6 SET DIEXEC=1
+7 ;DIGL WILL BE 201, NOT 102
SET DIVAL=$GET(^DD(A,DA,DIGL,DIPROP,2))
+8 ;I 'O!$G(DICHANGE),^DI(.81,N,101,DIPROP,31.2)["|" S DIVAL=$$PARSE^DIETLIB(^(31.2),.DIVALS)
+9 SET DIVALS("DIDEF")=DIVAL
End DoDot:1
+10 ;
+11 ;Otherwise, get regular default
+12 IF '$TEST
SET (DIVAL,DIVALS("DIDEF"))=$$GETDEF(N,DIPROP,.DIVALS)
+13 ;
+14 ;Should user be prompted for value?
+15 ;PROMPT IF THERE IS NO VALUE
SET DIPROMPT=$GET(^DI(.81,N,DIGL,DIPROP,31))=""
+16 IF $GET(^DI(.81,N,DIGL,DIPROP,10))'?."^"
XECUTE $$PARSE^DIETLIB(^(10))
SET DIPROMPT=$TEST
+17 ;
+18 ;If so, prompt for DIVAL
+19 IF DIPROMPT
Begin DoDot:1
+20 ;If there's Get Code, execute it
+21 IF $GET(^DI(DIDD,DIPROP,51))'?."^"
Begin DoDot:2
+22 DO XCODEM^DIETLIB(^DI(DIDD,DIPROP,51),.DIVALS,.DIVAL)
+23 if $DATA(DIVAL)[0
SET DUOUT=1
End DoDot:2
+24 ;
+25 ;Otherwise, use ^DIR to get value of property
+26 IF '$TEST
SET DIVAL=$$DIR(DIPROP,.DIVALS)
+27 if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+28 if DIVAL'=DIVALS("DIDEF")
SET DICHANGE=1
End DoDot:1
+29 ;
+30 if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+31 DO SAVE(DIPROP,.DIVAL,.DIVALS,.DIGL,$GET(DIEXEC))
+32 QUIT
+33 ;
DIR(DIPROP,DIVALS) ;Do a ^DIR read to get value for property or method
+1 NEW I,J,X,Y,DIR,DIRUT,DIROUT
+2 ;
+3 ;Get DIR(0) from the PROPERTY or METHOD, (convert |abbr| to values)
+4 SET DIR(0)=$$PARSE^DIETLIB($GET(^DI(DIDD,DIPROP,42)),.DIVALS)
+5 if DIR(0)=""
QUIT ""
A ;Put Prompt into DIR("A")
+1 SET I=0
+2 SET J=1
SET DIR("A",1)=$PIECE($GET(^DI(DIDD,DIPROP,0)),U)
+3 FOR
SET I=$ORDER(^DI(DIDD,DIPROP,43,I))
if 'I
QUIT
if $DATA(^(I,0))#2
Begin DoDot:1
+4 SET J=J+1
+5 SET DIR("A",J)=^DI(DIDD,DIPROP,43,I,0)
End DoDot:1
+6 IF J
SET DIR("A")=DIR("A",J)
KILL DIR("A",J)
H ;Put Help into DIR("?")
+1 SET (I,J)=0
+2 IF $GET(^DI(DIDD,DIPROP,11))]""
SET J=1
SET DIR("?",1)=^(11)
+3 FOR
SET I=$ORDER(^DI(DIDD,DIPROP,44,I))
if 'I
QUIT
if $DATA(^(I,0))#2
Begin DoDot:1
+4 SET J=J+1
+5 SET DIR("?",J)=^DI(DIDD,DIPROP,44,I,0)
End DoDot:1
+6 IF J
SET DIR("?")=DIR("?",J)
KILL DIR("?",J)
B ;Put default into DIR("B")
+1 ;get the current VALUE
SET I=$GET(DICATTPM(DIGL,DIPROP,31))
+2 ;or get the DEFAULT from node 33 of the PROPERTY for this DATA TYPE
IF I=""
SET I=$GET(DIVALS("DIDEF"))
+3 IF I]""
Begin DoDot:1
+4 IF DIGL=101
Begin DoDot:2
+5 ;get the TYPE
NEW T
SET T=+$GET(^DI(.86,DIPROP,41))
+6 IF T=1
SET I=$$DATE^DIUTL(I)
+7 IF T=3
SET I=$PIECE($PIECE($PIECE(DIR(0),U,2),I_":",2),";")
End DoDot:2
End DoDot:1
SET DIR("B")=I
+8 ;S:$G(DIVALS("DIDEF"))]"" DIR("B")=DIVALS("DIDEF")
+9 if $GET(^DI(DIDD,DIPROP,45))]""
SET DIR("S")=^(45)
+10 if $GET(^DI(DIDD,DIPROP,46))]""
SET DIR("T")=^(46)
+11 DO ^DIR
+12 QUIT Y
+13 ;
+14 ;
SAVE(DIPROP,DIVAL,DIVALS,DICAT101,DIEXEC) ;Save the value of the property
+1 ; in DIVALS(abbr) and DICAT101
+2 ;DIVAL is the value of the property
+3 ;DIEXEC = 1 : if value is an executable
+4 ;
+5 ;Returns:
+6 ; DIVALS(abbr)= array property values
+7 ; DICATTPM(DIGL,prop#,0)=prop#^abbrev
+8 ; DICATTPM(DIGL,prop#,31)=value
+9 ; or 2)=executable value
+10 ; DICATTPM(DIGL,prop#,3,n,0) = descendent node n of DIVAL
+11 ;
+12 NEW DIABBR
+13 ;
+14 ;Set the DIVALS array
+15 SET DIABBR=$PIECE(^DI(DIDD,DIPROP,0),U,2)
+16 if DIABBR]""
SET DIVALS(DIABBR)=DIVAL
+17 ;
+18 ;Set the DICATTPM array
+19 IF DIVAL]""
Begin DoDot:1
+20 NEW I,Z
SET Z=0
FOR I=1:1
SET Z=$ORDER(DICATTPM(DIGL,Z))
if 'Z
QUIT
+21 ;remember that DIGL=101 or 201
SET DICATTPM(DIGL,0)="^."_DIGL_"01P^"_DIPROP_"^"_I
+22 SET DICATTPM(DIGL,DIPROP,0)=DIPROP_U_DIABBR
+23 SET DICATTPM(DIGL,DIPROP,31+$GET(DIEXEC))=DIVAL
+24 IF $DATA(DIVAL)>9
SET I=""
FOR
SET I=$ORDER(DIVAL(I))
if I=""
QUIT
Begin DoDot:2
+25 IF $DATA(DIVAL(I))#2
SET DICATTPM(DIGL,DIPROP,3,I,0)=DIVAL(I)
+26 IF '$TEST
IF $DATA(DIVAL(I,0))#2
SET DICATTPM(DIGL,DIPROP,3,I,0)=DIVAL(I,0)
+27 IF '$TEST
QUIT
End DoDot:2
End DoDot:1
+28 ;
+29 ;Execute the post action
+30 ;X:$G(^DI(.81,N,101,DIPROP,61))'?."^" $$PARSE^DIETLIB(^(61))
+31 QUIT
+32 ;
+33 ;
GETDEF(N,DIPROP,DIVALS) ;Get defaults for a property.
+1 ;May come from the ^DD or the data type file.
+2 NEW DIDEF
+3 ;
+4 ;Get value from ^DD
+5 SET DIDEF=$SELECT(DIPROP=3:$GET(^DD(A,DA,3)),1:$GET(^DD(A,DA,101,DIPROP,31)))
+6 ;
+7 ;For existing fields, return default from ^DD(file#,field#)
+8 ;if the user hasn't changed any property values
+9 IF O
IF '$GET(DICHANGE)
QUIT DIDEF
+10 ;
+11 ;Otherwise, look at default from Data Type file.
+12 ;For existing fields where default contains no |abbr|,
+13 ;return value from DD.
+14 ;
+15 ;Default
+16 SET DIDEF=$GET(^DI(.81,N,101,DIPROP,33))
+17 ;Q:$G(^DI(.81,N,101,DIPROP,31))]"" $S(^(31)'["|"&O:DIDEF,1:$$PARSE^DIETLIB(^(31),.DIVALS))
+18 ;
+19 ;Build Default
+20 ;Q:$G(^DI(.81,N,101,DIPROP,31.1))]"" $S(^(31.1)'["|"&O:DIDEF,1:$$XCODE^DIETLIB(^(31.1),.DIVALS)) ;NOT THERE ANY MORE
+21 ;
+22 QUIT DIDEF
