DIFROMSB.m

DIFROMSB ;SCISC/DCL-SILENT DIFROM/INSTALL BLOCKS ;08:35 AM  22 Nov 1994

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

BLKSIN(DIFRNAME,DIFRFLG,DIFRSA,DIFRMSGR) ;

 ;PACKAGE_NAME,FLAGS,SOURCE_ROOT,MSG_ROOT

 ;*

 ;PACKAGE_NAME=Package Name

 ;    (Required if Source Root is not passed) - Identifies the

 ;                 unique key subscript in the transport structure.

 ;*

 ;FLAGS=O

 ;    (Optional) - "O"=use Old calls (DIC)

 ;*

 ;SOURCE_ROOT=Source Array Root

 ;    (Optional) - Closed array reference which contain all the

 ;                 Blocks that are to be installed.

 ;    (Note) - Required if Package_Name is not passed.

 ;*

 ;MSG_ROOT=Closed Root for Error Messages

 ;    (Optional) - Array where messages such as errors will be

 ;                 returned.  If not passed, decendents of the ^TMP

 ;                 will be used.

 ;*

 I $G(DIFRNAME)=""&($G(DIFRSA))="" D ERR("PACKAGE NAME/SOUCE ROOT") Q

 N DIFRFILE,DIFRDA,DIFROLD,DIFRX,DIFRY,DIC,DA,DLAYGO,X,Y

 S DIFRFILE=.404,DIFRDA=0

 I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))

 S DIFROLD=$G(DIFRFLG)["O"

 I DIFROLD S DLAYGO=DIFRFILE,DIC="^DIST(.404,",DIC(0)="LX" D  Q

 .F  S DIFRDA=$O(@DIFRSA@(.404,DIFRDA)) Q:DIFRDA'>0  S DIFRX=^(DIFRDA,0) D

 ..S X=$P(DIFRX,"^"),DIFRFL=$P(DIFRX,"^",2)

 ..K DA

 ..D ^DIC

 ..I Y>0 S DIFRY=Y D DELADD Q

 ..N DIFRERR S DIFRERR(1)=$P(DIFRX,"^")

 ..D BLD^DIALOG(9517,.DIFRERR)

 ..Q

 ; CODE FOR NEW CALLS                                           <<<***

 G EXIT

 Q

DELADD ;

 K ^DIST(.404,+DIFRY),DA,DIK

 M ^DIST(.404,+DIFRY)=@DIFRSA@(.404,DIFRDA)

 S DIK="^DIST(.404,",DA=+DIFRY

 D IX1^DIK

 I '$D(DD(+DIFRFL)) D

 .N DIFRERR S DIFRERR(1)=$P(DIFRX,"^"),DIFRERR(2)=DIFRFL

 .D BLD^DIALOG(9518,.DIFRERR)

 .Q

 Q

 ;

ERR(X) S X(1)=X D BLD^DIALOG(202,.X)

 Q

EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)

 Q

DIFROMSB  ;SCISC/DCL-SILENT DIFROM/INSTALL BLOCKS ;08:35 AM  22 Nov 1994

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

BLKSIN(DIFRNAME,DIFRFLG,DIFRSA,DIFRMSGR) ;

 +1       ;PACKAGE_NAME,FLAGS,SOURCE_ROOT,MSG_ROOT

 +2       ;*

 +3       ;PACKAGE_NAME=Package Name

 +4       ;    (Required if Source Root is not passed) - Identifies the

 +5       ;                 unique key subscript in the transport structure.

 +6       ;*

 +7       ;FLAGS=O

 +8       ;    (Optional) - "O"=use Old calls (DIC)

 +9       ;*

 +10      ;SOURCE_ROOT=Source Array Root

 +11      ;    (Optional) - Closed array reference which contain all the

 +12      ;                 Blocks that are to be installed.

 +13      ;    (Note) - Required if Package_Name is not passed.

 +14      ;*

 +15      ;MSG_ROOT=Closed Root for Error Messages

 +16      ;    (Optional) - Array where messages such as errors will be

 +17      ;                 returned.  If not passed, decendents of the ^TMP

 +18      ;                 will be used.

 +19      ;*

 +20       IF $GET(DIFRNAME)=""&($GET(DIFRSA))=""

               DO ERR("PACKAGE NAME/SOUCE ROOT")

               QUIT 

 +21       NEW DIFRFILE,DIFRDA,DIFROLD,DIFRX,DIFRY,DIC,DA,DLAYGO,X,Y

 +22       SET DIFRFILE=.404

           SET DIFRDA=0

 +23       IF $GET(DIFRSA)=""

               SET DIFRSA=$NAME(^XTMP("XPDI",DIFRNAME,"KRN"))

 +24       SET DIFROLD=$GET(DIFRFLG)["O"

 +25       IF DIFROLD

               SET DLAYGO=DIFRFILE

               SET DIC="^DIST(.404,"

               SET DIC(0)="LX"

               Begin DoDot:1

 +26               FOR 

                       SET DIFRDA=$ORDER(@DIFRSA@(.404,DIFRDA))

                       IF DIFRDA'>0

                           QUIT 

                       SET DIFRX=^(DIFRDA,0)

                       Begin DoDot:2

 +27                       SET X=$PIECE(DIFRX,"^")

                           SET DIFRFL=$PIECE(DIFRX,"^",2)

 +28                       KILL DA

 +29                       DO ^DIC

 +30                       IF Y>0

                               SET DIFRY=Y

                               DO DELADD

                               QUIT 

 +31                       NEW DIFRERR

                           SET DIFRERR(1)=$PIECE(DIFRX,"^")

 +32                       DO BLD^DIALOG(9517,.DIFRERR)

 +33                       QUIT 

                       End DoDot:2

               End DoDot:1

               QUIT 

 +34      ; CODE FOR NEW CALLS                                           <<<***

 +35       GOTO EXIT

 +36       QUIT 

DELADD    ;

 +1        KILL ^DIST(.404,+DIFRY),DA,DIK

 +2        MERGE ^DIST(.404,+DIFRY)=@DIFRSA@(.404,DIFRDA)

 +3        SET DIK="^DIST(.404,"

           SET DA=+DIFRY

 +4        DO IX1^DIK

 +5        IF '$DATA(DD(+DIFRFL))

               Begin DoDot:1

 +6                NEW DIFRERR

                   SET DIFRERR(1)=$PIECE(DIFRX,"^")

                   SET DIFRERR(2)=DIFRFL

 +7                DO BLD^DIALOG(9518,.DIFRERR)

 +8                QUIT 

               End DoDot:1

 +9        QUIT 

 +10      ;

ERR(X)     SET X(1)=X

           DO BLD^DIALOG(202,.X)

 +1        QUIT 

EXIT       IF $GET(DIFRMSGR)]""

               DO CALLOUT^DIEFU(DIFRMSGR)

 +1        QUIT