Return to DIDH1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIDH1.m, revision 1.1.1.1

1.1       snw         1: DIDH1  ;SFISC/XAK-HDR FOR DD LISTS ;12/16/94  14:13
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        S M=1 I DC=1 S (F(1),DA)=DFF,Z=1
                      5:        E  I $Y,IOST?1"C".E W $C(7) R M:DTIME I M=U!'$T K DIOEND S M=U,DN=0 Q
                      6:        S M1=$S($G(^DD(F(1),0,"VR"))]"":" (VERSION "_$P(^("VR"),U)_")   ",1:"") I IOST?1"C".E S DIFF=1
                      7:        W:$D(DIFF)&($Y) @IOF S DIFF=1 W $S(DHIT["DIDX":"BRIEF",DHIT["DIDG":"GLOBAL MAP",$D(DINM):"MODIFIED",1:"STANDARD")
                      8:        W " DATA DICTIONARY #"_DFF_" -- "_$O(^DD(DFF,0,"NM",0))_" "_$P("SUB-",U,$D(^DD(DFF,0,"UP")))_"FILE   "
                      9:        S DIC=^DIC(DUB,0,"GL"),W=$E(DT,4,5)_"/"_(DT#100)_"/"_$E(DT,2,3)_"  PAGE "_DC W ?(IOM-$L(W)-1),W
                     10:        S M=IOM\2,S=" ",W="" I $D(^DD("SITE")) S W="SITE: "_^("SITE")_"   "
                     11:        I $D(^%ZOSF("UCI"))#2 X ^("UCI") S W=W_"UCI: "_Y
                     12:        W ! I DHIT["DIDX" W W,?(IOM-$L(M1)-1),M1 S W="",$P(W,"-",IOM)="" W !,W S W="" G Q^DIDH
                     13:        W "STORED IN ",DIC I $O(@(DIC_"0)"))'>0 W "  *** NO DATA STORED YET ***"
                     14:        E  S I=$P(^(0),U,4) W:I "  ("_I_" ENTR"_$S(I=1:"Y)",1:"IES)")
                     15:        W "   ",W,?(IOM-$L(M1)-1),M1 G G:DHIT["DIDG"
                     16:        W !!,"DATA",?14,"NAME",?36,"GLOBAL",?50,"DATA",!,"ELEMENT",?14,"TITLE",?36,"LOCATION",?50,"TYPE"
                     17: G      W ! F I=1:1:IOM-1 W "-"
                     18:        S W="" Q:DC>1
                     19:        S DG=Z,DIWF="W|",DIWL=1,DIWR=IOM D
                     20:        .N A,D,X S A=$P($G(^DIC(DA,"%D",0)),U,3) F D=0:0 S D=$O(^DIC(DA,"%D",D)) Q:D'>0  Q:+A&(D>A)  S X=^(D,0) D ^DIWP I $D(DN),'DN S M=U Q
                     21:        D ^DIWW S Z=DG Q:'DN  I DHIT["DIDG" D XR^DIDH Q
                     22:        Q:DHIT["DIDX"!(M=U)  W !
                     23:        F %=1:1:4 S X=$P("SCR^DIC^ACT^DIK",U,%) I $D(^DD(DA,0,X)),^(X)]"" W !,$P("FILE SCREEN (SCR-node) ^SPECIAL LOOKUP ROUTINE ^POST-SELECTION ACTION  ^COMPILED CROSS-REFERENCE ROUTINE",U,%)_": " S W=^(X) D W^DIDH G Q:M=U
                     24:        W:$P($G(^DD(DA,0,"DI")),U)["Y" !,"THIS IS AN ARCHIVE FILE."
                     25:        W:$P($G(^DD(DA,0,"DI")),U,2)["Y" !,"EDITING OF FILE IS NOT ALLOWED."
                     26:        F N="DD","RD","WR","DEL","LAYGO","AUDIT" I $D(^DIC(DA,0,N)) W !?(Z+Z+14-$L(N)),N," ACCESS: ",^(N)
                     27:        W ! I $O(^DD(DA,0,"ID",""))]"" W !,"IDENTIFIED BY: "
                     28:        S X=0 F  S X=$O(^DD(DA,0,"ID",X)) Q:X=""  Q:'$D(^DD(DA,X,0))  S I1=$P(^(0),U)_" (#"_X_")" W:($L(I1)+$X)+1>IOM ! W ?15,I1 I $O(^DD(DA,0,"ID",X)) W ","
                     29:        S:X="" X=-1 D POINT^DIDH Q:M=U  D TRIG^DIDH,XR^DIDH Q:M=U  W !
                     30:        I $D(^DIC(DA,"%A")) S N=^("%A"),Y=$P(N,U,2) I Y X ^DD("DD") W !!?3,"CREATED ON: "_Y I $S($D(^DIC(200,0)):1,1:$D(^DIC(3,0))),^(0)["NEW PERSON"!(^(0)["USER")!(^(0)["EMPLOY"),$D(^(+N,0)) W " by "_$P(^(0),U)
                     31: Q      Q
                     32: W      W:$X+$L(W)+3>IOM !,?$S(IOM-$L(W)-5<M:IOM-5-$L(W),1:M),S S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1),S Q:%Y=""  S W=%Y G W
                     33:        Q
                     34: WR     ;
                     35:        S W="TRIGGERED by the "_$P(^(0),U,1)_" field"
                     36: UP1    S W=W_" of the "_$O(^DD(%,0,"NM",0))
                     37:        I $D(^DD(%,0,"UP")) S %=^("UP") S W=W_" sub-field" G UP1
                     38:        S W=W_" File"
                     39: W1     S DDV1="" W ?DDL2 F K=1:1 S DDV=$P(W," ",K)_" ",DDV1=DDV1_DDV W:$L(DDV)+$X>IOM !?DDL2 W DDV Q:$L(DDV1)>$L(W)
                     40:        I $Y+6>IOSL S DC=DC+1 D DIDH1
                     41:        K DDV,DDV1 Q
                     42: DE     ;
                     43:        N X K ^UTILITY($J,"W") S DIWF="W",DIWL=DDL2+1,DIWR=IOM,DIGG=Z
                     44:        W !?DDL1,$P("DESCRIPTION:^TECHNICAL DESCR:",U,%Y=23+1) D
                     45:        .N A1,D S A1=$P($G(^DD(F(DIGG),DJ(DIGG),%Y,0)),U,3) F D=0:0 S D=$O(^DD(F(DIGG),DJ(DIGG),%Y,D)) Q:D'>0  Q:+A1&(D>A1)  S X=^(D,0) D ^DIWP I $D(DN),'DN S M=U Q
                     46:        D ^DIWW I $D(DN),'DN S M=U K DIOEND
                     47:        S Z=DIGG K DIGG,DIWF,DIWL,DIWR
                     48:        Q