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 (5 weeks, 4 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

DIFROMSO	;SCISC/DCL-DIFROM SERVER EDE OUT;08:43 AM  22 Nov 1994;
	;;21.0;VA FileMan;;Dec 28, 1994
	;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=None at this time
	;*
	;PKGNAME=Package Name
	;    (Required) - Identifies the unique key subscript
	;                 in the export target array.
	;*
	;FIA_ARRAY="FIA"_ARRAY_INPUT_ARRAY_ROOT
	;    (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"))
	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

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