Return to DIFROMSB.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFROMSB.m, revision 1.1.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