Return to DIFROMSB.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFROMSB.m, revision 1.1

1.1     ! snw         1: DIFROMSB       ;SCISC/DCL-SILENT DIFROM/INSTALL BLOCKS;08:35 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:        Q
        !             5: BLKSIN(DIFRNAME,DIFRFLG,DIFRSA,DIFRMSGR)       ;
        !             6:        ;PACKAGE_NAME,FLAGS,SOURCE_ROOT,MSG_ROOT
        !             7:        ;*
        !             8:        ;PACKAGE_NAME=Package Name
        !             9:        ;    (Required if Source Root is not passed) - Identifies the
        !            10:        ;                 unique key subscript in the transport structure.
        !            11:        ;*
        !            12:        ;FLAGS=O
        !            13:        ;    (Optional) - "O"=use Old calls (DIC)
        !            14:        ;*
        !            15:        ;SOURCE_ROOT=Source Array Root
        !            16:        ;    (Optional) - Closed array reference which contain all the
        !            17:        ;                 Blocks that are to be installed.
        !            18:        ;    (Note) - Required if Package_Name is not passed.
        !            19:        ;*
        !            20:        ;MSG_ROOT=Closed Root for Error Messages
        !            21:        ;    (Optional) - Array where messages such as errors will be
        !            22:        ;                 returned.  If not passed, decendents of the ^TMP
        !            23:        ;                 will be used.
        !            24:        ;*
        !            25:        I $G(DIFRNAME)=""&($G(DIFRSA))="" D ERR("PACKAGE NAME/SOUCE ROOT") Q
        !            26:        N DIFRFILE,DIFRDA,DIFROLD,DIFRX,DIFRY,DIC,DA,DLAYGO,X,Y
        !            27:        S DIFRFILE=.404,DIFRDA=0
        !            28:        I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))
        !            29:        S DIFROLD=$G(DIFRFLG)["O"
        !            30:        I DIFROLD S DLAYGO=DIFRFILE,DIC="^DIST(.404,",DIC(0)="LX" D  Q
        !            31:        .F  S DIFRDA=$O(@DIFRSA@(.404,DIFRDA)) Q:DIFRDA'>0  S DIFRX=^(DIFRDA,0) D
        !            32:        ..S X=$P(DIFRX,"^"),DIFRFL=$P(DIFRX,"^",2)
        !            33:        ..K DA
        !            34:        ..D ^DIC
        !            35:        ..I Y>0 S DIFRY=Y D DELADD Q
        !            36:        ..N DIFRERR S DIFRERR(1)=$P(DIFRX,"^")
        !            37:        ..D BLD^DIALOG(9517,.DIFRERR)
        !            38:        ..Q
        !            39:        ; CODE FOR NEW CALLS                                           <<<***
        !            40:        G EXIT
        !            41:        Q
        !            42: DELADD ;
        !            43:        K ^DIST(.404,+DIFRY),DA,DIK
        !            44:        M ^DIST(.404,+DIFRY)=@DIFRSA@(.404,DIFRDA)
        !            45:        S DIK="^DIST(.404,",DA=+DIFRY
        !            46:        D IX1^DIK
        !            47:        I '$D(DD(+DIFRFL)) D
        !            48:        .N DIFRERR S DIFRERR(1)=$P(DIFRX,"^"),DIFRERR(2)=DIFRFL
        !            49:        .D BLD^DIALOG(9518,.DIFRERR)
        !            50:        .Q
        !            51:        Q
        !            52:        ;
        !            53: ERR(X) S X(1)=X D BLD^DIALOG(202,.X)
        !            54:        Q
        !            55: EXIT   I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
        !            56:        Q