MAGNU001 ;WOIFO/NST - Utilities for RPC calls ; 25 Apr 2017 4:16 PM
;;3.0;IMAGING;**185**;Mar 19, 2002;Build 92;Aug 02, 2012
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
FM2IDF(FMDT) ; converts date time in FileMan format CYYMMDD.HHMMSS to YYYYMMDD.HHMMSS
I FMDT="" Q ""
N MAGTIME
S MAGTIME=$P(FMDT,".",2)
Q (FMDT\1+17000000)_"."_MAGTIME
;
; Input parameters
; ================
; FILE = FileMan file number (e.g. 2006.917)
GETFILNM(FILE) ; Returns file name
Q $$GET1^DID(FILE,"","","NAME")
;
; Input parameters
; ================
; FILE - FileMan file
GETFILGL(FILE) ; Get Global root of the file
Q $$ROOT^DILFD(FILE)
;
; Input parameters
; ================
; FILE - FileMan file
; FNAME - Field name
GETFLDID(FILE,FNAME) ; Returns a field number
Q $$FLDNUM^DILFD(FILE,FNAME)
;
GETFLDS(MAGRY,MAGRYW,FILE,FLAGS) ; Returns array with all fields in a file
;
; Input Parameters
; ================
; FILE = FileMan file number
; FLAGS = I - add I(internal) to the field numbers in Result e.g .01I;2I;3I
;
; Return Values
; =============
;
; Result=n1;n2;n3 (e.g. .01;2;3) - no multiple or word-processing fields
;
; MAGRY(n)=nth field name
; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
;
; MAGRYW(n)=nth Word-Processing field name
; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
;
N I,FLDID,FLDS,DEL
N WPTYPE,IVAL
K MAGRY,MAGRYW
S IVAL=$S($G(FLAGS)["I":"I",1:"")
S I=""
S FLDS=""
F S I=$O(^DD(FILE,"B",I)) Q:I="" D ; IA #5551
. S FLDID=$O(^DD(FILE,"B",I,""))
. I $$ISFLDSUB^MAGNU001(.WPTYPE,FILE,FLDID) D
. . S MAGRYW(FLDID)=I
. . S MAGRYW(FLDID,"TYPE")=WPTYPE
. . Q
. E D
. . S MAGRY(FLDID)=I
. . S MAGRY(FLDID,"TYPE")=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
. . Q
. Q
S I="",DEL=""
F S I=$O(MAGRY(I)) Q:I="" D
. ; Skip multiple and word-processing fields GETS^DIQ cannot handle Word-Processing field
. I $$ISFLDSUB^MAGNU001(.WPTYPE,FILE,I) Q
. S FLDS=FLDS_DEL_I_IVAL
. S DEL=";"
. Q
Q FLDS
;
; Input parameters
; ================
; FILE - FileMan file
; FLDID - Field Number
;
; Return Values
; =============
; TYPEDEF = Type of field
ISFLDSUB(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type or Multiple
N FILESUB
S TYPEDEF=""
Q:'$$GET1^DID(FILE,FLDID,"","MULTIPLE-VALUED") 0
S FILESUB=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
S TYPEDEF=$$GET1^DID(+FILESUB,.01,"","SPECIFIER")
Q 1
;
; Input parameters
; ================
; FILE - FileMan file
; FLDID - Field Number
ISFLDDT(FILE,FLDID) ; Returns true(1) or false(0) if a field is from DATE/TIME type
Q $$GET1^DID(FILE,FLDID,"","TYPE")="DATE/TIME"
;
; Return WP field value as a string
; WP = Word-Processing field values
; e.g. WP(1)=Line 1
; WP(2)=Line 2
;
;
; Input parameters
; ================
; FILE - FileMan file
; FLDID - Field Number
;
; Return Values
; =============
; TYPEDEF = Type of Word-Processing field
ISFLDWP(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type
N WPFILE
S TYPEDEF=""
Q:$$GET1^DID(FILE,FLDID,"","TYPE")'="WORD-PROCESSING" 0
S WPFILE=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
S TYPEDEF=$$GET1^DID(WPFILE,.01,"","SPECIFIER")
Q 1
;
GSUBFILE(FILE,FIELD) ; Returns sub-file of a multiple field
Q +$$GET1^DID(FILE,FIELD,"","SPECIFIER")
;
GSUBROOT(FILE,FIELD,D0) ; Return open root of multiple field
N ROOT,NODE
S NODE=$$GET1^DID(FILE,FIELD,"","GLOBAL SUBSCRIPT LOCATION")
S NODE=$P(NODE,";")
S ROOT=$$GETFILGL(FILE)
Q ROOT_D0_","_NODE_","
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNU001 4695 printed Nov 22, 2024@17:17:34 Page 2
MAGNU001 ;WOIFO/NST - Utilities for RPC calls ; 25 Apr 2017 4:16 PM
+1 ;;3.0;IMAGING;**185**;Mar 19, 2002;Build 92;Aug 02, 2012
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
FM2IDF(FMDT) ; converts date time in FileMan format CYYMMDD.HHMMSS to YYYYMMDD.HHMMSS
+1 IF FMDT=""
QUIT ""
+2 NEW MAGTIME
+3 SET MAGTIME=$PIECE(FMDT,".",2)
+4 QUIT (FMDT\1+17000000)_"."_MAGTIME
+5 ;
+6 ; Input parameters
+7 ; ================
+8 ; FILE = FileMan file number (e.g. 2006.917)
GETFILNM(FILE) ; Returns file name
+1 QUIT $$GET1^DID(FILE,"","","NAME")
+2 ;
+3 ; Input parameters
+4 ; ================
+5 ; FILE - FileMan file
GETFILGL(FILE) ; Get Global root of the file
+1 QUIT $$ROOT^DILFD(FILE)
+2 ;
+3 ; Input parameters
+4 ; ================
+5 ; FILE - FileMan file
+6 ; FNAME - Field name
GETFLDID(FILE,FNAME) ; Returns a field number
+1 QUIT $$FLDNUM^DILFD(FILE,FNAME)
+2 ;
GETFLDS(MAGRY,MAGRYW,FILE,FLAGS) ; Returns array with all fields in a file
+1 ;
+2 ; Input Parameters
+3 ; ================
+4 ; FILE = FileMan file number
+5 ; FLAGS = I - add I(internal) to the field numbers in Result e.g .01I;2I;3I
+6 ;
+7 ; Return Values
+8 ; =============
+9 ;
+10 ; Result=n1;n2;n3 (e.g. .01;2;3) - no multiple or word-processing fields
+11 ;
+12 ; MAGRY(n)=nth field name
+13 ; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
+14 ;
+15 ; MAGRYW(n)=nth Word-Processing field name
+16 ; MAGRY(n,"TYPE")=type of the field (e.g. RP2006.916, 2006.9183, RD, RN, etc.)
+17 ;
+18 NEW I,FLDID,FLDS,DEL
+19 NEW WPTYPE,IVAL
+20 KILL MAGRY,MAGRYW
+21 SET IVAL=$SELECT($GET(FLAGS)["I":"I",1:"")
+22 SET I=""
+23 SET FLDS=""
+24 ; IA #5551
FOR
SET I=$ORDER(^DD(FILE,"B",I))
if I=""
QUIT
Begin DoDot:1
+25 SET FLDID=$ORDER(^DD(FILE,"B",I,""))
+26 IF $$ISFLDSUB^MAGNU001(.WPTYPE,FILE,FLDID)
Begin DoDot:2
+27 SET MAGRYW(FLDID)=I
+28 SET MAGRYW(FLDID,"TYPE")=WPTYPE
+29 QUIT
End DoDot:2
+30 IF '$TEST
Begin DoDot:2
+31 SET MAGRY(FLDID)=I
+32 SET MAGRY(FLDID,"TYPE")=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 SET I=""
SET DEL=""
+36 FOR
SET I=$ORDER(MAGRY(I))
if I=""
QUIT
Begin DoDot:1
+37 ; Skip multiple and word-processing fields GETS^DIQ cannot handle Word-Processing field
+38 IF $$ISFLDSUB^MAGNU001(.WPTYPE,FILE,I)
QUIT
+39 SET FLDS=FLDS_DEL_I_IVAL
+40 SET DEL=";"
+41 QUIT
End DoDot:1
+42 QUIT FLDS
+43 ;
+44 ; Input parameters
+45 ; ================
+46 ; FILE - FileMan file
+47 ; FLDID - Field Number
+48 ;
+49 ; Return Values
+50 ; =============
+51 ; TYPEDEF = Type of field
ISFLDSUB(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type or Multiple
+1 NEW FILESUB
+2 SET TYPEDEF=""
+3 if '$$GET1^DID(FILE,FLDID,"","MULTIPLE-VALUED")
QUIT 0
+4 SET FILESUB=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
+5 SET TYPEDEF=$$GET1^DID(+FILESUB,.01,"","SPECIFIER")
+6 QUIT 1
+7 ;
+8 ; Input parameters
+9 ; ================
+10 ; FILE - FileMan file
+11 ; FLDID - Field Number
ISFLDDT(FILE,FLDID) ; Returns true(1) or false(0) if a field is from DATE/TIME type
+1 QUIT $$GET1^DID(FILE,FLDID,"","TYPE")="DATE/TIME"
+2 ;
+3 ; Return WP field value as a string
+4 ; WP = Word-Processing field values
+5 ; e.g. WP(1)=Line 1
+6 ; WP(2)=Line 2
+7 ;
+8 ;
+9 ; Input parameters
+10 ; ================
+11 ; FILE - FileMan file
+12 ; FLDID - Field Number
+13 ;
+14 ; Return Values
+15 ; =============
+16 ; TYPEDEF = Type of Word-Processing field
ISFLDWP(TYPEDEF,FILE,FLDID) ; Returns true(1) or false(0) if a field is from Word-Processing type
+1 NEW WPFILE
+2 SET TYPEDEF=""
+3 if $$GET1^DID(FILE,FLDID,"","TYPE")'="WORD-PROCESSING"
QUIT 0
+4 SET WPFILE=$$GET1^DID(FILE,FLDID,"","SPECIFIER")
+5 SET TYPEDEF=$$GET1^DID(WPFILE,.01,"","SPECIFIER")
+6 QUIT 1
+7 ;
GSUBFILE(FILE,FIELD) ; Returns sub-file of a multiple field
+1 QUIT +$$GET1^DID(FILE,FIELD,"","SPECIFIER")
+2 ;
GSUBROOT(FILE,FIELD,D0) ; Return open root of multiple field
+1 NEW ROOT,NODE
+2 SET NODE=$$GET1^DID(FILE,FIELD,"","GLOBAL SUBSCRIPT LOCATION")
+3 SET NODE=$PIECE(NODE,";")
+4 SET ROOT=$$GETFILGL(FILE)
+5 QUIT ROOT_D0_","_NODE_","
