File:  [Coherent Logic Development] / freem_fileman / USER / DIFROMSB.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>