Annotation of freem_fileman/USER/DIFROM0.m, revision 1.1

1.1     ! snw         1: DIFROM0        ;SFISC/XAK-GATHER PCS TO SEND ;02:07 PM  28 Nov 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S %=2,DIT=0,DIH=""
        !             5:        I DPK<0,$O(F(0))>0 K DIR S DIR(0)="Y",DIR("A")="Do you want to include all the templates and forms",DIR("B")="NO",DIR("??")="^D NOPKG^DIFROMH" D ^DIR G Q:$D(DIRUT) S DIT=Y=1
        !             6:        W ! S DIR(0)="YA",DIR("??")="^D ^DIFROMH",DIR("B")="YES"
        !             7:        ;NOTE: I removed 9.8 (ROUTINE FILE) from this list for V19 but none of the supporting code. (tkw)
        !             8:        F DL=19,3.6,19.1,.5,9.2 I $D(^DIC(DL,0)) S X=$P(^(0),U),DIR("A")="Would you like to include "_X_"S?"_$E("       ",1,13-$L(X)) D ^DIR G Q:$D(DIRUT) I Y=1 S DL(DL)=DL,DIFC=1
        !             9:        G:$D(F(-1))&('$D(DIFC)) Q
        !            10: S      W ! S DIR("A")="Would you like security codes sent along: ",DIR("B")="NO"
        !            11:        S DIR("??")="^D S^DIFROMH" D ^DIR G Q:$D(DIRUT) S DSEC=Y=1 K ^UTILITY("DI",$J)
        !            12: M      ;
        !            13:        S DIR("A")="Maximum Routine Size    (2000 - 9999) : ",DIR("B")=^DD("ROU"),DIR(0)="NA^2000:9999"
        !            14:        S DIR("??")="^D M^DIFROMH" D ^DIR G Q:$D(DIRUT) S DIFRM=Y
        !            15: GO     W ! D WAIT^DICD
        !            16:        D:DPK>0 PKG^DIFROM12
        !            17:        D  I DTL="DI" S DTL="DD" D  S DTL="DI"
        !            18:        .F Y=19,3.6,19.1,.5,9.8,9.2 I $D(DL(Y)) S X=$S(Y=19:"OPT",Y=3.6:"BUL",Y=19.1:"SE",Y=.5:"FUN",Y=9.8:"ROU",Y=9.2:"HEL") D ADD,A:'Y
        !            19:        D SBF
        !            20:        K DL,DIR S DL=DRN,DRN=1 G ^DIFROM1
        !            21: ADD    ;
        !            22:        S DH=$S(DTL="XU":"DD",1:DTL)
        !            23:        Q:$D(^DIC(Y,0))[0!$D(DTL(Y))  Q:$P(^(0),X,1)]""!'$D(^(0,"GL"))
        !            24:        S Y=^("GL"),X=$S(X="ROU":"RTN",X="SE":"KEY",1:X)
        !            25:        Q
        !            26: A      F D=0:0 S D=$O(^DIC(9.4,DPK,"EX",D)) Q:D'>0  I $P(DH,$P(^(D,0),U))="" G DH
        !            27:        S D=$O(@(Y_"""B"",DH,0)")),%X=Y_"D,",%Y="^UTILITY(U,$J,X,D,"
        !            28:        G DH:D'>0,DH:D<100&(X="FUN") S Q(X)=0
        !            29:        D %XY^%RCR G H:X'="OPT"
        !            30:        S %=^UTILITY(U,$J,X,D,0),%1=+$P(%,U,12),%1=$S($D(^DIC(9.4,%1,0)):$P(^(0),U),1:""),$P(%,U,12)=%1,$P(%,U,5)=""
        !            31:        S %1=+$P(%,U,7),%1=$S($D(^DIC(9.2,%1,0)):$P(^(0),U),1:""),$P(%,U,7)=%1,^UTILITY(U,$J,X,D,0)=% K ^(3.96),^(10,"B"),^("C")
        !            32:        I $D(^UTILITY(U,$J,X,D,220)) S %=^(220),%1=$S($D(^XMB(3.6,+%,0)):$P(^(0),U),1:""),$P(%,U)=%1,%1=$S($D(^XMB(3.8,+$P(%,U,3),0)):$P(^(0),U),1:""),$P(%,U,3)=%1,^UTILITY(U,$J,X,D,220)=%
        !            33:        F %=0:0 S %=$O(^DIC(19,D,10,%)) Q:%'>0  I $D(^(%,0)),$D(^DIC(19,+^(0),0)) S ^UTILITY(U,$J,X,D,10,%,U)=$P(^(0),U)
        !            34: H      K:"BULKEY"[X ^UTILITY(U,$J,X,D,2) G:X'="HEL" DH
        !            35:        K ^UTILITY(U,$J,X,D,4) S $P(^(0),U,4)="" K ^(2,"B"),^UTILITY(U,$J,X,D,10,"B")
        !            36:        F %2=0:0 S %2=$O(^UTILITY(U,$J,X,D,10,%2)) Q:'%2  I $D(^(%2,0))#2 S %1=+^(0),%1=$S($D(^MAG(%1,0)):$P(^(0),U,1),1:"") K:%1="" ^UTILITY(U,$J,X,D,10,%2) I %1]"" S $P(^UTILITY(U,$J,X,D,10,%2,0),U,1)=%1
        !            37:        F %2=0:0 S %2=$O(^UTILITY(U,$J,X,D,2,%2)) G DH:%2'>0 I $D(^(%2,0))#2,$P(^(0),U,2) S %1=^(0),%=1 D HP1 Q:%<0
        !            38:        K %1,%2 Q
        !            39: HP1    I $D(^DIC(9.2,+$P(%1,U,2),0)) S ^UTILITY(U,$J,X,D,2,%2,0)=$P(%1,U)_U_$P(^(0),U) Q
        !            40:        W !,$C(7),"The Help Frame, "_$P(^DIC(9.2,D,0),U)_" has the keyword "_$P(%1,U)
        !            41:        W !,"whose Related Frame does not exist.  Shall I exclude it" D YN^DICN
        !            42:        K:%=1 ^UTILITY(U,$J,X,D,2,%2) Q
        !            43:        ;
        !            44: DH     S DH=$O(@(Y_"""B"",DH)")) G A:DH]""&(DTL="XU"!($P(DH,DTL,1)="")) Q
        !            45:        ;
        !            46: ERM    W $C(7),!!?5,"Was not able to get a message number for the network INIT",!?10,"DIFROM ABORTED!!",! Q
        !            47:        ;
        !            48: Q      G Q^DIFROM11
        !            49: SBF    N I,II
        !            50:        S I=0 F  S I=$O(F(I)) Q:I'>0  S II=0 F  S II=$O(F(I,II)) Q:II'>0  S ^UTILITY("^",$J,"SBF",I,II)=""
        !            51:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>