DINIT5 ;SFISC/GFT-INITIALIZE VA FILEMAN ;25SEP2010
;;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.
;
DOPT K ^DOPT("DDS"),^("DICR"),^("DDU"),^("DIAR"),^("DIAU"),^("DIBT"),^("DICATT"),^("DICR"),^("DID"),^("DIFG"),^("DII"),^("DII1"),^("DIS"),^("DIT"),^("DIU"),^("DIX"),^("DIAX"),^("DDXP")
S ^DOPT("DICATT",0)="DATA TYPE^1.01"
F I=1:1:9 S ^DOPT("DICATT",I,0)=$P("DATE/TIME^NUMERIC^SET OF CODES^FREE TEXT^WORD-PROCESSING^COMPUTED^POINTER TO A FILE^VARIABLE-POINTER^MUMPS",U,I)
S ^DOPT("DIS",0)="CONDITION^1.01",^DOPT("DID",0)="LISTING FORMAT^1.01",^DOPT("DICR",0)="TYPE OF INDEXING^1.01"
F I=1:1:6 S ^DOPT("DIS",I,0)=$P("NULL^^1;CONTAINS^[^1;MATCHES^^1;LESS THAN^<^;EQUALS^=^1;GREATER THAN^>^",";",I) S:I-1&(I-3) ^DOPT("DIS","B",$P(^(0),U,2),I)=1
F I=1:1:9 S ^DOPT("DID",I,0)=$P("STANDARD^BRIEF^CUSTOM-TAILORED^MODIFIED STANDARD^TEMPLATES ONLY^GLOBAL MAP^CONDENSED^INDEXES ONLY^KEYS ONLY",U,I)
F I=1:1:7 S ^DOPT("DICR",I,0)=$P("REGULAR^KWIC^MNEMONIC^MUMPS^SOUNDEX^TRIGGER^BULLETIN",U,I)
F I="DID","DIS","DICATT","DICR" S DIK="^DOPT("""_I_"""," D IXALL^DIK
S DIK="^DD(""FUNC""," D IXALL^DIK
D DT^DICRW I '$D(^DD("VERSION")) D FIX S %="" F I=0:0 S %=$O(^DISV(%)) G V:%="" K ^DISV(%)
F I=2:1:6 W ".." I ^("VERSION")<$P("^14.3^14.7^16^16.07^16.39",U,I) D @("FIX"_I) Q
V K ^DD(0,"B","HELP FRAME") G ^DINIT6
;
FIX ;
N DIDUZ
S U="^",DH="DIC("
F D=0:1 Q:$O(^DIBT(D))'>0
S DIDUZ=0 F S DIDUZ=+$O(^DISV(DIDUZ)) Q:'DIDUZ S I=0 F S I=$O(^DISV(DIDUZ,I)) Q:I'>0 I $O(^(I,0))>0 D PUT
S DIK="^DIBT(" D IXALL^DIK G FIX2
;
PUT S X=^(0),Y=U_$P(X,U,2) I Y]U,@("$D("_Y_"0))") S DIC=+$P(^(0),U,2) I $D(^DIC(DIC,0,"GL")),^("GL")=Y G GOT
Q
GOT S D=D+1,^DIBT(D,0)=$P(X,U,1)_U_$P(X,U,3)_U_U_+DIC_U_DIDUZ
S X=0 F S X=$O(^DISV(DIDUZ,I,X)) Q:X'>0 S ^DIBT(D,1,X)=""
S Y="",X=0 F S Y=$O(^DISV(DIDUZ,I,0,Y)) Q:Y="" S ^DIBT(D,"DIS",Y)=^(Y)
S Y=-1 Q
;
UP S D=0 F S D=$O(^DD(J,D)) Q:D'>0 I $D(^(D,0)),$P(^(0),U,2)>J S J(+$P(^(0),U,2))=J
S:D="" D=-1 S J=$O(J(0)) S:J="" J=-1 Q:J<0 S ^DD(J,0,"UP")=J(J) K J(J) G UP
;
FIX2 S I=1 F S I=$O(^DIC(I)) Q:I'>0 I $D(^(I,0,"GL")),@("$D("_^("GL")_"0))"),$P(^(0),U,2)["N",'$D(^DD(I,.001)) S ^(.001,0)="NUMBER^N^^ ^K:$L(X)>9 X I $D(X) K:+X'=X!(X'>0) X",^DD(I,"B","NUMBER",.001)=""
S I=0 F S I=$O(^DD(I)) Q:I'>0 S J=0 F S J=$O(^DD(I,J)) Q:J'>0 S X=$P(^(J,0),U,2),F=$F(X,"P") I 'X,F,'$E(X,F,99),@("$D(^"_$P(^(0),U,3)_"0))") S P=+$P(^(0),U,2),^(0)=$P(^DD(I,J,0),U,1)_U_$E(X,1,F-1)_P_$E(X,F,99)_U_$P(^(0),U,3,99)
;
FIX3 S I=.9 F S I=$O(^DIPT(I)) Q:I'>0 I $D(^(I,0)) S X=$P(^(0),U,3) I $P(^(0),U,6)="" S ^(0)=$P(^(0)_"^^^^",U,1,5)_U_X
S:I="" I=-1 S DD=1 F S DD=$O(^DD(DD)) Q:DD'>0 S %=0 F S %=$O(^DD(DD,"SB",%)) Q:%="" S ^DD(%,0,"UP")=DD
S:DD="" DD=-1 S %=-1
;
FIX4 S F=1 F S F=$O(^DD(F)) Q:F'>0 I $D(^(F,"GR")) K ^("GR") S DIK="^DD("_F_",",DA(1)=F D IXALL^DIK
;
FIX5 S F=1 F S F=$O(^DIC(F)) Q:F'>0 S I=$S($D(^(F,0,"DT")):^("DT"),1:0),J=$S($D(^("U")):^("U"),1:0) S:I!J ^DIC(F,"%A")=J_U_I
;
FIX6 K J S F=1 F S (J,F)=$O(^DIC(F)) Q:F'>0 D UP
S:F="" (F,J)=-1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDINIT5 3310 printed Apr 09, 2024@21:50 Page 2
DINIT5 ;SFISC/GFT-INITIALIZE VA FILEMAN ;25SEP2010
+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 ;
DOPT KILL ^DOPT("DDS"),^("DICR"),^("DDU"),^("DIAR"),^("DIAU"),^("DIBT"),^("DICATT"),^("DICR"),^("DID"),^("DIFG"),^("DII"),^("DII1"),^("DIS"),^("DIT"),^("DIU"),^("DIX"),^("DIAX"),^("DDXP")
+1 SET ^DOPT("DICATT",0)="DATA TYPE^1.01"
+2 FOR I=1:1:9
SET ^DOPT("DICATT",I,0)=$PIECE("DATE/TIME^NUMERIC^SET OF CODES^FREE TEXT^WORD-PROCESSING^COMPUTED^POINTER TO A FILE^VARIABLE-POINTER^MUMPS",U,I)
+3 SET ^DOPT("DIS",0)="CONDITION^1.01"
SET ^DOPT("DID",0)="LISTING FORMAT^1.01"
SET ^DOPT("DICR",0)="TYPE OF INDEXING^1.01"
+4 FOR I=1:1:6
SET ^DOPT("DIS",I,0)=$PIECE("NULL^^1;CONTAINS^[^1;MATCHES^^1;LESS THAN^<^;EQUALS^=^1;GREATER THAN^>^",";",I)
if I-1&(I-3)
SET ^DOPT("DIS","B",$PIECE(^(0),U,2),I)=1
+5 FOR I=1:1:9
SET ^DOPT("DID",I,0)=$PIECE("STANDARD^BRIEF^CUSTOM-TAILORED^MODIFIED STANDARD^TEMPLATES ONLY^GLOBAL MAP^CONDENSED^INDEXES ONLY^KEYS ONLY",U,I)
+6 FOR I=1:1:7
SET ^DOPT("DICR",I,0)=$PIECE("REGULAR^KWIC^MNEMONIC^MUMPS^SOUNDEX^TRIGGER^BULLETIN",U,I)
+7 FOR I="DID","DIS","DICATT","DICR"
SET DIK="^DOPT("""_I_""","
DO IXALL^DIK
+8 SET DIK="^DD(""FUNC"","
DO IXALL^DIK
+9 DO DT^DICRW
IF '$DATA(^DD("VERSION"))
DO FIX
SET %=""
FOR I=0:0
SET %=$ORDER(^DISV(%))
if %=""
GOTO V
KILL ^DISV(%)
+10 FOR I=2:1:6
WRITE ".."
IF ^("VERSION")<$PIECE("^14.3^14.7^16^16.07^16.39",U,I)
DO @("FIX"_I)
QUIT
V KILL ^DD(0,"B","HELP FRAME")
GOTO ^DINIT6
+1 ;
FIX ;
+1 NEW DIDUZ
+2 SET U="^"
SET DH="DIC("
+3 FOR D=0:1
if $ORDER(^DIBT(D))'>0
QUIT
+4 SET DIDUZ=0
FOR
SET DIDUZ=+$ORDER(^DISV(DIDUZ))
if 'DIDUZ
QUIT
SET I=0
FOR
SET I=$ORDER(^DISV(DIDUZ,I))
if I'>0
QUIT
IF $ORDER(^(I,0))>0
DO PUT
+5 SET DIK="^DIBT("
DO IXALL^DIK
GOTO FIX2
+6 ;
PUT SET X=^(0)
SET Y=U_$PIECE(X,U,2)
IF Y]U
IF @("$D("_Y_"0))")
SET DIC=+$PIECE(^(0),U,2)
IF $DATA(^DIC(DIC,0,"GL"))
IF ^("GL")=Y
GOTO GOT
+1 QUIT
GOT SET D=D+1
SET ^DIBT(D,0)=$PIECE(X,U,1)_U_$PIECE(X,U,3)_U_U_+DIC_U_DIDUZ
+1 SET X=0
FOR
SET X=$ORDER(^DISV(DIDUZ,I,X))
if X'>0
QUIT
SET ^DIBT(D,1,X)=""
+2 SET Y=""
SET X=0
FOR
SET Y=$ORDER(^DISV(DIDUZ,I,0,Y))
if Y=""
QUIT
SET ^DIBT(D,"DIS",Y)=^(Y)
+3 SET Y=-1
QUIT
+4 ;
UP SET D=0
FOR
SET D=$ORDER(^DD(J,D))
if D'>0
QUIT
IF $DATA(^(D,0))
IF $PIECE(^(0),U,2)>J
SET J(+$PIECE(^(0),U,2))=J
+1 if D=""
SET D=-1
SET J=$ORDER(J(0))
if J=""
SET J=-1
if J<0
QUIT
SET ^DD(J,0,"UP")=J(J)
KILL J(J)
GOTO UP
+2 ;
FIX2 SET I=1
FOR
SET I=$ORDER(^DIC(I))
if I'>0
QUIT
IF $DATA(^(I,0,"GL"))
IF @("$D("_^("GL")_"0))")
IF $PIECE(^(0),U,2)["N"
IF '$DATA(^DD(I,.001))
SET ^(.001,0)="NUMBER^N^^ ^K:$L(X)>9 X I $D(X) K:+X'=X!(X'>0) X"
SET ^DD(I,"B","NUMBER",.001)=""
+1 SET I=0
FOR
SET I=$ORDER(^DD(I))
if I'>0
QUIT
SET J=0
FOR
SET J=$ORDER(^DD(I,J))
if J'>0
QUIT
SET X=$PIECE(^(J,0),U,2)
SET F=$FIND(X,"P")
IF 'X
IF F
IF '$EXTRACT(X,F,99)
IF @("$D(^"_$PIECE(^(0),U,3)_"0))")
SET P=+$PIECE(^(0),U,2)
SET ^(0)=$PIECE(^DD(I,J,0),U,1)_U_$EXTRACT(X,1,F-1)_P_$EXTRACT(X,F,99)_U_$PIECE(^(0),U,3,99)
+2 ;
FIX3 SET I=.9
FOR
SET I=$ORDER(^DIPT(I))
if I'>0
QUIT
IF $DATA(^(I,0))
SET X=$PIECE(^(0),U,3)
IF $PIECE(^(0),U,6)=""
SET ^(0)=$PIECE(^(0)_"^^^^",U,1,5)_U_X
+1 if I=""
SET I=-1
SET DD=1
FOR
SET DD=$ORDER(^DD(DD))
if DD'>0
QUIT
SET %=0
FOR
SET %=$ORDER(^DD(DD,"SB",%))
if %=""
QUIT
SET ^DD(%,0,"UP")=DD
+2 if DD=""
SET DD=-1
SET %=-1
+3 ;
FIX4 SET F=1
FOR
SET F=$ORDER(^DD(F))
if F'>0
QUIT
IF $DATA(^(F,"GR"))
KILL ^("GR")
SET DIK="^DD("_F_","
SET DA(1)=F
DO IXALL^DIK
+1 ;
FIX5 SET F=1
FOR
SET F=$ORDER(^DIC(F))
if F'>0
QUIT
SET I=$SELECT($DATA(^(F,0,"DT")):^("DT"),1:0)
SET J=$SELECT($DATA(^("U")):^("U"),1:0)
if I!J
SET ^DIC(F,"%A")=J_U_I
+1 ;
FIX6 KILL J
SET F=1
FOR
SET (J,F)=$ORDER(^DIC(F))
if F'>0
QUIT
DO UP
+1 if F=""
SET (F,J)=-1
