DIFROMSO ;SCISC/DCL-DIFROM SERVER EDE OUT ;01:18 PM 8 Feb 1995
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFROMSO 3712 printed Dec 13, 2024@02:48:24 Page 2
DIFROMSO ;SCISC/DCL-DIFROM SERVER EDE OUT ;01:18 PM 8 Feb 1995
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 QUIT
+8 ;
+9 ; * 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
