[613] | 1 | DIFROMS2 ;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
|
---|
| 6 | EN ;
|
---|
| 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
|
---|
| 12 | FCHK I '$D(@DIFRFIA@(DIFRFILE)) D ERR(6) Q
|
---|
| 13 | FILE ;
|
---|
| 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 | ;
|
---|
| 88 | IXKEY ; 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 | ;
|
---|
| 96 | DIKZ 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 | ;
|
---|
| 112 | UP(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 | ;
|
---|
| 124 | ERR(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
|
---|