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

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1DIFROMS2 ;SFISC/DCL/TKW-INSTALL DD FROM SOURCE ARRAY ;9:06 AM 14 Jul 2000
2 ;;22.0;VA FileMan;**11,53**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6EN ;
7 I '$D(@DIFRSA) D ERR(5) Q
8 I '$D(@DIFRFIA) D ERR(4) Q
9 G:$G(DIFRFILE) FCHK
10 S DIFRFILE=0 F S DIFRFILE=$O(@DIFRFIA@(DIFRFILE)) Q:DIFRFILE'>0 D FILE
11 Q
12FCHK I '$D(@DIFRFIA@(DIFRFILE)) D ERR(6) Q
13FILE ;
14 N DIFR01,DIFR02,DIFRVR,DIFRFDD
15 S DIFR01=$G(@DIFRFIA@(DIFRFILE,0,1)),DIFR02=$G(^(2))
16 I $TR($E(DIFR01),"NY","ny")="n" D ERR(1) Q
17 S DIFRFDD=$TR($P(DIFR01,"^",3),"FP","fp")'="p"
18 I 'DIFRFDD,'$D(^DIC(DIFRFILE)) D ERR(7) Q
19 I $D(^DIC(DIFRFILE,0)),$G(@DIFRFIA@(DIFRFILE,0,10))]"" X ^(10) I '$T D ERR(3) Q
20 ;I $TR($E(@DIFRFIA@(DIFRFILE,0,5)),"NY","ny")="y",$D(^DIC(DIFRFILE)) D ERR(2) Q ;INSTALL ONLY IF NEW * * PHASING OUT * *
21 N %1,DSEC,D,DA,DIC,DIK,DIFRD,DIFRDATA,DIFRFLD,DIFRDIC,DIFRGL,DIFRX,I,X,Y,Z
22 S DSEC=$P(DIFR02,"^") ; **>> add file security if new file only <<**
23 I 'DSEC,'$D(^DIC(DIFRFILE,0))#2 S DSEC=1 ; Check to see if the file was Deleted during Pre-Install
24 ;delete DD wp text for file, field and x-ref description and field tech description
25 ;also delete "NM" nodes when installing full DD at specified level
26 I 'DIFRFDD D
27 .K @DIFRSA@("DIFRNI",DIFRFILE)
28 .N DIFRD
29 .S DIFRD=DIFRFILE
30 .F S DIFRD=$O(@DIFRFIA@(DIFRFILE,DIFRD)) Q:DIFRD'>0 D
31 ..Q:$$UP(DIFRSA,DIFRFILE,DIFRD)
32 ..S @DIFRSA@("DIFRNI",DIFRFILE,DIFRD)=""
33 ..N DIFRNGF,DIFRNGFD
34 ..S DIFRNGF=+$G(@DIFRSA@("UP",DIFRFILE,DIFRD,-1))
35 ..S DIFRNGFD=.01 F S DIFRNGFD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRNGF,DIFRNGFD)) Q:DIFRNGFD="" Q:+$P($G(^(DIFRNGFD,0)),U,2)=DIFRD
36 ..I DIFRNGFD'="" K @DIFRSA@("^DD",DIFRFILE,DIFRNGF,DIFRNGFD)
37 ..Q
38 .Q
39 K:DIFRFDD ^DIC(DIFRFILE,"%D")
40 S DIFRD=0
41 F S DIFRD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD)) Q:DIFRD'>0 D
42 .I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
43 .K:$D(@DIFRSA@("^DD",DIFRFILE,DIFRD,0,"NM"))\10 ^DD(DIFRD,0,"NM")
44 .S DIFRFLD=0
45 .F S DIFRFLD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD,DIFRFLD)) Q:DIFRFLD'>0 D
46 ..K ^DD(DIFRD,DIFRFLD,21),^(23)
47 ..S DIFRX=0
48 ..F S DIFRX=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD,DIFRFLD,1,DIFRX)) Q:DIFRX'>0 D
49 ...K ^DD(DIFRD,DIFRFLD,1,DIFRX,"%D")
50 ...Q
51 ..Q
52 .Q
53 I DIFRFDD F DIFRX="^DIC","^DD" D
54 .;I DIFRX="^DIC",'DIFRFDD Q
55 .N X
56 .I DIFRX="^DIC",$G(^DIC(DIFRFILE,0))]"" S X=$P(^(0),"^",3,9)
57 .M @DIFRX=@DIFRSA@(DIFRX,DIFRFILE)
58 .I DIFRX="^DIC",$G(X)]"" S $P(^DIC(DIFRFILE,0),"^",3,9)=X
59 .I DSEC,$D(@DIFRSA@("SEC",DIFRX,DIFRFILE)) M @DIFRX=@DIFRSA@("SEC",DIFRX,DIFRFILE)
60 .Q
61 I 'DIFRFDD D
62 .N DIFRD
63 .S DIFRD=0
64 .F S DIFRD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD)) Q:DIFRD'>0 D
65 ..I $D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
66 ..M ^DD(DIFRD)=@DIFRSA@("^DD",DIFRFILE,DIFRD)
67 ..I DSEC,$D(@DIFRSA@("SEC","^DD",DIFRFILE,DIFRD)) M ^DD(DIFRD)=@DIFRSA@("SEC","^DD",DIFRFILE,DIFRD)
68 ..Q
69 .Q
70 S DIFRD=0 F S DIFRD=$O(@DIFRFIA@(DIFRFILE,DIFRD)) Q:DIFRD'>0 D
71 .I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
72 .S D=DIFRD,DIK="A" F S DIK=$O(^DD(D,DIK)) Q:DIK="" K ^(DIK)
73 .S DA(1)=D,DIK="^DD("_D_"," D IXALL^DIK
74 .I $D(^DIC(D,"%",0)) S DIK="^DIC(D,""%""," D IXALL^DIK
75 .Q
76 I 'DIFRFDD D G IXKEY
77 .Q:'$D(@DIFRSA@("^DD",DIFRFILE,DIFRFILE,.01))
78 .S $P(@(^DIC(DIFRFILE,0,"GL")_"0)"),"^",2)=$$HDR2P^DIFROMSS(DIFRFILE)
79 .Q
80 S DIFRGL=^DIC(DIFRFILE,0,"GL"),DIFRDIC=$P(^DIC(DIFRFILE,0),U,1,2)
81 S $P(DIFRDIC,"^",2)=@DIFRFIA@(DIFRFILE,0,0)
82 I DIFRFDD,+$G(@DIFRFIA@(DIFRFILE,0,"VR")) S DIFRVR=^("VR") D
83 .S ^DD(DIFRFILE,0,"VR")=$P(DIFRVR,"^")
84 .S ^DD(DIFRFILE,0,"VRPK")=$P(DIFRVR,"^",2)
85 .Q
86 S DIFRDATA=$D(@(DIFRGL_"0)")),^(0)=DIFRDIC_"^"_$S(DIFRDATA#2:$P(^(0),"^",3,9),1:"^")
87 ;
88IXKEY ; Bring INDEX and KEY entries
89 K ^TMP("DIFROMS2",$J,"TRIG")
90 S DIFRD=0
91 F S DIFRD=$O(@DIFRSA@("IX",DIFRFILE,DIFRD)) Q:'DIFRD D DDIXIN^DIFROMSX(DIFRFILE,DIFRD,DIFRSA)
92 K ^TMP("DIFROMS2",$J,"TRIG")
93 S DIFRD=0
94 F S DIFRD=$O(@DIFRSA@("KEY",DIFRFILE,DIFRD)) Q:'DIFRD D DDKEYIN^DIFROMSY(DIFRFILE,DIFRD,DIFRSA)
95 ;
96DIKZ I $D(^DD(DIFRFILE,0,"DIK")) D
97 .N %X,DIKJ,DIR,DMAX,X,Y,DIFRDIKA
98 .D EN2^DIKZ(DIFRFILE,"",^DD(DIFRFILE,0,"DIK"),^DD("ROU"),"DIFRDIKA")
99 .I $D(DIFRDIKA) M @DIFRSA@("DIKZ",DIFRFILE)=DIFRDIKA
100 .S @DIFRSA@("DIKZ",DIFRFILE)=^DD(DIFRFILE,0,"DIK")
101 .Q
102 I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE)) D
103 .N DIFRD
104 .S DIFRD=0
105 .F S DIFRD=$O(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q:DIFRD'>0 D
106 ..N DIFRERR S DIFRERR(1)=DIFRD
107 ..D BLD^DIALOG(9512,.DIFRERR)
108 ..Q
109 .Q
110 Q
111 ;
112UP(ROOT,FILE,DDN) ;Return 1 or 0 to install
113 Q:FILE=DDN 1
114 Q:$D(^DD(DDN)) 1
115 Q:'$D(@ROOT@("UP",FILE,DDN)) 1
116 N MP,PARENT,T,X
117 S MP=0,X="",T=0
118 F S X=$O(@ROOT@("UP",FILE,DDN,X)) Q:X="" S PARENT=+^(X) D Q:T!(MP)
119 .I $D(^DD(PARENT))!($G(@ROOT@("FIA",FILE,PARENT))=0) S:X=0 T=1 Q
120 .S MP=1
121 .Q
122 Q T
123 ;
124ERR(X) D BLD^DIALOG($P($T(ERR+X),";",5)) Q
125 ;;FIA Node Is Set To "No DD Update";1;9503
126 ;;Already Exist On Target System (INSTALL ONLY IF NEW);2;9504
127 ;;Did Not Pass DD Screen;3;9505
128 ;;FIA Array Does Not Exist;4;9511
129 ;;Distribution Array Does Not Exist;5;9506
130 ;;FIA File Number Invalid;6;9507
131 ;;Partial DD/File Does Not Already Exist On Target System;7;9508
Note: See TracBrowser for help on using the repository browser.