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