Return to DIFROMS2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIFROMS2	;SFISC/DCL-INSTALL DD FROM SOURCE ARRAY;08:34 AM  22 Nov 1994;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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: 	;delete DD wp text for file, field and x-ref description and field tech description
   24: 	I 'DIFRFDD D
   25: 	.K @DIFRSA@("DIFRNI",DIFRFILE)
   26: 	.N DIFRD
   27: 	.S DIFRD=DIFRFILE
   28: 	.F  S DIFRD=$O(@DIFRFIA@(DIFRFILE,DIFRD)) Q:DIFRD'>0  D
   29: 	..Q:$$UP(DIFRSA,DIFRFILE,DIFRD)
   30: 	..S @DIFRSA@("DIFRNI",DIFRFILE,DIFRD)=""
   31: 	..Q
   32: 	.Q
   33: 	K:DIFRFDD ^DIC(DIFRFILE,"%D")
   34: 	S DIFRD=0
   35: 	F  S DIFRD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD)) Q:DIFRD'>0  D
   36: 	.I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
   37: 	.S DIFRFLD=0
   38: 	.F  S DIFRFLD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD,DIFRFLD)) Q:DIFRFLD'>0  D
   39: 	..K ^DD(DIFRD,DIFRFLD,21),^(23)
   40: 	..S DIFRX=0
   41: 	..F  S DIFRX=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD,DIFRFLD,1,DIFRX)) Q:DIFRX'>0  D
   42: 	...K ^DD(DIFRD,DIFRFLD,1,DIFRX,"%D")
   43: 	...Q
   44: 	..Q
   45: 	.Q
   46: 	I DIFRFDD F DIFRX="^DIC","^DD" D
   47: 	.;I DIFRX="^DIC",'DIFRFDD Q
   48: 	.N X
   49: 	.I DIFRX="^DIC",$G(^DIC(DIFRFILE,0))]"" S X=$P(^(0),"^",3,9)
   50: 	.M @DIFRX=@DIFRSA@(DIFRX,DIFRFILE)
   51: 	.I DIFRX="^DIC",$G(X)]"" S $P(^DIC(DIFRFILE,0),"^",3,9)=X
   52: 	.I DSEC,$D(@DIFRSA@("SEC",DIFRX,DIFRFILE)) M @DIFRX=@DIFRSA@("SEC",DIFRX,DIFRFILE)
   53: 	.Q
   54: 	I 'DIFRFDD D
   55: 	.N DIFRD
   56: 	.S DIFRD=0
   57: 	.F  S DIFRD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD)) Q:DIFRD'>0  D
   58: 	..I $D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
   59: 	..M ^DD(DIFRD)=@DIFRSA@("^DD",DIFRFILE,DIFRD)
   60: 	..I DSEC,$D(@DIFRSA@("SEC","^DD",DIFRFILE,DIFRD)) M ^DD(DIFRD)=@DIFRSA@("SEC","^DD",DIFRFILE,DIFRD)
   61: 	..Q
   62: 	.Q
   63: 	S DIFRD=0 F  S DIFRD=$O(@DIFRFIA@(DIFRFILE,DIFRD)) Q:DIFRD'>0  D
   64: 	.I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
   65: 	.S D=DIFRD,DIK="A" F  S DIK=$O(^DD(D,DIK)) Q:DIK=""  K ^(DIK)
   66: 	.S DA(1)=D,DIK="^DD("_D_"," D IXALL^DIK
   67: 	.I $D(^DIC(D,"%",0)) S DIK="^DIC(D,""%""," D IXALL^DIK
   68: 	.Q
   69: 	I 'DIFRFDD D  G DIKZ
   70: 	.Q:'$D(@DIFRSA@("^DD",DIFRFILE,DIFRFILE,.01))
   71: 	.S $P(@(^DIC(DIFRFILE,0,"GL")_"0)"),"^",2)=$$HDR2P^DIFROMSS(DIFRFILE)
   72: 	.Q
   73: 	S DIFRGL=^DIC(DIFRFILE,0,"GL"),DIFRDIC=$P(^DIC(DIFRFILE,0),U,1,2)
   74: 	S $P(DIFRDIC,"^",2)=@DIFRFIA@(DIFRFILE,0,0)
   75: 	I DIFRFDD,+$G(@DIFRFIA@(DIFRFILE,0,"VR")) S DIFRVR=^("VR") D
   76: 	.S ^DD(DIFRFILE,0,"VR")=$P(DIFRVR,"^")
   77: 	.S ^DD(DIFRFILE,0,"VRPK")=$P(DIFRVR,"^",2)
   78: 	.Q
   79: 	S DIFRDATA=$D(@(DIFRGL_"0)")),^(0)=DIFRDIC_"^"_$S(DIFRDATA#2:$P(^(0),"^",3,9),1:"^")
   80: DIKZ	I $D(^DD(DIFRFILE,0,"DIK")) D
   81: 	.N %X,DIKJ,DIR,DMAX,X,Y,DIFRDIKA
   82: 	.D EN2^DIKZ(DIFRFILE,"",^DD(DIFRFILE,0,"DIK"),^DD("ROU"),"DIFRDIKA")
   83: 	.I $D(DIFRDIKA) M @DIFRSA@("DIKZ",DIFRFILE)=DIFRDIKA
   84: 	.S @DIFRSA@("DIKZ",DIFRFILE)=^DD(DIFRFILE,0,"DIK")
   85: 	.Q
   86: 	I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE)) D
   87: 	.N DIFRD
   88: 	.S DIFRD=0
   89: 	.F  S DIFRD=$O(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q:DIFRD'>0  D
   90: 	..N DIFRERR S DIFRERR(1)=DIFRD
   91: 	..D BLD^DIALOG(9512,.DIFRERR)
   92: 	..Q
   93: 	.Q
   94: 	Q
   95: 	;
   96: UP(ROOT,FILE,DDN)	;Return 1 or 0 to install
   97: 	Q:FILE=DDN 1
   98: 	Q:$D(^DD(DDN)) 1
   99: 	Q:'$D(@ROOT@("UP",FILE,DDN)) 1
  100: 	N MP,PARENT,T,X
  101: 	S MP=0,X="",T=0
  102: 	F  S X=$O(@ROOT@("UP",FILE,DDN,X)) Q:X=""  S PARENT=+^(X) D  Q:T!(MP)
  103: 	.I $D(^DD(PARENT))!($G(@ROOT@("FIA",FILE,PARENT))=0) S:X=0 T=1 Q
  104: 	.S MP=1
  105: 	.Q
  106: 	Q T
  107: 	;
  108: ERR(X)	D BLD^DIALOG($P($T(ERR+X),";",5)) Q
  109: 	;;FIA Node Is Set To "No DD Update";1;9503
  110: 	;;Already Exist On Target System (INSTALL ONLY IF NEW);2;9504
  111: 	;;Did Not Pass DD Screen;3;9505
  112: 	;;FIA Array Does Not Exist;4;9511
  113: 	;;Distribution Array Does Not Exist;5;9506
  114: 	;;FIA File Number Invalid;6;9507
  115: 	;;Partial DD/File Does Not Already Exist On Target System;7;9508