- DIFROMSO ;SCISC/DCL-DIFROM SERVER EDE OUT ;01:18 PM 8 Feb 1995
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;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="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
- DIFROMSO ;SCISC/DCL-DIFROM SERVER EDE OUT ;01:18 PM 8 Feb 1995
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ; * 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