Routine: DINIT12

DINIT12 ;SFISC/GFT,XAK-INITIALIZE VA FILEMAN ;16FEB2010

 ;;22.0;VA FileMan;**104,163**;Mar 30, 1999;Build 30

 ;Per VHA Directive 2004-038, this routine should not be modified.

DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G T:X?.P S @("^DD("_$E($P(X," ",2),3,99)_")=Y")

 ;;.4,0 FIELD^^1819^21

 ;;.4,0,"DT" 2950909

 ;;.4,.01,0 NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X

 ;;.4,.01,1,0 ^.1^2^2

 ;;.4,.01,1,1,0 .4^B

 ;;.4,.01,1,1,1 S @(DIC_"""B"",X,DA)=""""")

 ;;.4,.01,1,1,2 K @(DIC_"""B"",X,DA)")

 ;;.4,.01,1,2,0 ^^MUMPS

 ;;.4,.01,1,2,1 X "S %=$P("_DIC_"DA,0),U,4) S:$L(%) "_DIC_"""F""_+%,X,DA)=1"

 ;;.4,.01,1,2,2 X "S %=$P("_DIC_"DA,0),U,4) K:$L(%) "_DIC_"""F""_+%,X,DA)"

 ;;.4,.01,1,3,0 ^^MUMPS

 ;;.4,.01,1,3,1 Q

 ;;.4,.01,1,3,2 S X=-1 X "F  S X=$O("_DIC_"""AF"",X)) Q:X=""""  K:'X ^(X,DA) S Y=0 F  S Y=$O("_DIC_"""AF"",X,Y)) Q:Y'>0  K:$D(^(Y,DA)) ^(DA)" S X=-1 S:$G(Y)="" Y=-1

 ;;.4,.01,3 2-30 CHARACTERS

 ;;.4,2,0 DATE CREATED^D^^0;2^S %DT="ET" D ^%DT S X=Y K:Y<1 X

 ;;.4,3,0 READ ACCESS^F^^0;3^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q

 ;;.4,4,0 FILE^P1'I^DIC(^0;4^Q

 ;;.4,4,1,0 ^.1^1^1

 ;;.4,4,1,1,0 ^^^MUMPS

 ;;.4,4,1,1,1 X "S %=$P("_DIC_"DA,0),U,1),"_DIC_"""F""_+X,%,DA)=1"

 ;;.4,4,1,1,2 Q

 ;;.4,5,0 USER #^N^^0;5^Q

 ;;.4,6,0 WRITE ACCESS^F^^0;6^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q

 ;;.4,7,0 DATE LAST USED^D^^0;7^S %DT="EX" D ^%DT S X=Y K:Y<1 X

 ;;.4,1815,0 ROUTINE INVOKED^F^^ROU;E1,13^Q

 ;;.4,1815,9 @

 ;;.4,1815,1,0 ^.1^1^1

 ;;.4,1815,1,1,0 ^^^MUMPS

 ;;.4,1815,1,1,1 Q

 ;;.4,1815,1,1,2 D DELETROU^DIEZ($TR(X,U))

 ;;.4,1816,0 PREVIOUS ROUTINE INVOKED^F^^ROUOLD;E1,13^Q

 ;;.4,1816,9 @

 ;;.4,10,0 DESCRIPTION^.4001^^%D;0

 ;;.4001,0 DESCRIPTION SUB-FIELD^^.01^1

 ;;.4001,0,"NM","DESCRIPTION"

 ;;.4001,0,"UP" .4

 ;;.4001,.01,0 DESCRIPTION^W^^0;1^Q

T ;

 ;;N D,D1,D2 S D2=^(0) S:$X>30 D1(1,"F")="!" S D=$P(D2,U,2) S:D D1(2)="("_$$FMTE^DILIBF(D)_")",D1(2,"F")="?30" S D=$P(D2,U,5) S:D D1(3)=" User #"_D,D1(3,"F")="?50" S D=$P(D2,U,4) S:D D1(4)=" File #"_D,D1(4,"F")="?59" D EN^DDIOL(.D1)

 S ^DD(.4,0,"ID","WRITE")=$P($T(T+1),";",3,99)

 S %X="^DD(.4," S %Y="^DD(.402," D %XY^%RCR

 S %X="^DD(.4001," S %Y="^DD(.4021," D %XY^%RCR

 K ^DD(.402,1804),^("SB",.404),^DD(.402,"GL","RD",0,1804)

 S ^DIC(.4,"%D",0)="^^3^3^2940908^"

 S ^DIC(.4,"%D",1,0)="This file stores the PRINT FIELDS data and other information about print"

 S ^DIC(.4,"%D",2,0)="templates.  These templates are used in the Print, Filegram, Extract, and"

 S ^DIC(.4,"%D",3,0)="Export options."

 S ^DIC(.402,"%D",0)="^^1^1^2940908^^"

 S ^DIC(.402,"%D",1,0)="This file stores the EDIT FIELDS data from an input template."

DD1 F I=1:1 S X=$T(DD1+I),Y=$P(X," ",3,99) G DD2:X?.P S @("^DD("_$E($P(X," ",2),3,99)_")=Y")

 ;;.4,0,"ID","WRIT" I $P(^(0),U,8) N D1 S @("D1=$P($P($C(59)_$S($D(^DD(.4,8,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,8)_"":"",2),$C(59),1)") D EN^DDIOL("**"_D1_"**","","?0")

 ;;.4,0,"ID","WRITED" I $G(DZ)?1"???".E N % S %=0 F  S %=$O(^DIPT(Y,"%D",%)) Q:%'>0  I $D(^(%,0))#2 D EN^DDIOL(^(0),"","!?5")

 ;;.402,0,"ID","WRITED" I $G(DZ)?1"???".E N % S %=0 F  S %=$O(^DIE(Y,"%D",%)) Q:%'>0  I $D(^(%,0))#2 D EN^DDIOL(^(0),"","!?5")

 ;;.4,1620,9 ^

 ;;.4,1620,9.01

 ;;.4,1620,9.1 D ^DIET

 ;;.402,1620,0 EDIT FIELDS^Cm^^ ; ^D EN^DIET

 ;;.402,1620,21,0 ^

 ;;.402,1620,21,1,0 This multi-line field displays all the "EDIT" prompts of this Input Template

 ;;.402,1620,23,0 ^

 ;;.402,1620,23,1,0 This Computed Multiple uses code in ^DIETED to build the entire displayable Input Template.  Then it is output node-by-node.

 ;;.402,1819,9.1 S X=$S('$D(^DIE(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 ;;.4,1819,0 COMPILED^CJ3^^ ; ^S X=$S('$D(^DIPT(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 ;;.4,1819,9 ^

 ;;.4,1819,9.01

 ;;.4,1819,9.1 S X=$S('$D(^DIPT(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 ;;.402,1819,0 COMPILED^CJ3^^ ; ^S X=$S('$D(^DIE(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 ;;.402,1819,9.1 S X=$S('$D(^DIE(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

;;

DD2 N DICNT F DICNT=0:1:7 D @("^DINIT12"_DICNT)

 K DICNT G ^DINIT13

DINIT12   ;SFISC/GFT,XAK-INITIALIZE VA FILEMAN ;16FEB2010

 +1       ;;22.0;VA FileMan;**104,163**;Mar 30, 1999;Build 30

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

DD         FOR I=1:1

               SET X=$TEXT(DD+I)

               SET Y=$PIECE(X," ",3,99)

               IF X?.P

                   GOTO T

               SET @("^DD("_$EXTRACT($PIECE(X," ",2),3,99)_")=Y")

 +1       ;;.4,0 FIELD^^1819^21

 +2       ;;.4,0,"DT" 2950909

 +3       ;;.4,.01,0 NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X

 +4       ;;.4,.01,1,0 ^.1^2^2

 +5       ;;.4,.01,1,1,0 .4^B

 +6       ;;.4,.01,1,1,1 S @(DIC_"""B"",X,DA)=""""")

 +7       ;;.4,.01,1,1,2 K @(DIC_"""B"",X,DA)")

 +8       ;;.4,.01,1,2,0 ^^MUMPS

 +9       ;;.4,.01,1,2,1 X "S %=$P("_DIC_"DA,0),U,4) S:$L(%) "_DIC_"""F""_+%,X,DA)=1"

 +10      ;;.4,.01,1,2,2 X "S %=$P("_DIC_"DA,0),U,4) K:$L(%) "_DIC_"""F""_+%,X,DA)"

 +11      ;;.4,.01,1,3,0 ^^MUMPS

 +12      ;;.4,.01,1,3,1 Q

 +13      ;;.4,.01,1,3,2 S X=-1 X "F  S X=$O("_DIC_"""AF"",X)) Q:X=""""  K:'X ^(X,DA) S Y=0 F  S Y=$O("_DIC_"""AF"",X,Y)) Q:Y'>0  K:$D(^(Y,DA)) ^(DA)" S X=-1 S:$G(Y)="" Y=-1

 +14      ;;.4,.01,3 2-30 CHARACTERS

 +15      ;;.4,2,0 DATE CREATED^D^^0;2^S %DT="ET" D ^%DT S X=Y K:Y<1 X

 +16      ;;.4,3,0 READ ACCESS^F^^0;3^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q

 +17      ;;.4,4,0 FILE^P1'I^DIC(^0;4^Q

 +18      ;;.4,4,1,0 ^.1^1^1

 +19      ;;.4,4,1,1,0 ^^^MUMPS

 +20      ;;.4,4,1,1,1 X "S %=$P("_DIC_"DA,0),U,1),"_DIC_"""F""_+X,%,DA)=1"

 +21      ;;.4,4,1,1,2 Q

 +22      ;;.4,5,0 USER #^N^^0;5^Q

 +23      ;;.4,6,0 WRITE ACCESS^F^^0;6^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q

 +24      ;;.4,7,0 DATE LAST USED^D^^0;7^S %DT="EX" D ^%DT S X=Y K:Y<1 X

 +25      ;;.4,1815,0 ROUTINE INVOKED^F^^ROU;E1,13^Q

 +26      ;;.4,1815,9 @

 +27      ;;.4,1815,1,0 ^.1^1^1

 +28      ;;.4,1815,1,1,0 ^^^MUMPS

 +29      ;;.4,1815,1,1,1 Q

 +30      ;;.4,1815,1,1,2 D DELETROU^DIEZ($TR(X,U))

 +31      ;;.4,1816,0 PREVIOUS ROUTINE INVOKED^F^^ROUOLD;E1,13^Q

 +32      ;;.4,1816,9 @

 +33      ;;.4,10,0 DESCRIPTION^.4001^^%D;0

 +34      ;;.4001,0 DESCRIPTION SUB-FIELD^^.01^1

 +35      ;;.4001,0,"NM","DESCRIPTION"

 +36      ;;.4001,0,"UP" .4

 +37      ;;.4001,.01,0 DESCRIPTION^W^^0;1^Q

 +38      ;

