Return to DIFROMSR.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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