MAGVIMRA ;WOIFO/MAT,DWM,DAC - VISA Importer RA Utilities ; Dec 31, 2019@07:47:15
;;3.0;IMAGING;**138,164,252**;Mar 19, 2002;Build 5
;; 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
;+++++ Wrap calls to ALERT^RARTE7. IA #6006 (Private).
;
; Called by XMCOMPLT^MAGVIM05 after exam status advanced to COMPLETE.
;
ALERT(RADFN,RADTI,RACNI,RAFIRST) ;
N RAA1,RAA2,RANY1,RANY2,RARPT
S RANY1=0
S RANY2=$$ANYDX^RARTE7(.RAA2)
S RARPT=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)
D ALERT^RARTE7
K RAAB
Q
;--- Increment counter.
C() S C=C+1
Q C
;+++++ Return STANDARD REPORTS file (#74.1) data w/ XML tags.
;
; RPC: MAGV GET RAD STD RPTS
;
; Input
;
; OUT Array holding the results to return.
;
; Output
;
; Array of XML tagged STANDARD REPORTS file (#74.1) data.
;
GETRADSR(OUT) ;
N FILE S FILE=74.1
N C S C=0
;--- Output standard XML header. IA #4153 (Supported).
S OUT(C)=$$XMLHDR^MXMLUTL()
N TAG0 S TAG0="ArrayOfStandardReport"
S OUT($$C())=$$XMTAG(TAG0,0) D
. ;
. ;--- Read of ^RA(74.1,IEN, is IA #6004 (Private).
. N TAG1 S TAG1="StandardReport"
. N IEN
. S IEN=0 F S IEN=$O(^RA(FILE,IEN)) Q:IEN]"A" D RADSR(TAG1,IEN)
. Q
S OUT($$C())=$$XMTAG(TAG0,1)
Q
;+++++ Return DIAGNOSTIC CODE file (#78.3) data w/ XML tags.
;
; RPC: MAGV GET RAD DX CODES
;
; Input
;
; OUT Array holding the results to return.
;
; Output
;
; Array of XML tagged DIAGNOSTIC CODES file (#78.3) data.
;
GETRADDX(OUT) ; P252 DAC - Modified to exclude inactive RAD DX codes
N FILE S FILE=78.3
N C S C=0
;--- IA #3561 (Supported)
S OUT(C)=$$XMLHDR^MXMLUTL()
N TAG0 S TAG0="ArrayOfDiagnosticCode"
S OUT($$C())=$$XMTAG(TAG0,0) D
. ;
. ;--- Read of ^RA(78.1,IEN, is IA #6005 (Private).
. N TAG1 S TAG1="DiagnosticCode"
. N IEN
. S IEN=0 F S IEN=$O(^RA(FILE,IEN)) Q:IEN]"A" D
.. Q:$$GET1^DIQ(FILE,IEN,5,"I")="Y" ; exclude inactive codes <<
.. D RADDX(TAG1,IEN)
.. Q
. Q
S OUT($$C())=$$XMTAG(TAG0,1)
Q
;+++++ Return IMAGING LOCATIONS file (#79.1) data w/ XML tags.
;
; RPC: MAGV GET RAD DX CODES
;
; Input
;
; OUT Array holding the results to return.
;
; Output
;
; Array of XML tagged IMAGING LOCATIONS file (#79.1) data.
;
;--- Drive output assembly for one IMAGING LOCATIONS file (#78.3) record.
GETRADLC(OUT) ;
N FILE S FILE=79.1
N C S C=0
;--- IA #3561 (Supported)
S OUT(C)=$$XMLHDR^MXMLUTL()
N TAG0 S TAG0="ArrayOfImagingLocation"
S OUT($$C())=$$XMTAG(TAG0,0) D
. ;
. ;--- Read of ^RA(78.3,IEN, is IA #6007 (Private).
. N TAG1 S TAG1="ImagingLocation"
. N IEN,INACTIVE
. S IEN=0 F S IEN=$O(^RA(FILE,IEN)) Q:IEN]"A" D
.. S INACTIVE=$$GET1^DIQ(FILE,IEN,19,"I") ;; p164 Check the location is active
.. I (INACTIVE="")!(INACTIVE>$$DT^XLFDT) D RADLOC^MAGVIMRA(TAG1,IEN)
.. Q
. Q
S OUT($$C())=$$XMTAG(TAG0,1)
Q
;--- Drive output assembly for one DIAGNOSTIC CODES file (#78.3) record.
RADDX(TAG1,IEN) ;
S OUT($$C())=$$XMTAG(TAG1,0) D
. N STRING
. S OUT($$C())=$$STRING("Id",IEN)
. S STRING=$$GET1^DIQ(FILE,IEN,.01)
. S OUT($$C())=$$STRING("Name",STRING)
. S STRING=$$GET1^DIQ(FILE,IEN,2)
. S OUT($$C())=$$STRING("Description",IEN)
. Q
S OUT($$C())=$$XMTAG(TAG1,1)
Q
;--- Drive output assembly for one IMAGING LOCATIONS file (#79.1) record.
RADLOC(TAG1,IEN) ;
S OUT($$C())=$$XMTAG(TAG1,0) D
. N STRING
. S OUT($$C())=$$STRING("Id",IEN)
. S STRING=$$GET1^DIQ(FILE,IEN,.01)
. S OUT($$C())=$$STRING("Name",STRING)
. S STRING=$$GET1^DIQ(FILE,IEN,21)
. S OUT($$C())=$$STRING("CreditMethod",STRING)
. Q
S OUT($$C())=$$XMTAG(TAG1,1)
Q
;--- Drive output assembly for one STANDARD REPORT file (#78.1) record.
RADSR(TAG1,IEN) ;
S OUT($$C())=$$XMTAG(TAG1,0) D
. S OUT($$C())=$$STRING("Id",IEN)
. S STRING=$$GET1^DIQ(FILE,IEN,.01)
. S OUT($$C())=$$STRING("ReportName",STRING)
. ;
. ;--- Handle word-processing fields.
. D WPTXT("ReportText",FILE,200,IEN)
. D WPTXT("Impression",FILE,300,IEN)
. Q
S OUT($$C())=$$XMTAG(TAG1,1)
Q
;--- Tag an input string.
STRING(TAG,STRING) ;
N ITEM
S ITEM=$$XMTAG(TAG,0)
;--- Translate embedded reserved XML symbols. IA #4153 (Supported).
S ITEM=ITEM_$$SYMENC^MXMLUTL(STRING)
S ITEM=ITEM_$$XMTAG(TAG,1)
Q ITEM
;
;--- Tag a word processing field.
WPTXT(TAG,FILE,FIELD,IEN) ;
S OUT($$C())=$$XMTAG(TAG,0)
;
;--- Word Processing Field
K TXTERR,TXTWP
N ITEM
S ITEM=$$GET1^DIQ(FILE,IEN,FIELD,,"TXTWP","TXTERR")
;
;--- Translate embedded reserved XML symbols. IA #4153 (Supported).
N NDX
S NDX=0
F S NDX=$O(TXTWP(NDX)) Q:NDX="" S OUT($$C())=$$SYMENC^MXMLUTL(TXTWP(NDX))
S OUT($$C())=$$XMTAG(TAG,1)
Q
;--- Enclose a tag.
XMTAG(TAG,END) ;
S OUT="<"
S:END OUT=OUT_"/"
S OUT=OUT_TAG
S OUT=OUT_">"
Q OUT
;
; MAGVIMRA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIMRA 5820 printed Oct 16, 2024@18:10:38 Page 2
MAGVIMRA ;WOIFO/MAT,DWM,DAC - VISA Importer RA Utilities ; Dec 31, 2019@07:47:15
+1 ;;3.0;IMAGING;**138,164,252**;Mar 19, 2002;Build 5
+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 ;
+18 QUIT
+19 ;+++++ Wrap calls to ALERT^RARTE7. IA #6006 (Private).
+20 ;
+21 ; Called by XMCOMPLT^MAGVIM05 after exam status advanced to COMPLETE.
+22 ;
ALERT(RADFN,RADTI,RACNI,RAFIRST) ;
+1 NEW RAA1,RAA2,RANY1,RANY2,RARPT
+2 SET RANY1=0
+3 SET RANY2=$$ANYDX^RARTE7(.RAA2)
+4 SET RARPT=$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)
+5 DO ALERT^RARTE7
+6 KILL RAAB
+7 QUIT
+8 ;--- Increment counter.
C() SET C=C+1
+1 QUIT C
+2 ;+++++ Return STANDARD REPORTS file (#74.1) data w/ XML tags.
+3 ;
+4 ; RPC: MAGV GET RAD STD RPTS
+5 ;
+6 ; Input
+7 ;
+8 ; OUT Array holding the results to return.
+9 ;
+10 ; Output
+11 ;
+12 ; Array of XML tagged STANDARD REPORTS file (#74.1) data.
+13 ;
GETRADSR(OUT) ;
+1 NEW FILE
SET FILE=74.1
+2 NEW C
SET C=0
+3 ;--- Output standard XML header. IA #4153 (Supported).
+4 SET OUT(C)=$$XMLHDR^MXMLUTL()
+5 NEW TAG0
SET TAG0="ArrayOfStandardReport"
+6 SET OUT($$C())=$$XMTAG(TAG0,0)
Begin DoDot:1
+7 ;
+8 ;--- Read of ^RA(74.1,IEN, is IA #6004 (Private).
+9 NEW TAG1
SET TAG1="StandardReport"
+10 NEW IEN
+11 SET IEN=0
FOR
SET IEN=$ORDER(^RA(FILE,IEN))
if IEN]"A"
QUIT
DO RADSR(TAG1,IEN)
+12 QUIT
End DoDot:1
+13 SET OUT($$C())=$$XMTAG(TAG0,1)
+14 QUIT
+15 ;+++++ Return DIAGNOSTIC CODE file (#78.3) data w/ XML tags.
+16 ;
+17 ; RPC: MAGV GET RAD DX CODES
+18 ;
+19 ; Input
+20 ;
+21 ; OUT Array holding the results to return.
+22 ;
+23 ; Output
+24 ;
+25 ; Array of XML tagged DIAGNOSTIC CODES file (#78.3) data.
+26 ;
GETRADDX(OUT) ; P252 DAC - Modified to exclude inactive RAD DX codes
+1 NEW FILE
SET FILE=78.3
+2 NEW C
SET C=0
+3 ;--- IA #3561 (Supported)
+4 SET OUT(C)=$$XMLHDR^MXMLUTL()
+5 NEW TAG0
SET TAG0="ArrayOfDiagnosticCode"
+6 SET OUT($$C())=$$XMTAG(TAG0,0)
Begin DoDot:1
+7 ;
+8 ;--- Read of ^RA(78.1,IEN, is IA #6005 (Private).
+9 NEW TAG1
SET TAG1="DiagnosticCode"
+10 NEW IEN
+11 SET IEN=0
FOR
SET IEN=$ORDER(^RA(FILE,IEN))
if IEN]"A"
QUIT
Begin DoDot:2
+12 ; exclude inactive codes <<
if $$GET1^DIQ(FILE,IEN,5,"I")="Y"
QUIT
+13 DO RADDX(TAG1,IEN)
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 SET OUT($$C())=$$XMTAG(TAG0,1)
+17 QUIT
+18 ;+++++ Return IMAGING LOCATIONS file (#79.1) data w/ XML tags.
+19 ;
+20 ; RPC: MAGV GET RAD DX CODES
+21 ;
+22 ; Input
+23 ;
+24 ; OUT Array holding the results to return.
+25 ;
+26 ; Output
+27 ;
+28 ; Array of XML tagged IMAGING LOCATIONS file (#79.1) data.
+29 ;
+30 ;--- Drive output assembly for one IMAGING LOCATIONS file (#78.3) record.
GETRADLC(OUT) ;
+1 NEW FILE
SET FILE=79.1
+2 NEW C
SET C=0
+3 ;--- IA #3561 (Supported)
+4 SET OUT(C)=$$XMLHDR^MXMLUTL()
+5 NEW TAG0
SET TAG0="ArrayOfImagingLocation"
+6 SET OUT($$C())=$$XMTAG(TAG0,0)
Begin DoDot:1
+7 ;
+8 ;--- Read of ^RA(78.3,IEN, is IA #6007 (Private).
+9 NEW TAG1
SET TAG1="ImagingLocation"
+10 NEW IEN,INACTIVE
+11 SET IEN=0
FOR
SET IEN=$ORDER(^RA(FILE,IEN))
if IEN]"A"
QUIT
Begin DoDot:2
+12 ;; p164 Check the location is active
SET INACTIVE=$$GET1^DIQ(FILE,IEN,19,"I")
+13 IF (INACTIVE="")!(INACTIVE>$$DT^XLFDT)
DO RADLOC^MAGVIMRA(TAG1,IEN)
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 SET OUT($$C())=$$XMTAG(TAG0,1)
+17 QUIT
+18 ;--- Drive output assembly for one DIAGNOSTIC CODES file (#78.3) record.
RADDX(TAG1,IEN) ;
+1 SET OUT($$C())=$$XMTAG(TAG1,0)
Begin DoDot:1
+2 NEW STRING
+3 SET OUT($$C())=$$STRING("Id",IEN)
+4 SET STRING=$$GET1^DIQ(FILE,IEN,.01)
+5 SET OUT($$C())=$$STRING("Name",STRING)
+6 SET STRING=$$GET1^DIQ(FILE,IEN,2)
+7 SET OUT($$C())=$$STRING("Description",IEN)
+8 QUIT
End DoDot:1
+9 SET OUT($$C())=$$XMTAG(TAG1,1)
+10 QUIT
+11 ;--- Drive output assembly for one IMAGING LOCATIONS file (#79.1) record.
RADLOC(TAG1,IEN) ;
+1 SET OUT($$C())=$$XMTAG(TAG1,0)
Begin DoDot:1
+2 NEW STRING
+3 SET OUT($$C())=$$STRING("Id",IEN)
+4 SET STRING=$$GET1^DIQ(FILE,IEN,.01)
+5 SET OUT($$C())=$$STRING("Name",STRING)
+6 SET STRING=$$GET1^DIQ(FILE,IEN,21)
+7 SET OUT($$C())=$$STRING("CreditMethod",STRING)
+8 QUIT
End DoDot:1
+9 SET OUT($$C())=$$XMTAG(TAG1,1)
+10 QUIT
+11 ;--- Drive output assembly for one STANDARD REPORT file (#78.1) record.
RADSR(TAG1,IEN) ;
+1 SET OUT($$C())=$$XMTAG(TAG1,0)
Begin DoDot:1
+2 SET OUT($$C())=$$STRING("Id",IEN)
+3 SET STRING=$$GET1^DIQ(FILE,IEN,.01)
+4 SET OUT($$C())=$$STRING("ReportName",STRING)
+5 ;
+6 ;--- Handle word-processing fields.
+7 DO WPTXT("ReportText",FILE,200,IEN)
+8 DO WPTXT("Impression",FILE,300,IEN)
+9 QUIT
End DoDot:1
+10 SET OUT($$C())=$$XMTAG(TAG1,1)
+11 QUIT
+12 ;--- Tag an input string.
STRING(TAG,STRING) ;
+1 NEW ITEM
+2 SET ITEM=$$XMTAG(TAG,0)
+3 ;--- Translate embedded reserved XML symbols. IA #4153 (Supported).
+4 SET ITEM=ITEM_$$SYMENC^MXMLUTL(STRING)
+5 SET ITEM=ITEM_$$XMTAG(TAG,1)
+6 QUIT ITEM
+7 ;
+8 ;--- Tag a word processing field.
WPTXT(TAG,FILE,FIELD,IEN) ;
+1 SET OUT($$C())=$$XMTAG(TAG,0)
+2 ;
+3 ;--- Word Processing Field
+4 KILL TXTERR,TXTWP
+5 NEW ITEM
+6 SET ITEM=$$GET1^DIQ(FILE,IEN,FIELD,,"TXTWP","TXTERR")
+7 ;
+8 ;--- Translate embedded reserved XML symbols. IA #4153 (Supported).
+9 NEW NDX
+10 SET NDX=0
+11 FOR
SET NDX=$ORDER(TXTWP(NDX))
if NDX=""
QUIT
SET OUT($$C())=$$SYMENC^MXMLUTL(TXTWP(NDX))
+12 SET OUT($$C())=$$XMTAG(TAG,1)
+13 QUIT
+14 ;--- Enclose a tag.
XMTAG(TAG,END) ;
+1 SET OUT="<"
+2 if END
SET OUT=OUT_"/"
+3 SET OUT=OUT_TAG
+4 SET OUT=OUT_">"
+5 QUIT OUT
+6 ;
+7 ; MAGVIMRA
