Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIFROMSR

DIFROMSR.m

Go to the documentation of this file.
  1. DIFROMSR ;SFISC/DCL,TKW-RESOLVE POINTERS ON TARGET SYSTEM ;5/14/98 12:29
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. Q
  1. RP(DIFRFLG,DIFRFIA,DIFRSA,DIFRMSGR) ; Resolve Pointers on Target System
  1. ;The "FRV1" and "FRVL" structures within the
  1. ;transport array are used.
  1. ;FILE,FLAGS,FIAROOT,SOURCE_ARRAY,MSG_ROOT
  1. ;*
  1. ;FLAGS=(RESERVED FOR LATER USE)
  1. ; (Optional)
  1. ; None
  1. ;*
  1. ;FIA_ARRAY="FIA"_ARRAY_INPUT_ARRAY_ROOT
  1. ; (Optional) - Close Input Array Reference
  1. ; See DIFROM SERVER documentation for FIA array structure
  1. ; definitions. If undefined SOURCE_ARRAY will be used
  1. ; by appending "FIA" to the source array root subscript.
  1. ;*
  1. ;SOURCE_ARRAY=CLOSED_INPUT_ARRAY_ROOT
  1. ; (Required) - Closed Input Array Reference where the file data
  1. ; is temporarily stored for distribution.
  1. ;*
  1. ;MSG_ROOT=CLOSED ARRAY REFERENCE
  1. ; (Optional) - Closed array reference where messages such as
  1. ; errors will be returned. If not passed, decendents of ^TMP
  1. ; will be used.
  1. ;*
  1. I '$D(DIQUIET) N DIQUIET S DIQUIET=1
  1. I '$D(DIFM) N DIFM S DIFM=1
  1. I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
  1. I $G(DIFRSA)']"" D ERR(6) G EXIT
  1. S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(@DIFRSA@("FIA"))
  1. ;
  1. I '$D(DIFRFIA) D ERR(2) G EXIT
  1. N DIFRFRVX,DIFRFILE
  1. S DIFRFRVX="FRV1",DIFRFILE=0 F S DIFRFILE=$O(@DIFRSA@(DIFRFRVX,DIFRFILE)) Q:DIFRFILE'>0 D FILE
  1. G EXIT
  1. ;
  1. FILE N DIFRTART,DIFRDNSC,DIFRPCE,DIFRSDA,DIFRY,DIFRPRV,DIFRPTF,DIFRPTFR,DIFRPRVL,DIFR2DD,DIFRTARL
  1. N C,D0,DA,DIC,DIK,F,G,I,R1,R2,R3,X,Y
  1. S DIFRTART=$NA(@DIFRSA@(DIFRFRVX,DIFRFILE))
  1. S DIFRTARL=$NA(@DIFRSA@("FRVL",DIFRFILE))
  1. S DIFRSDA=$$OREF^DILF($NA(@DIFRSA@("DATA",DIFRFILE))),DIFRDNSC=""
  1. F S DIFRDNSC=$O(@DIFRTART@(DIFRDNSC)) Q:DIFRDNSC="" D
  1. .K R1
  1. .S R2=DIFRDNSC,C=$P(R2,","),F=1,R1=0
  1. .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)
  1. .I R1'>3 S DIFR2DD=DIFRFILE
  1. .E D
  1. ..S R3=""
  1. ..F I=0:1:R1-3 S R3=R3_R1(I)_","
  1. ..S DIFR2DD=+$P($G(@(DIFRSDA_R3_"0)")),"^",2)
  1. ..Q
  1. .;
  1. .S DIFRPCE=""
  1. .F S DIFRPCE=$O(@DIFRTART@(DIFRDNSC,DIFRPCE)) Q:DIFRPCE'>0 D
  1. ..S DIFRPRV=$G(@DIFRTART@(DIFRDNSC,DIFRPCE)),DIFRPTF=$G(^(DIFRPCE,"F"))
  1. ..S DIFRPRVL=$G(@DIFRTARL@(DIFRDNSC)),DIFRPTFR=$P(DIFRPTF,";",2)
  1. ..I DIFRPRVL="" D ERR(7," (^"_DIFRPTFR_"/"_DIFRPRV_")") Q
  1. ..I DIFRPTFR="" D ERR(8," ("_DIFRPRVL_"/"_DIFRPRV_")") Q
  1. ..I DIFRPRV="" D ERR(9," (^"_DIFRPTFR_"/"_DIFRPRVL_")") Q
  1. ..I '$D(@("^"_DIFRPTFR_"0)")) D ERR(10," (^"_DIFRPTFR_"/"_DIFRPRV_")") Q
  1. ..D LOOKUP
  1. ..I +Y'>0 D ERR(11," ("_DIC_" Entry:"_DIFRPRV_")") S Y=-1
  1. ..S DIFRY=+Y S:DIFRPTF DIFRY=+Y_";"_DIFRPTFR
  1. ..S $P(@DIFRPRVL,"^",DIFRPCE)=DIFRY
  1. ..Q
  1. ;
  1. S DIK=@DIFRFIA@(DIFRFILE,0),DIK(0)="AB"
  1. D IXALL^DIK:$O(@(DIK_"0)"))
  1. ;
  1. Q
  1. ;
  1. LOOKUP ; Lookup entry on pointed-to file
  1. N DIFRS S DIFRS=$NA(@DIFRSA@("FRV1K",DIFRFILE,DIFRDNSC,DIFRPCE))
  1. S DIC="^"_DIFRPTFR
  1. I '$O(@DIFRS@(0)) S DIC(0)="X",X=DIFRPRV D ^DIC Q
  1. N DIFL,DIKEY,I,DIFRVAL
  1. S DIKEY=@DIFRS
  1. S DIFL=+$P(@("^"_DIFRPTFR_"0)"),U,2) I 'DIFL S Y=-1 Q
  1. F I=0:0 S I=$O(@DIFRS@(I)) Q:'I S DIFRVAL(I)=@DIFRS@(I)
  1. S Y=$$FIND1^DIC(DIFL,",","X",.DIFRVAL,DIKEY)
  1. S:'Y Y=-1 Q
  1. ;
  1. EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
  1. Q
  1. ERR(X,Y) S X=$P($T(ERR+X),";",5) S:$D(Y) Y(1)=Y Q:'X D BLD^DIALOG(X,.Y) Q
  1. ;;FIA Node Is Set To "No Data";1;9509
  1. ;;FIA Array Does Not Exist;2;9501
  1. ;;;3;
  1. ;;Records Do Not Exist;4;9510
  1. ;;FIA File Number Invalid;5;9502
  1. ;;Source Array Root Missing;6;9533
  1. ;;Resolved Value Data Link Missing;7;9534
  1. ;;Pointed Too File Missing;8;9535
  1. ;;Pointer Resolved Value Missing;9;9538
  1. ;;Pointed Too File NOT on Target System;10;9536
  1. ;;Unable To Find Exact Match And Resolve Pointer;11;9537