| 1 | DIFROMSO ;SCISC/DCL-DIFROM SERVER EDE OUT ;01:18 PM  8 Feb 1995
 | 
|---|
| 2 |  ;;22.0;VA FileMan;;Mar 30, 1999
 | 
|---|
| 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  Q
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  ; * EXTENDED DATABASE ELEMENTS (EDE) OUT *
 | 
|---|
| 7 | EDEOUT(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRFIA,DIFRTA,DIFRLST,DIFRMSGR) ;
 | 
|---|
| 8 |  ;FILE,IEN,FLAGS,PKGNAME,FIA_ARRAY,TARGET_ARRAY,RECORD_LIST,MSG_ROOT
 | 
|---|
| 9 |  ;FILE=FILE NUMBER can only be:.5,.4,.401,.402,.403
 | 
|---|
| 10 |  ;                            (.404 automatically comes with .403)
 | 
|---|
| 11 |  ;     (Required) -
 | 
|---|
| 12 |  ;                  Forms           .403   ^DIST(.403,   "DIST(.403,"
 | 
|---|
| 13 |  ;                  Blocks          .404   ^DIST(.404,   "DIST(.404,"
 | 
|---|
| 14 |  ;                  Input Template  .402   ^DIE(         "DIE"
 | 
|---|
| 15 |  ;                  Print Template  .4     ^DIPT(        "DIPT"
 | 
|---|
| 16 |  ;                  Sort Template   .401   ^DIBT(        "DIBT"
 | 
|---|
| 17 |  ;                  Functions       .5     ^DD("FUNC",   "FUN"
 | 
|---|
| 18 |  ;                  Dialog          .84    ^DI(.84,      ????
 | 
|---|
| 19 |  ;
 | 
|---|
| 20 |  ;                  Note: Blocks pointed to by Forms
 | 
|---|
| 21 |  ;                        are automatically sent
 | 
|---|
| 22 |  ;*
 | 
|---|
| 23 |  ;IEN=INTERNAL ENTRY NUMBER - DA
 | 
|---|
| 24 |  ;    (Required if LIST_ARRAY is not passed) - Identifies
 | 
|---|
| 25 |  ;                 the internal entry number for the
 | 
|---|
| 26 |  ;                 EDE being exported.
 | 
|---|
| 27 |  ;*
 | 
|---|
| 28 |  ;FLAGS="S" Strip Security Codes in Transport Structure (Do not send security codes for Forms and Templates)
 | 
|---|
| 29 |  ;*
 | 
|---|
| 30 |  ;PKGNAME=Package Name
 | 
|---|
| 31 |  ;    (Required) - Identifies the unique key subscript
 | 
|---|
| 32 |  ;                 in the export target array.
 | 
|---|
| 33 |  ;*
 | 
|---|
| 34 |  ;FIA_ARRAY="FIA"_ARRAY_INPUT_ARRAY_ROOT  * *NO LONGER USED* *
 | 
|---|
| 35 |  ;    (Optional) - Close Input Array Reference
 | 
|---|
| 36 |  ;    See DIFROM SERVER documentation for FIA array structure
 | 
|---|
| 37 |  ;    definitions.  If undefined Target Array Root will be used
 | 
|---|
| 38 |  ;    to append the "FIA" subscript  Default will be
 | 
|---|
| 39 |  ;    ^XTMP("XPDT",DIFRNAME,"FIA")
 | 
|---|
| 40 |  ;*
 | 
|---|
| 41 |  ;TARGET_ARRAY=CLOSED_OUTPUT_ARRAY_ROOT
 | 
|---|
| 42 |  ;    (Optional) - Closed Output Array Reference where the data will
 | 
|---|
| 43 |  ;    be retuned to be temporarily stored for distribution.
 | 
|---|
| 44 |  ;    ^XTMP("XPDT",DIFRNAME,"KRN") will be default.
 | 
|---|
| 45 |  ;*
 | 
|---|
| 46 |  ;LIST_ARRAY=LIST OF IENs PASSED BY VALUE
 | 
|---|
| 47 |  ;    (Required if ENTRY not passed) - Closed Array
 | 
|---|
| 48 |  ;    Reference where records for this type of template
 | 
|---|
| 49 |  ;    exist.  Nodes can contain ,0).  If +value is greater
 | 
|---|
| 50 |  ;    than 0 it is used, otherwise the subscript is
 | 
|---|
| 51 |  ;    used as the IEN.
 | 
|---|
| 52 |  ;*
 | 
|---|
| 53 |  ;MSG_ROOT=CLOSED ARRAY REFERENCE
 | 
|---|
| 54 |  ;    (Optional) - Closed array reference where messages such as
 | 
|---|
| 55 |  ;    errors will be returned.  If not passed, decendents of ^TMP
 | 
|---|
| 56 |  ;    will be used.
 | 
|---|
| 57 |  ;*
 | 
|---|
| 58 |  I '$D(DIQUIET) N DIQUIET S DIQUIET=1
 | 
|---|
| 59 |  I '$D(DIFM) N DIFM S DIFM=1
 | 
|---|
| 60 |  I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
 | 
|---|
| 61 |  I $G(DIFRNAME)']"" D BLD^DIALOG(9530) Q
 | 
|---|
| 62 |  D
 | 
|---|
| 63 |  .N X
 | 
|---|
| 64 |  .S X=DIFRFILE
 | 
|---|
| 65 |  .I X=.5!(X=.4)!(X=.401)!(X=.402)!(X=.403)!(X=.84) Q
 | 
|---|
| 66 |  .S DIFRFILE=0
 | 
|---|
| 67 |  .Q
 | 
|---|
| 68 |  I DIFRFILE'>0 D BLD^DIALOG(9531) Q
 | 
|---|
| 69 |  I $G(DIFRTA)="" S DIFRTA=$NA(^XTMP("XPDT",DIFRNAME,"KRN"))
 | 
|---|
| 70 |  ;*
 | 
|---|
| 71 |  ;        * *DIFRFIA NO LONGER USED* *
 | 
|---|
| 72 |  ;S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(^XTMP("XPDT",DIFRNAME,"FIA"))
 | 
|---|
| 73 |  ;I '$D(@DIFRFIA) D BLD^DIALOG(9501) Q
 | 
|---|
| 74 |  ;*
 | 
|---|
| 75 |  I $G(DIFRIEN)'>0&($G(DIFRLST)="") D BLD^DIALOG(9531) Q
 | 
|---|
| 76 |  I $G(DIFRIEN)'>0,$D(@DIFRLST)'>9 D BLD^DIALOG(9532) Q
 | 
|---|
| 77 |  S DIFRFLG=$G(DIFRFLG)
 | 
|---|
| 78 |  N DIFRFNAM
 | 
|---|
| 79 |  S DIFRFNAM=$P($P(".4;PRINT TEMPLATE^.401;SORT TEMPLATE^.402;INPUT TEMPLATE^.403;FORM^.404;BLOCK^.5;FUNCTION^.84;DIALOG",DIFRFILE_";",2),"^")
 | 
|---|
| 80 |  D EDEOUT^DIFROMS5
 | 
|---|
| 81 |  G EXIT
 | 
|---|
| 82 |  ;
 | 
|---|
| 83 | EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
 | 
|---|
| 84 |  Q
 | 
|---|