DIFROMSO.m

DIFROMSO ;SCISC/DCL-DIFROM SERVER EDE OUT ;01:18 PM  8 Feb 1995

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

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

 Q

 ;

 ; * EXTENDED DATABASE ELEMENTS (EDE) OUT *

EDEOUT(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRFIA,DIFRTA,DIFRLST,DIFRMSGR) ;

 ;FILE,IEN,FLAGS,PKGNAME,FIA_ARRAY,TARGET_ARRAY,RECORD_LIST,MSG_ROOT

 ;FILE=FILE NUMBER can only be:.5,.4,.401,.402,.403

 ;                            (.404 automatically comes with .403)

 ;     (Required) -

 ;                  Forms           .403   ^DIST(.403,   "DIST(.403,"

 ;                  Blocks          .404   ^DIST(.404,   "DIST(.404,"

 ;                  Input Template  .402   ^DIE(         "DIE"

 ;                  Print Template  .4     ^DIPT(        "DIPT"

 ;                  Sort Template   .401   ^DIBT(        "DIBT"

 ;                  Functions       .5     ^DD("FUNC",   "FUN"

 ;                  Dialog          .84    ^DI(.84,      ????

 ;

 ;                  Note: Blocks pointed to by Forms

 ;                        are automatically sent

 ;*

 ;IEN=INTERNAL ENTRY NUMBER - DA

 ;    (Required if LIST_ARRAY is not passed) - Identifies

 ;                 the internal entry number for the

 ;                 EDE being exported.

 ;*

 ;FLAGS="S" Strip Security Codes in Transport Structure (Do not send security codes for Forms and Templates)

 ;*

 ;PKGNAME=Package Name

 ;    (Required) - Identifies the unique key subscript

 ;                 in the export target array.

 ;*

 ;FIA_ARRAY="FIA"_ARRAY_INPUT_ARRAY_ROOT  * *NO LONGER USED* *

 ;    (Optional) - Close Input Array Reference

 ;    See DIFROM SERVER documentation for FIA array structure

 ;    definitions.  If undefined Target Array Root will be used

 ;    to append the "FIA" subscript  Default will be

 ;    ^XTMP("XPDT",DIFRNAME,"FIA")

 ;*

 ;TARGET_ARRAY=CLOSED_OUTPUT_ARRAY_ROOT

 ;    (Optional) - Closed Output Array Reference where the data will

 ;    be retuned to be temporarily stored for distribution.

 ;    ^XTMP("XPDT",DIFRNAME,"KRN") will be default.

 ;*

 ;LIST_ARRAY=LIST OF IENs PASSED BY VALUE

 ;    (Required if ENTRY not passed) - Closed Array

 ;    Reference where records for this type of template

 ;    exist.  Nodes can contain ,0).  If +value is greater

 ;    than 0 it is used, otherwise the subscript is

 ;    used as the IEN.

 ;*

 ;MSG_ROOT=CLOSED ARRAY REFERENCE

 ;    (Optional) - Closed array reference where messages such as

 ;    errors will be returned.  If not passed, decendents of ^TMP

 ;    will be used.

 ;*

 I '$D(DIQUIET) N DIQUIET S DIQUIET=1

 I '$D(DIFM) N DIFM S DIFM=1

 I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW

 I $G(DIFRNAME)']"" D BLD^DIALOG(9530) Q

 D

 .N X

 .S X=DIFRFILE

 .I X=.5!(X=.4)!(X=.401)!(X=.402)!(X=.403)!(X=.84) Q

 .S DIFRFILE=0

 .Q

 I DIFRFILE'>0 D BLD^DIALOG(9531) Q

 I $G(DIFRTA)="" S DIFRTA=$NA(^XTMP("XPDT",DIFRNAME,"KRN"))

 ;*

 ;        * *DIFRFIA NO LONGER USED* *

 ;S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(^XTMP("XPDT",DIFRNAME,"FIA"))

 ;I '$D(@DIFRFIA) D BLD^DIALOG(9501) Q

 ;*

 I $G(DIFRIEN)'>0&($G(DIFRLST)="") D BLD^DIALOG(9531) Q

 I $G(DIFRIEN)'>0,$D(@DIFRLST)'>9 D BLD^DIALOG(9532) Q

 S DIFRFLG=$G(DIFRFLG)

 N DIFRFNAM

 S DIFRFNAM=$P($P(".4;PRINT TEMPLATE^.401;SORT TEMPLATE^.402;INPUT TEMPLATE^.403;FORM^.404;BLOCK^.5;FUNCTION^.84;DIALOG",DIFRFILE_";",2),"^")

 D EDEOUT^DIFROMS5

 G EXIT

 ;

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

 Q

DIFROMSO  ;SCISC/DCL-DIFROM SERVER EDE OUT ;01:18 PM  8 Feb 1995

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

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

 +3        QUIT 

 +4       ;

 +5       ; * EXTENDED DATABASE ELEMENTS (EDE) OUT *

EDEOUT(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRFIA,DIFRTA,DIFRLST,DIFRMSGR) ;

 +1       ;FILE,IEN,FLAGS,PKGNAME,FIA_ARRAY,TARGET_ARRAY,RECORD_LIST,MSG_ROOT

 +2       ;FILE=FILE NUMBER can only be:.5,.4,.401,.402,.403

 +3       ;                            (.404 automatically comes with .403)

 +4       ;     (Required) -

 +5       ;                  Forms           .403   ^DIST(.403,   "DIST(.403,"

 +6       ;                  Blocks          .404   ^DIST(.404,   "DIST(.404,"

 +7       ;                  Input Template  .402   ^DIE(         "DIE"

 +8       ;                  Print Template  .4     ^DIPT(        "DIPT"

 +9       ;                  Sort Template   .401   ^DIBT(        "DIBT"

 +10      ;                  Functions       .5     ^DD("FUNC",   "FUN"

 +11      ;                  Dialog          .84    ^DI(.84,      ????

 +12      ;

 +13      ;                  Note: Blocks pointed to by Forms

 +14      ;                        are automatically sent

 +15      ;*

 +16      ;IEN=INTERNAL ENTRY NUMBER - DA

 +17      ;    (Required if LIST_ARRAY is not passed) - Identifies

 +18      ;                 the internal entry number for the

 +19      ;                 EDE being exported.

 +20      ;*

 +21      ;FLAGS="S" Strip Security Codes in Transport Structure (Do not send security codes for Forms and Templates)

 +22      ;*

 +23      ;PKGNAME=Package Name

 +24      ;    (Required) - Identifies the unique key subscript

 +25      ;                 in the export target array.

 +26      ;*

 +27      ;FIA_ARRAY="FIA"_ARRAY_INPUT_ARRAY_ROOT  * *NO LONGER USED* *

 +28      ;    (Optional) - Close Input Array Reference

 +29      ;    See DIFROM SERVER documentation for FIA array structure

 +30      ;    definitions.  If undefined Target Array Root will be used

 +31      ;    to append the "FIA" subscript  Default will be

 +32      ;    ^XTMP("XPDT",DIFRNAME,"FIA")

 +33      ;*

 +34      ;TARGET_ARRAY=CLOSED_OUTPUT_ARRAY_ROOT

 +35      ;    (Optional) - Closed Output Array Reference where the data will

 +36      ;    be retuned to be temporarily stored for distribution.

 +37      ;    ^XTMP("XPDT",DIFRNAME,"KRN") will be default.

 +38      ;*

 +39      ;LIST_ARRAY=LIST OF IENs PASSED BY VALUE

 +40      ;    (Required if ENTRY not passed) - Closed Array

 +41      ;    Reference where records for this type of template

 +42      ;    exist.  Nodes can contain ,0).  If +value is greater

 +43      ;    than 0 it is used, otherwise the subscript is

 +44      ;    used as the IEN.

 +45      ;*

 +46      ;MSG_ROOT=CLOSED ARRAY REFERENCE

 +47      ;    (Optional) - Closed array reference where messages such as

 +48      ;    errors will be returned.  If not passed, decendents of ^TMP

 +49      ;    will be used.

 +50      ;*

 +51       IF '$DATA(DIQUIET)

               NEW DIQUIET

               SET DIQUIET=1

 +52       IF '$DATA(DIFM)

               NEW DIFM

               SET DIFM=1

 +53       IF $GET(U)'="^"!($GET(DT)'>0)!($GET(DTIME)'>0)!('$DATA(DUZ))

               DO DT^DICRW

 +54       IF $GET(DIFRNAME)']""

               DO BLD^DIALOG(9530)

               QUIT 

 +55       Begin DoDot:1

 +56           NEW X

 +57           SET X=DIFRFILE

 +58           IF X=.5!(X=.4)!(X=.401)!(X=.402)!(X=.403)!(X=.84)

                   QUIT 

 +59           SET DIFRFILE=0

 +60           QUIT 

           End DoDot:1

 +61       IF DIFRFILE'>0

               DO BLD^DIALOG(9531)

               QUIT 

 +62       IF $GET(DIFRTA)=""

               SET DIFRTA=$NAME(^XTMP("XPDT",DIFRNAME,"KRN"))

 +63      ;*

 +64      ;        * *DIFRFIA NO LONGER USED* *

 +65      ;S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(^XTMP("XPDT",DIFRNAME,"FIA"))

 +66      ;I '$D(@DIFRFIA) D BLD^DIALOG(9501) Q

 +67      ;*

 +68       IF $GET(DIFRIEN)'>0&($GET(DIFRLST)="")

               DO BLD^DIALOG(9531)

               QUIT 

 +69       IF $GET(DIFRIEN)'>0

               IF $DATA(@DIFRLST)'>9

                   DO BLD^DIALOG(9532)

                   QUIT 

 +70       SET DIFRFLG=$GET(DIFRFLG)

 +71       NEW DIFRFNAM

 +72       SET DIFRFNAM=$PIECE($PIECE(".4;PRINT TEMPLATE^.401;SORT TEMPLATE^.402;INPUT TEMPLATE^.403;FORM^.404;BLOCK^.5;FUNCTION^.84;DIALOG",DIFRFILE_";",2),"^")

 +73       DO EDEOUT^DIFROMS5

 +74       GOTO EXIT

 +75      ;

EXIT       IF $GET(DIFRMSGR)]""

               DO CALLOUT^DIEFU(DIFRMSGR)

 +1        QUIT