- 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 Jan 18, 2025@03:55:30 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