source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFROM0.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1DIFROM0 ;SFISC/XAK-GATHER PCS TO SEND ;2:59 PM 25 Sep 1998
2 ;;22.0;VA FileMan;;Mar 30, 1999
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,8994 I $D(^DIC(DL,0)) S X=$P(^(0),U),DIR("A")="Would you like to include "_X_"S?"_$J("",17-$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
10S 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)
12M ;
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
15GO W ! D WAIT^DICD
16 D:DPK>0 PKG^DIFROM12
17 D I DTL="DI" S DTL="DD" D S DTL="DM" D S DTL="DI"
18 .F Y=19,3.6,19.1,.5,9.8,9.2,8994 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",Y=8994:"REM") D ADD,A:'Y
19 D SBF
20 K DL,DIR S DL=DRN,DRN=1 G ^DIFROM1
21ADD ;
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
26A 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)
34H 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
39HP1 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 ;
44DH S DH=$O(@(Y_"""B"",DH)")) G A:DH]""&(DTL="XU"!($P(DH,DTL,1)="")) Q
45 ;
46ERM W $C(7),!!?5,"Was not able to get a message number for the network INIT",!?10,"DIFROM ABORTED!!",! Q
47 ;
48Q G Q^DIFROM11
49SBF 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
Note: See TracBrowser for help on using the repository browser.