File:  [Coherent Logic Development] / freem_fileman / USER / DIFROMSO.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: DIFROMSO	;SCISC/DCL-DIFROM SERVER EDE OUT;08:43 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: 	;
    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=None at this time
   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
   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: 	S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(^XTMP("XPDT",DIFRNAME,"FIA"))
   71: 	I '$D(@DIFRFIA) D BLD^DIALOG(9501) Q
   72: 	I $G(DIFRIEN)'>0&($G(DIFRLST)="") D BLD^DIALOG(9531) Q
   73: 	I $G(DIFRIEN)'>0,$D(@DIFRLST)'>9 D BLD^DIALOG(9532) Q
   74: 	S DIFRFLG=$G(DIFRFLG)
   75: 	N DIFRFNAM
   76: 	S DIFRFNAM=$P($P(".4;PRINT TEMPLATE^.401;SORT TEMPLATE^.402;INPUT TEMPLATE^.403;FORM^.404;BLOCK^.5;FUNCTION^.84;DIALOG",DIFRFILE_";",2),"^")
   77: 	D EDEOUT^DIFROMS5
   78: 	G EXIT
   79: 	;
   80: EXIT	I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
   81: 	Q

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