Return to DIFROMSR.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFROMSR.m, revision 1.1

1.1     ! snw         1: DIFROMSR       ;SFISC/DCL-RESOLVE POINTERS ON TARGET SYSTEM;04:18 PM  18 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: RP(DIFRFLG,DIFRFIA,DIFRSA,DIFRMSGR)    ; Resolve Pointers on Target System
        !             6:        ;The "FRV1" and "FRVL" structures within the
        !             7:        ;transport array are used.
        !             8:        ;FILE,FLAGS,FIAROOT,SOURCE_ARRAY,MSG_ROOT
        !             9:        ;*
        !            10:        ;FLAGS=(RESERVED FOR LATER USE)
        !            11:        ;    (Optional)
        !            12:        ;                 None
        !            13:        ;*
        !            14:        ;FIA_ARRAY="FIA"_ARRAY_INPUT_ARRAY_ROOT
        !            15:        ;    (Optional) - Close Input Array Reference
        !            16:        ;    See DIFROM SERVER documentation for FIA array structure
        !            17:        ;    definitions.  If undefined SOURCE_ARRAY will be used
        !            18:        ;    by appending "FIA" to the source array root subscript.
        !            19:        ;*
        !            20:        ;SOURCE_ARRAY=CLOSED_INPUT_ARRAY_ROOT
        !            21:        ;    (Required) - Closed Input Array Reference where the file data
        !            22:        ;    is temporarily stored for distribution.
        !            23:        ;*
        !            24:        ;MSG_ROOT=CLOSED ARRAY REFERENCE
        !            25:        ;    (Optional) - Closed array reference where messages such as
        !            26:        ;    errors will be returned.  If not passed, decendents of ^TMP
        !            27:        ;    will be used.
        !            28:        ;*
        !            29:        I '$D(DIQUIET) N DIQUIET S DIQUIET=1
        !            30:        I '$D(DIFM) N DIFM S DIFM=1
        !            31:        I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
        !            32:        I $G(DIFRSA)']"" D ERR(6) G EXIT
        !            33:        S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(@DIFRSA@("FIA"))
        !            34:        ;
        !            35:        I '$D(DIFRFIA) D ERR(2) G EXIT
        !            36:        N DIFRFRVX,DIFRFILE
        !            37:        S DIFRFRVX="FRV1",DIFRFILE=0 F  S DIFRFILE=$O(@DIFRSA@(DIFRFRVX,DIFRFILE)) Q:DIFRFILE'>0  D FILE
        !            38:        G EXIT
        !            39:        ;
        !            40: FILE   N DIFRTART,DIFRDNSC,DIFRPCE,DIFRSDA,DIFRY,DIFRPRV,DIFRPTF,DIFRPTFR,DIFRPRVL,DIFR2DD,DIFRTARL
        !            41:        N C,D0,DA,DIC,DIK,F,G,I,R1,R2,R3,X,Y
        !            42:        S DIFRTART=$NA(@DIFRSA@(DIFRFRVX,DIFRFILE))
        !            43:        S DIFRTARL=$NA(@DIFRSA@("FRVL",DIFRFILE))
        !            44:        S DIFRSDA=$$OREF^DILF($NA(@DIFRSA@("DATA",DIFRFILE))),DIFRDNSC=""
        !            45:        F  S DIFRDNSC=$O(@DIFRTART@(DIFRDNSC)) Q:DIFRDNSC=""  D
        !            46:        .K R1
        !            47:        .S R2=DIFRDNSC,C=$P(R2,","),F=1,R1=0
        !            48:        .F I=1:1 Q:I>C  S G=$P(R2,",",F,I) Q:G=""  I G'[""""!($L(G,"""")#2&($E(G)="""")&($E(G,$L(G))="""")) S F=F+$L(G,","),I=F-1,R1(R1)=G,R1=R1+1,C=C+($L(G,",")-1)
        !            49:        .I R1'>3 S DIFR2DD=DIFRFILE
        !            50:        .E  D
        !            51:        ..S R3=""
        !            52:        ..F I=0:1:R1-3 S R3=R3_R1(I)_","
        !            53:        ..S DIFR2DD=+$P($G(@(DIFRSDA_R3_"0)")),"^",2)
        !            54:        ..Q
        !            55:        .;
        !            56:        .S DIFRPCE=""
        !            57:        .F  S DIFRPCE=$O(@DIFRTART@(DIFRDNSC,DIFRPCE)) Q:DIFRPCE'>0  D
        !            58:        ..S DIFRPRV=$G(@DIFRTART@(DIFRDNSC,DIFRPCE)),DIFRPTF=$G(^(DIFRPCE,"F"))
        !            59:        ..S DIFRPRVL=$G(@DIFRTARL@(DIFRDNSC)),DIFRPTFR=$P(DIFRPTF,";",2)
        !            60:        ..I DIFRPRVL="" D ERR(7," (^"_DIFRPTFR_"/"_DIFRPRV_")") Q
        !            61:        ..I DIFRPTFR="" D ERR(8," ("_DIFRPRVL_"/"_DIFRPRV_")") Q
        !            62:        ..I DIFRPRV="" D ERR(9," (^"_DIFRPTFR_"/"_DIFRPRVL_")") Q
        !            63:        ..I '$D(@("^"_DIFRPTFR_"0)")) D ERR(10," (^"_DIFRPTFR_"/"_DIFRPRV_")") Q
        !            64:        ..S DIC="^"_DIFRPTFR,DIC(0)="X",X=DIFRPRV D ^DIC I +Y'>0 D ERR(11," ("_DIC_"  Entry:"_DIFRPRV_")") S Y=""
        !            65:        ..S DIFRY=+Y S:DIFRPTF DIFRY=+Y_";"_DIFRPTFR
        !            66:        ..S $P(@DIFRPRVL,"^",DIFRPCE)=DIFRY
        !            67:        ..Q
        !            68:        ;
        !            69:        S DIK=@DIFRFIA@(DIFRFILE,0),DIK(0)="AB"
        !            70:        D IXALL^DIK:$O(@(DIK_"0)"))
        !            71:        ;
        !            72:        Q
        !            73:        ;
        !            74: EXIT   I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
        !            75:        Q
        !            76: ERR(X,Y)       S X=$P($T(ERR+X),";",5) S:$D(Y) Y(1)=Y Q:'X  D BLD^DIALOG(X,.Y) Q
        !            77:        ;;FIA Node Is Set To "No Data";1;9509
        !            78:        ;;FIA Array Does Not Exist;2;9501
        !            79:        ;;;3;
        !            80:        ;;Records Do Not Exist;4;9510
        !            81:        ;;FIA File Number Invalid;5;9502
        !            82:        ;;Source Array Root Missing;6;9533
        !            83:        ;;Resolved Value Data Link Missing;7;9534
        !            84:        ;;Pointed Too File Missing;8;9535
        !            85:        ;;Pointer Resolved Value Missing;9;9538
        !            86:        ;;Pointed Too File NOT on Target System;10;9536
        !            87:        ;;Unable To Find Exact Match And Resolve Pointer;11;9537