- DICATTDE ;O-OIFO/GFT - END screen edit ;23JUN2017
- ;;22.2;VA FileMan;**3,2,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;**1,42,83,103,999,1004,1027,1028,1032,1042,1043,1055,1058**
- ;
- LAYGODEF ;should user see 'ADDING NEW'?
- N %
- I DICATTF=.01,$G(^DD(DICATTA,0,"UP")) S Y=^("UP"),%=$O(^DD(Y,"SB",DICATTA,0)) I %,$P($G(^DD(Y,%,0)),U,2)["A" S Y="NO" Q
- S Y="YES"
- Q
- ;
- POST ;This is the DATA VALIDATION of the DICATT FORM
- N DICATT1N,DICATTM,DICATT4N,DICATT4S,DICATTED,X,T,G,DIC,DIE,DR,DA
- K DDSBR,DDSERROR
- I DICATT2 G MULEDIT^DICATTDD
- VP I $$G(20)=8 D POSTVP^DICATTD8 I $D(DDSBR) S DDSERROR=1,DDSBR=DDSBR_"^DICATT8^2.8" Q
- S DICATT1N=$$G(1)
- I DICATT1N="" G ^DICATTDK:$D(DICATTDK) S DDSBR=1,DDSERROR=1 Q
- I DICATT1N=$$G(2) S DDSERROR=1,DDSBR=1 D HLP^DDSUTL("NAME AND TITLE MUST BE DIFFERENT") Q
- I $G(DICATTLN) D I $D(DDSERROR) D HLP^DDSUTL("YOUR REDEFINITION OF THE FIELD WOULD CAUSE TOO MUCH DATA STORAGE!") Q
- .N W,DP,N,A,L,Y
- .S A=DICATTA,DP=DICATTF,W=$P(^DD(A,DP,0),U,4),Y=$P(W,";"),N=$P(W,";",2),T=0,L=DICATTLN Q:W=""
- .D MX^DICATT1
- TOOMUCH .I $$MAX^DICATTDM(L-T,Y)>($G(^DD("STRING_LIMIT"),255)-4) S DDSERROR=1,DDSBR=20
- NEW I DICATT4="",'$D(DICATT4N) D I $D(DDSERROR) D HLP^DDSUTL("DATA-STORAGE INFO INCOMPLETE") Q
- .I DICATTF=.001 S DICATT4N=" " Q
- .S G=$$G(20) I G=6 S DICATT4N=" ; " Q
- .I G=5!$$G(20.5) D Q:$D(DDSERROR) S DICATT4N=DICATTM(76)_";0" Q ;Note that we can $$GET the defaulted values for storage, even if user has not seen Pages 3 or 4
- ..F T=76,76.1 S DICATTM(T)=$$GET^DDSVALF(T,"DICATTS",4,"","") I DICATTM(T)="" S DDSERROR=1,DDSBR="76^DICATTS^4" Q
- .S G=$$GET^DDSVALF(16,"DICATTM",3,"",""),T=$$GET^DDSVALF(17,"DICATTM",3,"","")
- .I G=""!(T="") S DDSERROR=1,DDSBR="16^DICATTM^3" Q
- .S DICATT4N=G_";"_T Q
- S X=^DD(DICATTA,DICATTF,0) D I $D(DDSERROR) D HLP^DDSUTL("FIELD DEFINITION IS TOO LONG!") Q ;Can't fit it into the zero node
- .S T=$L(DICATT1N)+$L($S($D(DICATT2N):DICATT2N,1:$P(X,U,2)))+$L($S($D(DICATT3N):DICATT3N,1:$P(X,U,3)))+$L($S($D(DICATT4N):DICATT4N,1:$P(X,U,4)))+$L($S($D(DICATT5N)#2:DICATT5N,1:$P(X,U,5,999)))
- .I T>($G(^DD("STRING_LIMIT"),255)-13) S DDSERROR=1
- ;
- FILE ;Everything's good! We're gonna file it
- I $D(DICATT4N) S $P(^DD(DICATTA,DICATTF,0),U,4)=DICATT4N I DICATT4N'?.P S DICATT4S=$P(DICATT4N,";"),^DD(DICATTA,"GL",DICATT4S,$P(DICATT4N,";",2),DICATTF)="" ;new Piece 4
- I $D(DICATTM),$D(DICATT4S) D Q ;make a MULTIPLE
- .N TYPE S TYPE=$$G(20)
- .D MULMAKE^DICATTDD(DICATTM(76.1),TYPE)
- WP .I TYPE=5 N DICATTA,DICATTF S:'$D(DICATT2N) DICATT2N="W" ;so we'll bounce back up from W-P multiple
- .S DICATTA=DICATTM(76.1),DICATTF=.01,DICATTMN="" ;make the .01 Field of the new multiple
- .D M101 Q
- M101 I $G(DICATT2N)["t" M ^DD(DICATTA,DICATTF)=DICATTPM K DICATTPM
- S X=$E("R",$$G(18)) I DICATT2["R"'=$L(X)!$D(DICATTMN) D
- .F %=DICATTA:0 S ^DD(%,0,"DT")=DT Q:'$D(^("UP")) S %=^("UP") Q:'$D(^DD(%))
- .S DICATTMN="" K ^DD(DICATTA,"RQ",DICATTF) I X["R" S ^(DICATTF)=""
- .I '$D(DICATT2N) S DICATT2N=$TR(DICATT2,"R") I DICATT2["W" S DICATT2N="W"
- .S DICATT2N=X_DICATT2N_$E("I",$G(DICATT2)["I")
- .S %=$P(DICATT2,"P",2) I % K ^DD(+%,0,"PT",DICATTA,DICATTF) ;remove old PT node
- .S %=$P(DICATT2N,"P",2) I % S ^DD(+%,0,"PT",DICATTA,DICATTF)=""
- DIK2 .I DICATT2["t" D AFDEFDEL^DIETLIB(DICATTA,DICATTF)
- COMPUTED .I DICATT2N["C" D
- ..N DICOMPX,A,DA
- ..S A=+$P(DICATT2,"p",2) I A,$D(^DD(A,0)) K ^(0,"PTC",DICATTA,DICATTF)
- ..S A=+$P(DICATT2N,"p",2) I A,$D(^DD(A,0)) S ^(0,"PTC",DICATTA,DICATTF)=""
- ..S (DA(1),A)=DICATTA,DA=DICATTF,DICOMPX=$G(DICATT5N(9.01)) K ^DD(A,DA,9.02) D ACOMP^DICATT3
- .I DICATTF=.01 D
- ..I DICATTA=DICATTB D Q
- ...I $D(^DIC(DICATTA,0,"GL")),$D(@(^("GL")_"0)")) D UP2("",DICATT2N)
- ..S Y=$$GET^DDSVALF(2,"DICATTMUL",5,"I","") I Y?1N S DICATT2N=$E("M",Y=1)_DICATT2N
- ..S DR=$$GET^DDSVALF(1,"DICATTMUL",5,"I","")
- ..I $G(^DD(DICATTA,0,"UP")) S Y=^("UP"),%=$O(^DD(Y,"SB",DICATTA,0)) I Y,%,$D(^DD(Y,%,0)) D UP2(DR,DICATT2N) ;Reset the MULTIPLE field at the higher level
- .S $P(^DD(DICATTA,DICATTF,0),U,2)=DICATT2N ;SET THE SPECIFIER!
- PIECE3 .I $D(DICATT3N) S $P(^(0),U,3)=$G(DICATT3N)
- .I $D(DICATTVP) D FILE^DICATTD8
- DIK1 .N DIK,DA S DA=DICATTF,DA(1)=DICATTA,DIK="^DD("_DICATTA_",",DIK(1)=.2 D EN1^DIK ;CROSS-REFERENCE THE SPECIFIER!
- ;
- SCREEN S %=$$GET^DDSVALF(65,"DICATT SCREEN",6,"I",""),X=$P(^DD(DICATTA,DICATTF,0),U,2) I %=0!(%="NO")!(X'["P"&(X'["S")) K ^(12),^(12.1)
- COMPNODS S %=9.2 F K ^DD(DICATTA,DICATTF,%) S %=$O(^(%)) Q:%\1-9 ;KILL ALL THE 9.2 NODES
- F %=8:0 S %=$O(DICATT5N(%)) Q:'% S ^DD(DICATTA,DICATTF,%)=DICATT5N(%) ;SET THE 9.2 NODES
- I $D(DICATT5N)#2 S $P(^(0),U,5,99)=DICATT5N
- S DR="50////^S X=DT" F X=1:1:8 D 0
- D DIE
- EGP ;K ^DD(DICATTA,DICATTF,.009) ;WHEN FIELD CHANGES, KILL OFF ITS HELP TRANSLATIONS
- S DR="Q",X=98 D 0,DIE
- S DR="Q",X=99 D 0,DIE
- D FILEWORD^DICATTD0
- MUMPS I $P(^DD(DICATTA,DICATTF,0),U,2)["K" S ^(9)="@" ;**151
- AUDIT I $G(DICATT2)]"",$P(^(0),U,2)'=DICATT2,$G(^DD(DICATTB,0,"DIK"))]"" D EN2^DIKZ(DICATTB,"",^("DIK")) ;Recompile CROSS-REFS if auditing changes
- RESET D GET^DICATTD ;now that we have filed, the NEW is OLD, in case they keep editing!
- Q Q
- ;
- UP2(A,X) N T,Y ;A=0 if NO LAYGO X=SPECIFIER
- S Y=$P(^(0),U,2),Y=$TR(Y,"SDPV")
- F T="S","V","P","D" I X[T S Y=Y_T Q
- I A?1N S Y=$TR(Y,"A")_$E("A",DR=0)
- S $P(^(0),U,2)=Y
- Q
- ;
- 0 S T=$T(@X),G=$TR($$G(X),";") Q:G="@"!(G="^") S:G="" G="@" S DR=DR_$P(T,";",2,3)_"////"_G Q ;Re-file NAME, TITLE, etc. Delete if they are now gone. Leave "@" alone
- 1 ;;.01
- 2 ;;.1
- 3 ;;1.1
- 4 ;;1.2
- 5 ;;8
- 6 ;;8.5
- 7 ;;9
- 8 ;;10
- 98 ;;3
- 99 ;;4
- ;
- DIE S DICATTED=1,DA=DICATTF,DA(1)=DICATTA,(DIC,DIE)="^DD(DICATTA,"
- D ^DIE
- Q
- ;
- N ;
- S DA=DICATTF I $G(DDA(1))]"" S:$G(DICATTA) DDA(1)=DICATTA S:'$D(^DD(DDA(1),DA)) DDA="D" D AUDT^DICATTA
- I $D(DIU0) N DI D IJ^DIUTL(DICATTA),P^DICATT
- Q
- ;
- G(I) N X Q $$GET^DDSVALF(I,"DICATT",1,"I","")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICATTDE 6125 printed Feb 19, 2025@00:12:03 Page 2
- DICATTDE ;O-OIFO/GFT - END screen edit ;23JUN2017
- +1 ;;22.2;VA FileMan;**3,2,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;**1,42,83,103,999,1004,1027,1028,1032,1042,1043,1055,1058**
- +7 ;
- LAYGODEF ;should user see 'ADDING NEW'?
- +1 NEW %
- +2 IF DICATTF=.01
- IF $GET(^DD(DICATTA,0,"UP"))
- SET Y=^("UP")
- SET %=$ORDER(^DD(Y,"SB",DICATTA,0))
- IF %
- IF $PIECE($GET(^DD(Y,%,0)),U,2)["A"
- SET Y="NO"
- QUIT
- +3 SET Y="YES"
- +4 QUIT
- +5 ;
- POST ;This is the DATA VALIDATION of the DICATT FORM
- +1 NEW DICATT1N,DICATTM,DICATT4N,DICATT4S,DICATTED,X,T,G,DIC,DIE,DR,DA
- +2 KILL DDSBR,DDSERROR
- +3 IF DICATT2
- GOTO MULEDIT^DICATTDD
- VP IF $$G(20)=8
- DO POSTVP^DICATTD8
- IF $DATA(DDSBR)
- SET DDSERROR=1
- SET DDSBR=DDSBR_"^DICATT8^2.8"
- QUIT
- +1 SET DICATT1N=$$G(1)
- +2 IF DICATT1N=""
- if $DATA(DICATTDK)
- GOTO ^DICATTDK
- SET DDSBR=1
- SET DDSERROR=1
- QUIT
- +3 IF DICATT1N=$$G(2)
- SET DDSERROR=1
- SET DDSBR=1
- DO HLP^DDSUTL("NAME AND TITLE MUST BE DIFFERENT")
- QUIT
- +4 IF $GET(DICATTLN)
- Begin DoDot:1
- +5 NEW W,DP,N,A,L,Y
- +6 SET A=DICATTA
- SET DP=DICATTF
- SET W=$PIECE(^DD(A,DP,0),U,4)
- SET Y=$PIECE(W,";")
- SET N=$PIECE(W,";",2)
- SET T=0
- SET L=DICATTLN
- if W=""
- QUIT
- +7 DO MX^DICATT1
- TOOMUCH IF $$MAX^DICATTDM(L-T,Y)>($GET(^DD("STRING_LIMIT"),255)-4)
- SET DDSERROR=1
- SET DDSBR=20
- End DoDot:1
- IF $DATA(DDSERROR)
- DO HLP^DDSUTL("YOUR REDEFINITION OF THE FIELD WOULD CAUSE TOO MUCH DATA STORAGE!")
- QUIT
- NEW IF DICATT4=""
- IF '$DATA(DICATT4N)
- Begin DoDot:1
- +1 IF DICATTF=.001
- SET DICATT4N=" "
- QUIT
- +2 SET G=$$G(20)
- IF G=6
- SET DICATT4N=" ; "
- QUIT
- +3 ;Note that we can $$GET the defaulted values for storage, even if user has not seen Pages 3 or 4
- IF G=5!$$G(20.5)
- Begin DoDot:2
- +4 FOR T=76,76.1
- SET DICATTM(T)=$$GET^DDSVALF(T,"DICATTS",4,"","")
- IF DICATTM(T)=""
- SET DDSERROR=1
- SET DDSBR="76^DICATTS^4"
- QUIT
- End DoDot:2
- if $DATA(DDSERROR)
- QUIT
- SET DICATT4N=DICATTM(76)_";0"
- QUIT
- +5 SET G=$$GET^DDSVALF(16,"DICATTM",3,"","")
- SET T=$$GET^DDSVALF(17,"DICATTM",3,"","")
- +6 IF G=""!(T="")
- SET DDSERROR=1
- SET DDSBR="16^DICATTM^3"
- QUIT
- +7 SET DICATT4N=G_";"_T
- QUIT
- End DoDot:1
- IF $DATA(DDSERROR)
- DO HLP^DDSUTL("DATA-STORAGE INFO INCOMPLETE")
- QUIT
- +8 ;Can't fit it into the zero node
- SET X=^DD(DICATTA,DICATTF,0)
- Begin DoDot:1
- +9 SET T=$LENGTH(DICATT1N)+$LENGTH($SELECT($DATA(DICATT2N):DICATT2N,1:$PIECE(X,U,2)))+$LENGTH($SELECT($DATA(DICATT3N):DICATT3N,1:$PIECE(X,U,3)))+$LENGTH($SELECT($DATA(DICATT4N):DICATT4N,1:$PIECE(X,U,4)))+$LENGTH(...
- ... $SELECT($DATA(DICATT5N)#2:DICATT5N,1:$PIECE(X,U,5,999)))
- +10 IF T>($GET(^DD("STRING_LIMIT"),255)-13)
- SET DDSERROR=1
- End DoDot:1
- IF $DATA(DDSERROR)
- DO HLP^DDSUTL("FIELD DEFINITION IS TOO LONG!")
- QUIT
- +11 ;
- FILE ;Everything's good! We're gonna file it
- +1 ;new Piece 4
- IF $DATA(DICATT4N)
- SET $PIECE(^DD(DICATTA,DICATTF,0),U,4)=DICATT4N
- IF DICATT4N'?.P
- SET DICATT4S=$PIECE(DICATT4N,";")
- SET ^DD(DICATTA,"GL",DICATT4S,$PIECE(DICATT4N,";",2),DICATTF)=""
- +2 ;make a MULTIPLE
- IF $DATA(DICATTM)
- IF $DATA(DICATT4S)
- Begin DoDot:1
- +3 NEW TYPE
- SET TYPE=$$G(20)
- +4 DO MULMAKE^DICATTDD(DICATTM(76.1),TYPE)
- WP ;so we'll bounce back up from W-P multiple
- IF TYPE=5
- NEW DICATTA,DICATTF
- if '$DATA(DICATT2N)
- SET DICATT2N="W"
- +1 ;make the .01 Field of the new multiple
- SET DICATTA=DICATTM(76.1)
- SET DICATTF=.01
- SET DICATTMN=""
- +2 DO M101
- QUIT
- End DoDot:1
- QUIT
- M101 IF $GET(DICATT2N)["t"
- MERGE ^DD(DICATTA,DICATTF)=DICATTPM
- KILL DICATTPM
- +1 SET X=$EXTRACT("R",$$G(18))
- IF DICATT2["R"'=$LENGTH(X)!$DATA(DICATTMN)
- Begin DoDot:1
- +2 FOR %=DICATTA:0
- SET ^DD(%,0,"DT")=DT
- if '$DATA(^("UP"))
- QUIT
- SET %=^("UP")
- if '$DATA(^DD(%))
- QUIT
- +3 SET DICATTMN=""
- KILL ^DD(DICATTA,"RQ",DICATTF)
- IF X["R"
- SET ^(DICATTF)=""
- +4 IF '$DATA(DICATT2N)
- SET DICATT2N=$TRANSLATE(DICATT2,"R")
- IF DICATT2["W"
- SET DICATT2N="W"
- +5 SET DICATT2N=X_DICATT2N_$EXTRACT("I",$GET(DICATT2)["I")
- +6 ;remove old PT node
- SET %=$PIECE(DICATT2,"P",2)
- IF %
- KILL ^DD(+%,0,"PT",DICATTA,DICATTF)
- +7 SET %=$PIECE(DICATT2N,"P",2)
- IF %
- SET ^DD(+%,0,"PT",DICATTA,DICATTF)=""
- DIK2 IF DICATT2["t"
- DO AFDEFDEL^DIETLIB(DICATTA,DICATTF)
- COMPUTED IF DICATT2N["C"
- Begin DoDot:2
- +1 NEW DICOMPX,A,DA
- +2 SET A=+$PIECE(DICATT2,"p",2)
- IF A
- IF $DATA(^DD(A,0))
- KILL ^(0,"PTC",DICATTA,DICATTF)
- +3 SET A=+$PIECE(DICATT2N,"p",2)
- IF A
- IF $DATA(^DD(A,0))
- SET ^(0,"PTC",DICATTA,DICATTF)=""
- +4 SET (DA(1),A)=DICATTA
- SET DA=DICATTF
- SET DICOMPX=$GET(DICATT5N(9.01))
- KILL ^DD(A,DA,9.02)
- DO ACOMP^DICATT3
- End DoDot:2
- +5 IF DICATTF=.01
- Begin DoDot:2
- +6 IF DICATTA=DICATTB
- Begin DoDot:3
- +7 IF $DATA(^DIC(DICATTA,0,"GL"))
- IF $DATA(@(^("GL")_"0)"))
- DO UP2("",DICATT2N)
- End DoDot:3
- QUIT
- +8 SET Y=$$GET^DDSVALF(2,"DICATTMUL",5,"I","")
- IF Y?1N
- SET DICATT2N=$EXTRACT("M",Y=1)_DICATT2N
- +9 SET DR=$$GET^DDSVALF(1,"DICATTMUL",5,"I","")
- +10 ;Reset the MULTIPLE field at the higher level
- IF $GET(^DD(DICATTA,0,"UP"))
- SET Y=^("UP")
- SET %=$ORDER(^DD(Y,"SB",DICATTA,0))
- IF Y
- IF %
- IF $DATA(^DD(Y,%,0))
- DO UP2(DR,DICATT2N)
- End DoDot:2
- +11 ;SET THE SPECIFIER!
- SET $PIECE(^DD(DICATTA,DICATTF,0),U,2)=DICATT2N
- PIECE3 IF $DATA(DICATT3N)
- SET $PIECE(^(0),U,3)=$GET(DICATT3N)
- +1 IF $DATA(DICATTVP)
- DO FILE^DICATTD8
- DIK1 ;CROSS-REFERENCE THE SPECIFIER!
- NEW DIK,DA
- SET DA=DICATTF
- SET DA(1)=DICATTA
- SET DIK="^DD("_DICATTA_","
- SET DIK(1)=.2
- DO EN1^DIK
- End DoDot:1
- +1 ;
- SCREEN SET %=$$GET^DDSVALF(65,"DICATT SCREEN",6,"I","")
- SET X=$PIECE(^DD(DICATTA,DICATTF,0),U,2)
- IF %=0!(%="NO")!(X'["P"&(X'["S"))
- KILL ^(12),^(12.1)
- COMPNODS ;KILL ALL THE 9.2 NODES
- SET %=9.2
- FOR
- KILL ^DD(DICATTA,DICATTF,%)
- SET %=$ORDER(^(%))
- if %\1-9
- QUIT
- +1 ;SET THE 9.2 NODES
- FOR %=8:0
- SET %=$ORDER(DICATT5N(%))
- if '%
- QUIT
- SET ^DD(DICATTA,DICATTF,%)=DICATT5N(%)
- +2 IF $DATA(DICATT5N)#2
- SET $PIECE(^(0),U,5,99)=DICATT5N
- +3 SET DR="50////^S X=DT"
- FOR X=1:1:8
- DO 0
- +4 DO DIE
- EGP ;K ^DD(DICATTA,DICATTF,.009) ;WHEN FIELD CHANGES, KILL OFF ITS HELP TRANSLATIONS
- +1 SET DR="Q"
- SET X=98
- DO 0
- DO DIE
- +2 SET DR="Q"
- SET X=99
- DO 0
- DO DIE
- +3 DO FILEWORD^DICATTD0
- MUMPS ;**151
- IF $PIECE(^DD(DICATTA,DICATTF,0),U,2)["K"
- SET ^(9)="@"
- AUDIT ;Recompile CROSS-REFS if auditing changes
- IF $GET(DICATT2)]""
- IF $PIECE(^(0),U,2)'=DICATT2
- IF $GET(^DD(DICATTB,0,"DIK"))]""
- DO EN2^DIKZ(DICATTB,"",^("DIK"))
- RESET ;now that we have filed, the NEW is OLD, in case they keep editing!
- DO GET^DICATTD
- Q QUIT
- +1 ;
- UP2(A,X) ;A=0 if NO LAYGO X=SPECIFIER
- NEW T,Y
- +1 SET Y=$PIECE(^(0),U,2)
- SET Y=$TRANSLATE(Y,"SDPV")
- +2 FOR T="S","V","P","D"
- IF X[T
- SET Y=Y_T
- QUIT
- +3 IF A?1N
- SET Y=$TRANSLATE(Y,"A")_$EXTRACT("A",DR=0)
- +4 SET $PIECE(^(0),U,2)=Y
- +5 QUIT
- +6 ;
- 0 ;Re-file NAME, TITLE, etc. Delete if they are now gone. Leave "@" alone
- SET T=$TEXT(@X)
- SET G=$TRANSLATE($$G(X),";")
- if G="@"!(G="^")
- QUIT
- if G=""
- SET G="@"
- SET DR=DR_$PIECE(T,";",2,3)_"////"_G
- QUIT
- 1 ;;.01
- 2 ;;.1
- 3 ;;1.1
- 4 ;;1.2
- 5 ;;8
- 6 ;;8.5
- 7 ;;9
- 8 ;;10
- 98 ;;3
- 99 ;;4
- +1 ;
- DIE SET DICATTED=1
- SET DA=DICATTF
- SET DA(1)=DICATTA
- SET (DIC,DIE)="^DD(DICATTA,"
- +1 DO ^DIE
- +2 QUIT
- +3 ;
- N ;
- +1 SET DA=DICATTF
- IF $GET(DDA(1))]""
- if $GET(DICATTA)
- SET DDA(1)=DICATTA
- if '$DATA(^DD(DDA(1),DA))
- SET DDA="D"
- DO AUDT^DICATTA
- +2 IF $DATA(DIU0)
- NEW DI
- DO IJ^DIUTL(DICATTA)
- DO P^DICATT
- +3 QUIT
- +4 ;
- G(I) NEW X
- QUIT $$GET^DDSVALF(I,"DICATT",1,"I","")