Return to DIT1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIT1.m, revision 1.1

1.1     ! snw         1: DIT1   ;SFISC/GFT,TKW-TRANSFER DD'S ;10/9/90  11:59 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        K A W !! S A=+Y,E=A
        !             5: CHK    F V=0:0 S V=$O(^DD(A,"SB",V)) Q:'V  S A(V)=0,L(V)=DLAYGO_$P(V,E,2,9)
        !             6:        S A=$O(A(0)),B=A#1+DHIT I A'="" K A(A) G P:$P(DHIT,".",1)+1'>B,CHK:'$D(^DD(B)),P:DHIT["." S X=$P(^(B,0),U,1) S:$D(^DIC(B,0)) X=$P(^(0),U,1)_" FILE" W $P(^DD(A,0),U,1)_" WOULD COLLIDE WITH "_X,$C(7),! K L,A Q
        !             7:        S A=$O(L(0)) I A S %X="^DIC("_A_",""%D"",",%Y="^DIC("_L(A)_",""%D""," D %XY^%RCR
        !             8:        D WAIT^DICD F A="^DIE(","^DIPT(","^DIBT(" F V=0:0 S V=$O(@(A_"V)")) Q:'V  I $D(^(V,0)),$P(^(0),U,4)-Y=0 S ^UTILITY("DITR",$J,A,V)=$P(^(0),U,1)
        !             9:        S A="F B=0:0 Q:F=DTO!'$F(W,DTO)  S W=$P(W,DTO)_F_$P(W,DTO,2,9)"
        !            10:        G GO:$O(^UTILITY("DITR",$J,-1))="" W !,"DO YOU WANT TO COPY '",$P(Y,U,2),"'S TEMPLATES INTO YOUR NEW FILE" D YN^DICN W !
        !            11:        I %=1 S E="I DIK=""^DIBT("",%Z=1,$D(L(+W)) S $P(W,U,1)=L(+W)" F DIK="^DIE(","^DIPT(","^DIBT(" S V=$P(@(DIK_"0)"),U,3),%X=DIK_"Z,",%Y=DIK_"V," D ^DIT2,IXALL^DIK
        !            12: GO     S Y=DLAYGO K ^UTILITY("DITR",$J),^DD(Y,"B"),^(.01),^("IX"),^("RQ"),^(0,"IX"),E
        !            13:        S @("V=$P("_DTO_"0),U,2)"),@("^(0)=$P("_DTO(0)_"0),U,1,2)_$P(V,DDF(1),2)_U_U")
        !            14: DD     W ! S L=$O(L(L)),Y=L#1+DHIT Q:L=""  S B=0,V=$O(^DD(L,0,"NM",0)),^DD(Y,0)=^DD(L,0) I V]"",$O(^(0,"NM",0))="" S ^(V)=""
        !            15:        S V=-1 I $D(^DD(L,0,"UP")) S ^DD(Y,0,"UP")=^("UP")#1+DHIT
        !            16: ID     S V=$O(^DD(L,0,"ID",V)) I V]"",$D(^(V))#2 S W=^(V) X A S ^DD(Y,0,"ID",V)=W G ID
        !            17:        F V=0:0 S V=$O(^DD(L,V)) Q:'V  I $D(^(V,0)) W "." S W=^(0),D=$P(W,U,2),%Z=0,%A="" S:D L(+D)=D#1+DHIT,W=$P(W,U,1)_U_L(+D)_$P(D,+D,2,9)_U_$P(W,U,3,99) X A D Y S ^DD(Y,V,0)=W,%B=0 D N
        !            18:        S DA(1)=Y,DIK="^DD("_Y_"," D IXALL^DIK K %A,%B,%C,%Z G DD
        !            19:        ;
        !            20: P      W $C(7),"FILE #"_+Y_" SHOULD ONLY BE TRANSFERRED TO A FILE WHOSE NUMBER",!?8,"ALSO "_$S(Y#1:"ENDS WITH '"_(Y#1)_"'",1:"IS INTEGER") K L,A Q
        !            21:        ;
        !            22: N      S %B=$O(@("^DD(L,V,"_%A_"%B)")) G:%B=5 N I %B="" Q:'%Z  S @("%B="_$P(%A,",",%Z)),%Z=%Z-1,%A=$P(%A,",",1,%Z)_$E(",",%Z>0) G N
        !            23:        I @("$D(^DD(L,V,"_%A_"%B))#2") S W=^(%B) D D S @("^DD(Y,V,"_%A_"%B)=W")
        !            24:        I @("$D(^DD(L,V,"_%A_"%B))<9") G N
        !            25:        S:+%B'=%B %B=""""_%B_"""" S %A=%A_%B_",",%Z=%Z+1,%B=-1 G N
        !            26:        ;
        !            27: D      X A
        !            28: Y      F DTL=0:0 S DTL=$O(L(DTL)) Q:'DTL  F %=2:1 S B=$P(W,DTL,%,999) Q:B=""  S:'B W=$P(W,DTL,1,%-1)_(DTL#1+DHIT)_B,%=%-1