DITMU3 ;SFISC/EDE(OHPRD)-GET XREFS FOR ONE FIELD IN ONE FILE/SUBFILE ;2015-01-03 10:14 AM
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
; Given a file/subfile number, a field number, and a variable
; from which to assign subscripted values, this routine will
; return the xrefs for the specified field.
;
; The returned xrefs will be subscripted from the ROOT as follows:
;
; ROOT(FIELD,n) = file/subfile^xref (e.g. 9000010^AC)
; ROOT(FIELD,n,"K") = executable kill logic
; ROOT(FIELD,n,"S") = executable set logic
;
; Formal list:
;
; 1) FILE = file or subfile number (call by value)
; 2) FIELD = field number (call by value)
; 3) ROOT = array root (call by reference)
;
EN(FILE,FIELD,ROOT) ;
START ;
NEW Y
F Y=0:0 S Y=$O(^DD(FILE,FIELD,1,Y)) Q:Y'=+Y S ROOT(FIELD,Y)=^(Y,0),ROOT(FIELD,Y,"S")=^(1),ROOT(FIELD,Y,"K")=^(2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITMU3 1145 printed Nov 22, 2024@18:04:23 Page 2
DITMU3 ;SFISC/EDE(OHPRD)-GET XREFS FOR ONE FIELD IN ONE FILE/SUBFILE ;2015-01-03 10:14 AM
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ; Given a file/subfile number, a field number, and a variable
+8 ; from which to assign subscripted values, this routine will
+9 ; return the xrefs for the specified field.
+10 ;
+11 ; The returned xrefs will be subscripted from the ROOT as follows:
+12 ;
+13 ; ROOT(FIELD,n) = file/subfile^xref (e.g. 9000010^AC)
+14 ; ROOT(FIELD,n,"K") = executable kill logic
+15 ; ROOT(FIELD,n,"S") = executable set logic
+16 ;
+17 ; Formal list:
+18 ;
+19 ; 1) FILE = file or subfile number (call by value)
+20 ; 2) FIELD = field number (call by value)
+21 ; 3) ROOT = array root (call by reference)
+22 ;
EN(FILE,FIELD,ROOT) ;
START ;
+1 NEW Y
+2 FOR Y=0:0
SET Y=$ORDER(^DD(FILE,FIELD,1,Y))
if Y'=+Y
QUIT
SET ROOT(FIELD,Y)=^(Y,0)
SET ROOT(FIELD,Y,"S")=^(1)
SET ROOT(FIELD,Y,"K")=^(2)
+3 QUIT
