Annotation of freem_fileman/DIFROMSO.m, revision 1.1

1.1     ! snw         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>