Return to DIFROM0.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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