Return to DIFROMS2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DIFROMS2.m, revision 1.1

1.1     ! snw         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