| [613] | 1 | DIFROMSB ;SCISC/DCL-SILENT DIFROM/INSTALL BLOCKS ;08:35 AM 22 Nov 1994
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
