Return to DINIT12.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DINIT12.m, revision 1.1.1.1

1.1       snw         1: DINIT12        ;SFISC/GFT,XAK-INITIALIZE VA FILEMAN ;08:20 AM  14 Sep 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4: 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")
                      5:        ;;.4,0 FIELD^^1819^21
                      6:        ;;.4,0,"DT" 2921229
                      7:        ;;.4,.01,0 NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X
                      8:        ;;.4,.01,1,0 ^.1^2^2
                      9:        ;;.4,.01,1,1,0 .4^B
                     10:        ;;.4,.01,1,1,1 S @(DIC_"""B"",X,DA)=""""")
                     11:        ;;.4,.01,1,1,2 K @(DIC_"""B"",X,DA)")
                     12:        ;;.4,.01,1,2,0 ^^MUMPS
                     13:        ;;.4,.01,1,2,1 X "S %=$P("_DIC_"DA,0),U,4) S:$L(%) "_DIC_"""F""_+%,X,DA)=1"
                     14:        ;;.4,.01,1,2,2 X "S %=$P("_DIC_"DA,0),U,4) K:$L(%) "_DIC_"""F""_+%,X,DA)"
                     15:        ;;.4,.01,1,3,0 ^^MUMPS
                     16:        ;;.4,.01,1,3,1 Q
                     17:        ;;.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
                     18:        ;;.4,.01,3 2-30 CHARACTERS
                     19:        ;;.4,2,0 DATE CREATED^D^^0;2^S %DT="ET" D ^%DT S X=Y K:Y<1 X
                     20:        ;;.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
                     21:        ;;.4,4,0 FILE^P1'I^DIC(^0;4^Q
                     22:        ;;.4,4,1,0 ^.1^1^1
                     23:        ;;.4,4,1,1,0 ^^^MUMPS
                     24:        ;;.4,4,1,1,1 X "S %=$P("_DIC_"DA,0),U,1),"_DIC_"""F""_+X,%,DA)=1"
                     25:        ;;.4,4,1,1,2 Q
                     26:        ;;.4,5,0 USER #^N^^0;5^Q
                     27:        ;;.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
                     28:        ;;.4,7,0 DATE LAST USED^D^^0;7^S %DT="EX" D ^%DT S X=Y K:Y<1 X
                     29:        ;;.4,1815,0 ROUTINE INVOKED^F^^ROU;E1,13^Q
                     30:        ;;.4,1815,9 @
                     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:        ;
                     39: T      ;
                     40:        ;;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)
                     41:        S ^DD(.4,0,"ID","WRITE")=$P($T(T+1),";",3,99)
                     42:        S %X="^DD(.4," F %Y="^DD(.401,","^DD(.402," D %XY^%RCR
                     43:        S %X="^DD(.4001," F %Y="^DD(.4012,","^DD(.4021," D %XY^%RCR
                     44:        K ^DD(.402,1804),^("SB",.404),^DD(.402,"GL","RD",0,1804),^DD(.401,1815),^(1816),^(1620),^(.01,1,3)
                     45:        S ^DIC(.4,"%D",0)="^^3^3^2940908^"
                     46:        S ^DIC(.4,"%D",1,0)="This file stores the PRINT FIELDS data and other information about print"
                     47:        S ^DIC(.4,"%D",2,0)="templates.  These templates are used in the Print, Filegram, Extract, and"
                     48:        S ^DIC(.4,"%D",3,0)="Export options."
                     49:        S ^DIC(.402,"%D",0)="^^1^1^2940908^^"
                     50:        S ^DIC(.402,"%D",1,0)="This file stores the EDIT FIELDS data from an input template."
                     51: 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")
                     52:        ;;.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")
                     53:        ;;.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")
                     54:        ;;.401,0,"ID","WRITED" I $G(DZ)?1"???".E N % S %=0 F  S %=$O(^DIBT(Y,"%D",%)) Q:%'>0  I $D(^(%,0))#2 D EN^DDIOL(^(0),"","!?5")
                     55:        ;;.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")
                     56:        ;;.4,1819,0 COMPILED^CJ3^^ ; ^S X=$S('$D(^DIPT(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")
                     57:        ;;.4,1819,9 ^
                     58:        ;;.4,1819,9.01
                     59:        ;;.4,1819,9.1 S X=$S('$D(^DIPT(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")
                     60:        ;;.402,1819,0 COMPILED^CJ3^^ ; ^S X=$S('$D(^DIE(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")
                     61:        ;;.402,1819,9 ^
                     62:        ;;.402,1819,9.01
                     63:        ;;.402,1819,9.1 S X=$S('$D(^DIE(D0,"ROU"))#2:"NO",^("ROU")="":"NO",1:"YES")
                     64:        ;;
                     65: DD2    N DICNT F DICNT=0:1:7 D @("^DINIT12"_DICNT)
                     66:        K DICNT G ^DINIT13