T         ;

 +1       ;;N D,D1,D2 S D2=^(0) S:$X>30 D1(1,"F")="!" S D=$P(D2,U,2) S:D D1(2)="("_$$FMTE^DILIBF(D)_")",D1(2,"F")="?30" S D=$P(D2,U,5) S:D D1(3)=" User #"_D,D1(3,"F")="?50" S D=$P(D2,U,4) S:D D1(4)=" File #"_D,D1(4,"F")="?59" D EN^DDIOL(.D1)

 +2        SET ^DD(.4,0,"ID","WRITE")=$PIECE($TEXT(T+1),";",3,99)

 +3        SET %X="^DD(.4,"

           SET %Y="^DD(.402,"

           DO %XY^%RCR

 +4        SET %X="^DD(.4001,"

           SET %Y="^DD(.4021,"

           DO %XY^%RCR

 +5        KILL ^DD(.402,1804),^("SB",.404),^DD(.402,"GL","RD",0,1804)

 +6        SET ^DIC(.4,"%D",0)="^^3^3^2940908^"

 +7        SET ^DIC(.4,"%D",1,0)="This file stores the PRINT FIELDS data and other information about print"

 +8        SET ^DIC(.4,"%D",2,0)="templates.  These templates are used in the Print, Filegram, Extract, and"

 +9        SET ^DIC(.4,"%D",3,0)="Export options."

 +10       SET ^DIC(.402,"%D",0)="^^1^1^2940908^^"

 +11       SET ^DIC(.402,"%D",1,0)="This file stores the EDIT FIELDS data from an input template."

