DIU ;SFISC/GFT-UTILITY FUNCTIONS ;7NOV2012
;;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.
;
K DIU
0 S DIC="^DOPT(""DIU"","
G OPT:$D(^DOPT("DIU",11)) S ^(0)="UTILITY OPTION^1.01" K ^("B")
F X=1:1:11 S ^DOPT("DIU",X,0)=$P($T(@X),";;",2)
S DIK=DIC D IXALL^DIK S ^DOPT("DICR",0)="TYPE OF INDEXING^1.01"
F X=1:1:7 S ^DOPT("DICR",X,0)=$P("REGULAR^KWIC^MNEMONIC^MUMPS^SOUNDEX^TRIGGER^BULLETIN",U,X)
S DIK="^DOPT(""DICR""," D IXALL^DIK G 0
OPT ;
S DIC(0)="AEQIZ" S:DUZ(0)'="@" DIC("S")="I Y-5"
D ^DIC G Q:Y<0 S DI=Y D EN G 0
;
EN ;
I +DI=2 D G:'$D(DI) Q
. W ! S Y=$$TYPE^DIKCUTL2 Q:Y=1
. D:Y=2 MOD^DIKCUTL
. K DI
D D^DICRW G Q:Y<0 I '$D(DIC) D DIE^DIB G Q:'$D(DG) S DIC=DG
S DIU=DIC,DIU(0)="EDT" K DICS
K DIC,I,J S Y=DI,N=0,DI=+$P($G(@(DIU_"0)")),U,2),J(0)=DI,I(0)=DIU
I 'DI W $C(7),!,"Missing or incomplete global node "_DIU_"0)",! G Q
DDA S DDA=""
D @+Y W !!
Q K %,DIUF,DG,DGG,DIC,DIU,DJJ,DIK,DI,DA,I,J,X,Y,DICD,DICDF,DDA,DIFLD,DTOUT,DUOUT,DR Q
;
1 ;;VERIFY FIELDS
G ^DIV
;
2 ;;CROSS-REFERENCE A FIELD OR FILE
S X="CW" D DI Q:Y<.002 G ^DICD
;
3 ;;IDENTIFIER
S X="CW.01" D DIAX Q:'$T D DI Q:Y<0 G 3^DIU3
;
4 ;;RE-INDEX FILE
G 4^DIU1
;
5 ;;INPUT TRANSFORM (SYNTAX)
S X="W" D DIAX Q:'$T D DI Q:Y<0 G 5^DIU31
;
6 ;;EDIT FILE
G 6^DIU0
;
7 ;;OUTPUT TRANSFORM
S X="CW" D DI Q:Y<0 G O^DIU31
;
8 ;;TEMPLATE EDIT
G 0^DIBT
;
9 ;;UNEDITABLE DATA
S X="C" D DIAX Q:'$T D DI Q:Y<0 G 9^DIU31
;
10 ;;MANDATORY/REQUIRED FIELD CHECK
G ^DIVRE
;
11 ;;KEY DEFINITION
G MOD^DIKKUTL
;
99 ;;SPECIFIER
S X="CW",N=0 D DI Q:Y<0 G ^DIU4 ;NOT USED??
;
DI ;
S DIC(0)="ZQEAI"
D ;
S DIC="^DD("_DI_",",DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")"
S DIC("S")="S %=$P(^(0),U,2) I 1"_$P(",$O(^(1,0))!%","Z",X["R")_$P(",%'[""C""",U,X["C")_$P(",$P(^DD(+%,.01,0),U,2)'[""W""",9,X["W")_$P(",Y-.01",U,X[.01),DA=X
D ^DIC K DIC("S") I Y>0,$P(Y(0),U,2) S N=N+1,X=$P($P(Y(0),U,4),";",1),DI=$E("""",+X'=X),I(N)=DI_X_DI,(DI,J(N))=+$P(Y(0),U,2),X=DA G DI:$P(^DD(DI,.01,0),U,2)'["W" S Y(0)=^(0),Y=.01_U_$P(Y(0),U)
Q
DIAX I '$D(^DD(DI,0,"DI"))!($P($G(^("DI")),U)'["Y")!($P($G(^("DI")),U)["Y"&'$P(@(^DIC(DI,0,"GL")_"0)"),U,4))
W:'$T !!,$C(7),"THIS DATA DICTIONARY CHANGE IS NOT ALLOWED ON AN ARCHIVE FILE!"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIU 2607 printed Dec 13, 2024@02:54:32 Page 2
DIU ;SFISC/GFT-UTILITY FUNCTIONS ;7NOV2012
+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 ;
+7 KILL DIU
0 SET DIC="^DOPT(""DIU"","
+1 if $DATA(^DOPT("DIU",11))
GOTO OPT
SET ^(0)="UTILITY OPTION^1.01"
KILL ^("B")
+2 FOR X=1:1:11
SET ^DOPT("DIU",X,0)=$PIECE($TEXT(@X),";;",2)
+3 SET DIK=DIC
DO IXALL^DIK
SET ^DOPT("DICR",0)="TYPE OF INDEXING^1.01"
+4 FOR X=1:1:7
SET ^DOPT("DICR",X,0)=$PIECE("REGULAR^KWIC^MNEMONIC^MUMPS^SOUNDEX^TRIGGER^BULLETIN",U,X)
+5 SET DIK="^DOPT(""DICR"","
DO IXALL^DIK
GOTO 0
OPT ;
+1 SET DIC(0)="AEQIZ"
if DUZ(0)'="@"
SET DIC("S")="I Y-5"
+2 DO ^DIC
if Y<0
GOTO Q
SET DI=Y
DO EN
GOTO 0
+3 ;
EN ;
+1 IF +DI=2
Begin DoDot:1
+2 WRITE !
SET Y=$$TYPE^DIKCUTL2
if Y=1
QUIT
+3 if Y=2
DO MOD^DIKCUTL
+4 KILL DI
End DoDot:1
if '$DATA(DI)
GOTO Q
+5 DO D^DICRW
if Y<0
GOTO Q
IF '$DATA(DIC)
DO DIE^DIB
if '$DATA(DG)
GOTO Q
SET DIC=DG
+6 SET DIU=DIC
SET DIU(0)="EDT"
KILL DICS
+7 KILL DIC,I,J
SET Y=DI
SET N=0
SET DI=+$PIECE($GET(@(DIU_"0)")),U,2)
SET J(0)=DI
SET I(0)=DIU
+8 IF 'DI
WRITE $CHAR(7),!,"Missing or incomplete global node "_DIU_"0)",!
GOTO Q
DDA SET DDA=""
+1 DO @+Y
WRITE !!
Q KILL %,DIUF,DG,DGG,DIC,DIU,DJJ,DIK,DI,DA,I,J,X,Y,DICD,DICDF,DDA,DIFLD,DTOUT,DUOUT,DR
QUIT
+1 ;
1 ;;VERIFY FIELDS
+1 GOTO ^DIV
+2 ;
2 ;;CROSS-REFERENCE A FIELD OR FILE
+1 SET X="CW"
DO DI
if Y<.002
QUIT
GOTO ^DICD
+2 ;
3 ;;IDENTIFIER
+1 SET X="CW.01"
DO DIAX
if '$TEST
QUIT
DO DI
if Y<0
QUIT
GOTO 3^DIU3
+2 ;
4 ;;RE-INDEX FILE
+1 GOTO 4^DIU1
+2 ;
5 ;;INPUT TRANSFORM (SYNTAX)
+1 SET X="W"
DO DIAX
if '$TEST
QUIT
DO DI
if Y<0
QUIT
GOTO 5^DIU31
+2 ;
6 ;;EDIT FILE
+1 GOTO 6^DIU0
+2 ;
7 ;;OUTPUT TRANSFORM
+1 SET X="CW"
DO DI
if Y<0
QUIT
GOTO O^DIU31
+2 ;
8 ;;TEMPLATE EDIT
+1 GOTO 0^DIBT
+2 ;
9 ;;UNEDITABLE DATA
+1 SET X="C"
DO DIAX
if '$TEST
QUIT
DO DI
if Y<0
QUIT
GOTO 9^DIU31
+2 ;
10 ;;MANDATORY/REQUIRED FIELD CHECK
+1 GOTO ^DIVRE
+2 ;
11 ;;KEY DEFINITION
+1 GOTO MOD^DIKKUTL
+2 ;
99 ;;SPECIFIER
+1 ;NOT USED??
SET X="CW"
SET N=0
DO DI
if Y<0
QUIT
GOTO ^DIU4
+2 ;
DI ;
+1 SET DIC(0)="ZQEAI"
D ;
+1 SET DIC="^DD("_DI_","
SET DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")"
+2 SET DIC("S")="S %=$P(^(0),U,2) I 1"_$PIECE(",$O(^(1,0))!%","Z",X["R")_$PIECE(",%'[""C""",U,X["C")_$PIECE(",$P(^DD(+%,.01,0),U,2)'[""W""",9,X["W")_$PIECE(",Y-.01",U,X[.01)
SET DA=X
+3 DO ^DIC
KILL DIC("S")
IF Y>0
IF $PIECE(Y(0),U,2)
SET N=N+1
SET X=$PIECE($PIECE(Y(0),U,4),";",1)
SET DI=$EXTRACT("""",+X'=X)
SET I(N)=DI_X_DI
SET (DI,J(N))=+$PIECE(Y(0),U,2)
SET X=DA
if $PIECE(^DD(DI,.01,0),U,2)'["W"
GOTO DI
SET Y(0)=^(0)
SET Y=.01_U_$PIECE(Y(0),U)
+4 QUIT
DIAX IF '$DATA(^DD(DI,0,"DI"))!($PIECE($GET(^("DI")),U)'["Y")!($PIECE($GET(^("DI")),U)["Y"&'$PIECE(@(^DIC(DI,0,"GL")_"0)"),U,4))
+1 if '$TEST
WRITE !!,$CHAR(7),"THIS DATA DICTIONARY CHANGE IS NOT ALLOWED ON AN ARCHIVE FILE!"
+2 QUIT
