DITMU3.m

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 ---DITMU3   1145     printed  Apr 09, 2024@21:54:04                                                                                                                                                                                                      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