source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFROMSO.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1DIFROMSO ;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 *
7EDEOUT(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 ;
83EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
84 Q
Note: See TracBrowser for help on using the repository browser.