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

DIU.m

Go to the documentation of this file.
  1. DIU ;SFISC/GFT-UTILITY FUNCTIONS ;7NOV2012
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  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. K DIU
  1. 0 S DIC="^DOPT(""DIU"","
  1. G OPT:$D(^DOPT("DIU",11)) S ^(0)="UTILITY OPTION^1.01" K ^("B")
  1. F X=1:1:11 S ^DOPT("DIU",X,0)=$P($T(@X),";;",2)
  1. S DIK=DIC D IXALL^DIK S ^DOPT("DICR",0)="TYPE OF INDEXING^1.01"
  1. F X=1:1:7 S ^DOPT("DICR",X,0)=$P("REGULAR^KWIC^MNEMONIC^MUMPS^SOUNDEX^TRIGGER^BULLETIN",U,X)
  1. S DIK="^DOPT(""DICR""," D IXALL^DIK G 0
  1. OPT ;
  1. S DIC(0)="AEQIZ" S:DUZ(0)'="@" DIC("S")="I Y-5"
  1. D ^DIC G Q:Y<0 S DI=Y D EN G 0
  1. ;
  1. EN ;
  1. I +DI=2 D G:'$D(DI) Q
  1. . W ! S Y=$$TYPE^DIKCUTL2 Q:Y=1
  1. . D:Y=2 MOD^DIKCUTL
  1. . K DI
  1. D D^DICRW G Q:Y<0 I '$D(DIC) D DIE^DIB G Q:'$D(DG) S DIC=DG
  1. S DIU=DIC,DIU(0)="EDT" K DICS
  1. K DIC,I,J S Y=DI,N=0,DI=+$P($G(@(DIU_"0)")),U,2),J(0)=DI,I(0)=DIU
  1. I 'DI W $C(7),!,"Missing or incomplete global node "_DIU_"0)",! G Q
  1. DDA S DDA=""
  1. D @+Y W !!
  1. Q K %,DIUF,DG,DGG,DIC,DIU,DJJ,DIK,DI,DA,I,J,X,Y,DICD,DICDF,DDA,DIFLD,DTOUT,DUOUT,DR Q
  1. ;
  1. 1 ;;VERIFY FIELDS
  1. G ^DIV
  1. ;
  1. 2 ;;CROSS-REFERENCE A FIELD OR FILE
  1. S X="CW" D DI Q:Y<.002 G ^DICD
  1. ;
  1. 3 ;;IDENTIFIER
  1. S X="CW.01" D DIAX Q:'$T D DI Q:Y<0 G 3^DIU3
  1. ;
  1. 4 ;;RE-INDEX FILE
  1. G 4^DIU1
  1. ;
  1. 5 ;;INPUT TRANSFORM (SYNTAX)
  1. S X="W" D DIAX Q:'$T D DI Q:Y<0 G 5^DIU31
  1. ;
  1. 6 ;;EDIT FILE
  1. G 6^DIU0
  1. ;
  1. 7 ;;OUTPUT TRANSFORM
  1. S X="CW" D DI Q:Y<0 G O^DIU31
  1. ;
  1. 8 ;;TEMPLATE EDIT
  1. G 0^DIBT
  1. ;
  1. 9 ;;UNEDITABLE DATA
  1. S X="C" D DIAX Q:'$T D DI Q:Y<0 G 9^DIU31
  1. ;
  1. 10 ;;MANDATORY/REQUIRED FIELD CHECK
  1. G ^DIVRE
  1. ;
  1. 11 ;;KEY DEFINITION
  1. G MOD^DIKKUTL
  1. ;
  1. 99 ;;SPECIFIER
  1. S X="CW",N=0 D DI Q:Y<0 G ^DIU4 ;NOT USED??
  1. ;
  1. DI ;
  1. S DIC(0)="ZQEAI"
  1. D ;
  1. 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)"")"
  1. 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
  1. 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)
  1. Q
  1. 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))
  1. W:'$T !!,$C(7),"THIS DATA DICTIONARY CHANGE IS NOT ALLOWED ON AN ARCHIVE FILE!"
  1. Q