- 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 Feb 18, 2025@23:36:28 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