Return to DIFROMSR.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFROMSR.m, revision 1.1.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