DD1        FOR I=1:1

               SET X=$TEXT(DD1+I)

               SET Y=$PIECE(X," ",3,99)

               IF X?.P

                   GOTO DD2

               SET @("^DD("_$EXTRACT($PIECE(X," ",2),3,99)_")=Y")

 +1       ;;.4,0,"ID","WRIT" I $P(^(0),U,8) N D1 S @("D1=$P($P($C(59)_$S($D(^DD(.4,8,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,8)_"":"",2),$C(59),1)") D EN^DDIOL("**"_D1_"**","","?0")

 +2       ;;.4,0,"ID","WRITED" I $G(DZ)?1"???".E N % S %=0 F  S %=$O(^DIPT(Y,"%D",%)) Q:%'>0  I $D(^(%,0))#2 D EN^DDIOL(^(0),"","!?5")

 +3       ;;.402,0,"ID","WRITED" I $G(DZ)?1"???".E N % S %=0 F  S %=$O(^DIE(Y,"%D",%)) Q:%'>0  I $D(^(%,0))#2 D EN^DDIOL(^(0),"","!?5")

 +4       ;;.4,1620,9 ^

 +5       ;;.4,1620,9.01

 +6       ;;.4,1620,9.1 D ^DIET

 +7       ;;.402,1620,0 EDIT FIELDS^Cm^^ ; ^D EN^DIET

 +8       ;;.402,1620,21,0 ^

 +9       ;;.402,1620,21,1,0 This multi-line field displays all the "EDIT" prompts of this Input Template

 +10      ;;.402,1620,23,0 ^

 +11      ;;.402,1620,23,1,0 This Computed Multiple uses code in ^DIETED to build the entire displayable Input Template.  Then it is output node-by-node.

 +12      ;;.402,1819,9.1 S X=$S('$D(^DIE(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 +13      ;;.4,1819,0 COMPILED^CJ3^^ ; ^S X=$S('$D(^DIPT(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 +14      ;;.4,1819,9 ^

 +15      ;;.4,1819,9.01

 +16      ;;.4,1819,9.1 S X=$S('$D(^DIPT(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 +17      ;;.402,1819,0 COMPILED^CJ3^^ ; ^S X=$S('$D(^DIE(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 +18      ;;.402,1819,9.1 S X=$S('$D(^DIE(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")

 +19      ;;

DD2        NEW DICNT

           FOR DICNT=0:1:7

               DO @("^DINIT12"_DICNT)

 +1        KILL DICNT

           GOTO ^DINIT13

DINIT12.m