MAGVIM07 ;;WOIFO/PMK/MLS/SG/DAC/MAT/BT - Imaging RPCs for Importer II; 29 Nov 2011 4:28 PM ; 12 Apr 2012 6:02 PM
;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
;; 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
;
;--- Copied from MAGDRPCB. Changed REQUEST STATUS filter at ORDERS+24.
;
;
; Notes
; =====
;
; Modification is for MAG*3.0*118 only. The original RPC name appears for
; reference only.
;
ORDERS(ARRAY,DFN) ; RPC = MAG DICOM GET RAD ORDERS ** Modified for MAG*3.0*118 only.
; look up radiology orders
N ACNUMB,CASENUMB,DIERR,EXAMDATA,EXAMDATE,EXAMSTAT,ERROR,SKIP,FIELDS,I,IENS,IMAGLOCN,INACTDAT
N ORDER,MAGEXAM,MAGMSG,MAGTMPEXAM,MAGTMPMOD,MODCOUNT,MODDATA
N MODIEN,MODIFIER,MSG,PROCIEN,RACNI,RADFN,RADTI,RAOIEN,RC,STATUS,STUDYDAT,TODAY,X,Z
K ARRAY
S DFN=$G(DFN),TODAY=$$DT^XLFDT()
I (DFN'>0)!(DFN'=+DFN) D Q
. S ARRAY(1)="-1,Invalid or missing patient identifier: """_DFN_"""."
. Q
;
; Make sure that the patient is registered in the RAD/NUC MED PATIENT file (#70)
;
S RC=$$RAPTREG^RAMAGU04(DFN) I RC<0 D Q ; ICR 5519
. S ARRAY(1)="-2,Patient with DFN #"_DFN_" is not defined in the RAD/NUC MED PATIENT file (#70)."
. S ARRAY(2)=RC
. Q
;
; Use MUMPS global reads to get data from ^RAO because of possible bad data
; that would cause FileMan to throw an error and not return any results.
;
S (ARRAY(1),ERROR,RAOIEN)=0
F S RAOIEN=$O(^RAO(75.1,"B",DFN,RAOIEN)) Q:ERROR Q:RAOIEN="" D ; ICR 3074
. S STATUS=$$GET1^DIQ(75.1,RAOIEN,5) ; request status
. ;--- MAG*3.0*118 -- Removed "^COMPLETE^" from the list of statuses to filter.
. I "^^DISCONTINUED^UNRELEASED^"[("^"_STATUS_"^") Q ; quit if status is null too
. S Z=$G(^RAO(75.1,RAOIEN,0))
. K ORDER S $P(ORDER,"^",11)="" ; initialize ORDER string
. S $P(ORDER,"^",1)=RAOIEN ; file 75.1 IEN
. S PROCIEN=$P(Z,"^",2) ; procedure
. Q:PROCIEN="" Q:'$D(^RAMIS(71,PROCIEN,0)) ; null or bad PROCIEN
. S INACTDAT=$P($G(^RAMIS(71,PROCIEN,"I")),U)
. I INACTDAT,INACTDAT<TODAY Q ; ignore inactive procedures
. S $P(ORDER,"^",2)=PROCIEN ; procedure
. ; piece 3 of ORDER is modifier(s)
. S $P(ORDER,"^",4)=STATUS ; request status
. S $P(ORDER,"^",5)=$P(Z,"^",16) ; request entered date
. S $P(ORDER,"^",6)=$$GET1^DIQ(75.1,RAOIEN,1.1) ; reason for study
. S SKIP=0
. I $D(^RADPT("AO",RAOIEN)) D
. . S RADFN=$O(^RADPT("AO",RAOIEN,"")) ; ICR 1172
. . S RADTI=$O(^RADPT("AO",RAOIEN,RADFN,""))
. . S RACNI=$O(^RADPT("AO",RAOIEN,RADFN,RADTI,""))
. . S $P(ORDER,"^",7)=RADTI
. . S $P(ORDER,"^",8)=RACNI
. . S MAGTMPEXAM=$NA(^TMP($T(+0),$J,"EXAM"))
. . S IENS=RACNI_","_RADTI_","_RADFN_","
. . S EXAMDATA=$NA(@MAGTMPEXAM@(70.03,IENS))
. . I $T(ACCFIND^RAAPI)'="" S FIELDS=".01;31;3;" ; requires RA*5.0*47
. . E S FIELDS=".01;3;" ; no accession number field (#31)
. . K @MAGTMPEXAM,MAGMSG
. . D GETS^DIQ(70.03,IENS,FIELDS,"EI",MAGTMPEXAM,"MAGMSG") ; ICR 1172
. . I $D(MAGMSG) D ORDERERR(.ARRAY,.MAGMSG,-3) S ERROR=-3 Q ; fatal FileMan error
. . S EXAMSTAT=$G(@EXAMDATA@(3,"E"))
. . I EXAMSTAT="CANCELLED" S SKIP=1 Q ; do not include cancelled exam
. . S EXAMDATE=$$GET1^DIQ(70.02,(RADTI_","_RADFN),.01,"I") ; ICR 1172
. . S ACNUMB=$G(@EXAMDATA@(31,"E"))
. . I ACNUMB="" D
. . . S CASENUMB=@EXAMDATA@(.01,"E")
. . . S ACNUMB=$E(EXAMDATE,4,7)_$E(EXAMDATE,2,3)_"-"_CASENUMB
. . . Q
. . S $P(ORDER,"^",9)=ACNUMB,$P(ORDER,"^",10)=EXAMDATE
. . S IMAGLOCN=$$GET1^DIQ(70.02,(RADTI_","_RADFN),4) ; ICR 1172
. . S $P(ORDER,"^",11)=IMAGLOCN
. . Q
. ;
. I ERROR Q ; FileMan error encountered in exam lookup
. I SKIP Q ; do not include this record
. ;
. ; get procedure modifier(s)
. S MAGTMPMOD=$NA(^TMP($T(+0),$J,"MODIFIER")),MODDATA=$NA(@MAGTMPMOD@("DILIST"))
. K @MAGTMPMOD,MAGMSG
. D LIST^DIC(75.1125,","_RAOIEN_",","@;.01;.01I;IX","",,,,,,,MAGTMPMOD,"MAGMSG") ; ICR 3074
. I $D(MAGMSG) D ORDERERR(.ARRAY,.MAGMSG,-4) Q ; fatal FileMan error
. S MODCOUNT=+@MODDATA@(0)
. S MODIFIER=""
. F I=1:1:MODCOUNT D
. . S:$L(MODIFIER) MODIFIER=MODIFIER_"~"
. . S MODIEN=@MODDATA@(2,I)
. . S MODIFIER=MODIFIER_@MODDATA@("ID",MODIEN,.01,"E")_"|"_^("I")
. . Q
. S $P(ORDER,"^",3)=MODIFIER
. ;
. S ARRAY(1)=ARRAY(1)+1,ARRAY(ARRAY(1)+1)=ORDER
. Q
K:$D(MAGTMPEXAM) @MAGTMPEXAM K:$D(MAGTMPMOD) @MAGTMPMOD ; cleanup
Q
;
ORDERERR(ARRAY,MSG,ERRNUMB) ; handle FileMan errors in ORDER subroutine
N I,NODE
K ARRAY
S I=1,NODE="MSG"
F S NODE=$Q(@NODE) Q:NODE="" D
. S I=I+1,ARRAY(I)=NODE
. I $D(@NODE) S ARRAY(I)=ARRAY(I)_"="_@NODE
. Q
S ARRAY(1)="-100,Fatal FileMan error #"_ERRNUMB
Q
;
IMAGELOC(RESULT,RAOIEN,RAMLC) ; RPC = MAG DICOM SET IMAGING LOCATION
N DIERR,MAGFDA,MAGMSG
;
K RESULT
S RAOIEN=$G(RAOIEN)
I (RAOIEN'>0)!(RAOIEN'=+RAOIEN) D Q
. S RESULT="-1,Invalid or missing Radiology Order pointer: """_RAOIEN_"""."
. Q
;
S RAMLC=$G(RAMLC)
I (RAMLC'>0)!(RAMLC'=+RAMLC) D Q
. S RESULT="-2,Invalid or missing Radiology Image Location identifier: """_RAMLC_"""."
. Q
;
I $$GET1^DIQ(75.1,RAOIEN,.01)="" D Q ; ICR 3074
. S RESULT="-3,Missing Radiology Order for pointer: """_RAOIEN_"""."
. Q
;
I $$GET1^DIQ(79.1,RAMLC,.01)="" D Q ; ICR 5357
. S RESULT="-4,Missing Radiology Image Location for pointer: """_RAMLC_"""."
. Q
;
I $$GET1^DIQ(75.1,RAOIEN,20)="" D Q ; ICR 3074
. S MAGFDA(75.1,RAOIEN_",",20)=RAMLC ; IMAGING LOCATION
. D FILE^DIE("","MAGFDA","MAGMSG") ; ICR 3074
. I $D(MAGMSG) S RESULT="-5,Error setting Radiology Image Location" Q
. S RESULT="1,Radiology Image Location set for pointer: """_RAOIEN_"""."
. Q
E D
. S RESULT="2,Radiology Image Location already set for pointer: """_RAOIEN_""", operation ignored."
. Q
Q
;
ADDROOM(RETURN,RAEXAM) ; RPC = MAG DICOM ADD CAMERA EQUIP RM
N HIT,I,IENS,LOCNAME,OUTSIDESTUDY,MAGFDA,MAGMSG,RADIMGLOC,ROOMS
K RETURN
;
I $L($G(RAEXAM),"^")<2 S RETURN(0)="-1,Invalid or missing Radiology Exam pointer: """_RAEXAM_"""." Q
;
; get the Radiology IMAGING LOCATION
S IENS=$P(RAEXAM,"^",2)_","_$P(RAEXAM,"^",1)_","
S RADIMGLOC=$$GET1^DIQ(70.02,IENS,4,"I") ; ICR 1172
I 'RADIMGLOC S RETURN(0)="-2,Invalid or missing Radiology IMAGING LOCATION for Exam pointer: """_RAEXAM_"""." Q
S LOCNAME=$$GET1^DIQ(79.1,RADIMGLOC,.01)
;
; check if the IMAGING LOCATION has the OUTSIDE STUDY Camera/Equipment/Room
S OUTSIDESTUDY="OUTSIDE STUDY" ; designated name
D LIST^DIC(79.12,","_RADIMGLOC_",","@;.01","",,,,,,,"ROOMS","MAGMSG")
I $D(MAGMSG) D ORDERERR(.RETURN,.MAGMSG,-3) Q ; fatal FileMan error
S HIT=0 F I=1:1:ROOMS("DILIST",0) D Q:HIT
. I ROOMS("DILIST","ID",I,".01")=OUTSIDESTUDY S HIT=1
. Q
I HIT S RETURN(0)="2,"_OUTSIDESTUDY_" is already defined for """_LOCNAME_"""." Q
;
; add the OUTSIDE STUDY Camera/Equipment/Room to the IMAGING LOCATION
S MAGFDA(79.12,"+1,"_RADIMGLOC_",",.01)=OUTSIDESTUDY
D UPDATE^DIE("E","MAGFDA","MAGIENS","MAGMSG") ; ICR 5357
I $D(MAGMSG) D ORDERERR(.RETURN,.MAGMSG,-4) Q ; fatal FileMan error
S RETURN(0)="1,"_OUTSIDESTUDY_" has been added for """_LOCNAME_"""."
Q
;
;+++ FileMan Screen code for the RAD TECHNOLOGIST field (#300) of the
; IMAGING SITE PARAMETERS file (#2006.1).
;
; The direct "ARC" cross-reference read is supported by IA #3544.
;
YNRADIST(DUZ,RADCLASS) ;
;
N YN S YN=0
N X F X=1:1:$L(RADCLASS) I $D(^VA(200,"ARC",$E(RADCLASS,X),DUZ)) S YN=1 Q
Q YN
;
; MAGVIM07
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM07 8428 printed Oct 16, 2024@18:10:35 Page 2
MAGVIM07 ;;WOIFO/PMK/MLS/SG/DAC/MAT/BT - Imaging RPCs for Importer II; 29 Nov 2011 4:28 PM ; 12 Apr 2012 6:02 PM
+1 ;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
+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 ;
+19 ;--- Copied from MAGDRPCB. Changed REQUEST STATUS filter at ORDERS+24.
+20 ;
+21 ;
+22 ; Notes
+23 ; =====
+24 ;
+25 ; Modification is for MAG*3.0*118 only. The original RPC name appears for
+26 ; reference only.
+27 ;
ORDERS(ARRAY,DFN) ; RPC = MAG DICOM GET RAD ORDERS ** Modified for MAG*3.0*118 only.
+1 ; look up radiology orders
+2 NEW ACNUMB,CASENUMB,DIERR,EXAMDATA,EXAMDATE,EXAMSTAT,ERROR,SKIP,FIELDS,I,IENS,IMAGLOCN,INACTDAT
+3 NEW ORDER,MAGEXAM,MAGMSG,MAGTMPEXAM,MAGTMPMOD,MODCOUNT,MODDATA
+4 NEW MODIEN,MODIFIER,MSG,PROCIEN,RACNI,RADFN,RADTI,RAOIEN,RC,STATUS,STUDYDAT,TODAY,X,Z
+5 KILL ARRAY
+6 SET DFN=$GET(DFN)
SET TODAY=$$DT^XLFDT()
+7 IF (DFN'>0)!(DFN'=+DFN)
Begin DoDot:1
+8 SET ARRAY(1)="-1,Invalid or missing patient identifier: """_DFN_"""."
+9 QUIT
End DoDot:1
QUIT
+10 ;
+11 ; Make sure that the patient is registered in the RAD/NUC MED PATIENT file (#70)
+12 ;
+13 ; ICR 5519
SET RC=$$RAPTREG^RAMAGU04(DFN)
IF RC<0
Begin DoDot:1
+14 SET ARRAY(1)="-2,Patient with DFN #"_DFN_" is not defined in the RAD/NUC MED PATIENT file (#70)."
+15 SET ARRAY(2)=RC
+16 QUIT
End DoDot:1
QUIT
+17 ;
+18 ; Use MUMPS global reads to get data from ^RAO because of possible bad data
+19 ; that would cause FileMan to throw an error and not return any results.
+20 ;
+21 SET (ARRAY(1),ERROR,RAOIEN)=0
+22 ; ICR 3074
FOR
SET RAOIEN=$ORDER(^RAO(75.1,"B",DFN,RAOIEN))
if ERROR
QUIT
if RAOIEN=""
QUIT
Begin DoDot:1
+23 ; request status
SET STATUS=$$GET1^DIQ(75.1,RAOIEN,5)
+24 ;--- MAG*3.0*118 -- Removed "^COMPLETE^" from the list of statuses to filter.
+25 ; quit if status is null too
IF "^^DISCONTINUED^UNRELEASED^"[("^"_STATUS_"^")
QUIT
+26 SET Z=$GET(^RAO(75.1,RAOIEN,0))
+27 ; initialize ORDER string
KILL ORDER
SET $PIECE(ORDER,"^",11)=""
+28 ; file 75.1 IEN
SET $PIECE(ORDER,"^",1)=RAOIEN
+29 ; procedure
SET PROCIEN=$PIECE(Z,"^",2)
+30 ; null or bad PROCIEN
if PROCIEN=""
QUIT
if '$DATA(^RAMIS(71,PROCIEN,0))
QUIT
+31 SET INACTDAT=$PIECE($GET(^RAMIS(71,PROCIEN,"I")),U)
+32 ; ignore inactive procedures
IF INACTDAT
IF INACTDAT<TODAY
QUIT
+33 ; procedure
SET $PIECE(ORDER,"^",2)=PROCIEN
+34 ; piece 3 of ORDER is modifier(s)
+35 ; request status
SET $PIECE(ORDER,"^",4)=STATUS
+36 ; request entered date
SET $PIECE(ORDER,"^",5)=$PIECE(Z,"^",16)
+37 ; reason for study
SET $PIECE(ORDER,"^",6)=$$GET1^DIQ(75.1,RAOIEN,1.1)
+38 SET SKIP=0
+39 IF $DATA(^RADPT("AO",RAOIEN))
Begin DoDot:2
+40 ; ICR 1172
SET RADFN=$ORDER(^RADPT("AO",RAOIEN,""))
+41 SET RADTI=$ORDER(^RADPT("AO",RAOIEN,RADFN,""))
+42 SET RACNI=$ORDER(^RADPT("AO",RAOIEN,RADFN,RADTI,""))
+43 SET $PIECE(ORDER,"^",7)=RADTI
+44 SET $PIECE(ORDER,"^",8)=RACNI
+45 SET MAGTMPEXAM=$NAME(^TMP($TEXT(+0),$JOB,"EXAM"))
+46 SET IENS=RACNI_","_RADTI_","_RADFN_","
+47 SET EXAMDATA=$NAME(@MAGTMPEXAM@(70.03,IENS))
+48 ; requires RA*5.0*47
IF $TEXT(ACCFIND^RAAPI)'=""
SET FIELDS=".01;31;3;"
+49 ; no accession number field (#31)
IF '$TEST
SET FIELDS=".01;3;"
+50 KILL @MAGTMPEXAM,MAGMSG
+51 ; ICR 1172
DO GETS^DIQ(70.03,IENS,FIELDS,"EI",MAGTMPEXAM,"MAGMSG")
+52 ; fatal FileMan error
IF $DATA(MAGMSG)
DO ORDERERR(.ARRAY,.MAGMSG,-3)
SET ERROR=-3
QUIT
+53 SET EXAMSTAT=$GET(@EXAMDATA@(3,"E"))
+54 ; do not include cancelled exam
IF EXAMSTAT="CANCELLED"
SET SKIP=1
QUIT
+55 ; ICR 1172
SET EXAMDATE=$$GET1^DIQ(70.02,(RADTI_","_RADFN),.01,"I")
+56 SET ACNUMB=$GET(@EXAMDATA@(31,"E"))
+57 IF ACNUMB=""
Begin DoDot:3
+58 SET CASENUMB=@EXAMDATA@(.01,"E")
+59 SET ACNUMB=$EXTRACT(EXAMDATE,4,7)_$EXTRACT(EXAMDATE,2,3)_"-"_CASENUMB
+60 QUIT
End DoDot:3
+61 SET $PIECE(ORDER,"^",9)=ACNUMB
SET $PIECE(ORDER,"^",10)=EXAMDATE
+62 ; ICR 1172
SET IMAGLOCN=$$GET1^DIQ(70.02,(RADTI_","_RADFN),4)
+63 SET $PIECE(ORDER,"^",11)=IMAGLOCN
+64 QUIT
End DoDot:2
+65 ;
+66 ; FileMan error encountered in exam lookup
IF ERROR
QUIT
+67 ; do not include this record
IF SKIP
QUIT
+68 ;
+69 ; get procedure modifier(s)
+70 SET MAGTMPMOD=$NAME(^TMP($TEXT(+0),$JOB,"MODIFIER"))
SET MODDATA=$NAME(@MAGTMPMOD@("DILIST"))
+71 KILL @MAGTMPMOD,MAGMSG
+72 ; ICR 3074
DO LIST^DIC(75.1125,","_RAOIEN_",","@;.01;.01I;IX","",,,,,,,MAGTMPMOD,"MAGMSG")
+73 ; fatal FileMan error
IF $DATA(MAGMSG)
DO ORDERERR(.ARRAY,.MAGMSG,-4)
QUIT
+74 SET MODCOUNT=+@MODDATA@(0)
+75 SET MODIFIER=""
+76 FOR I=1:1:MODCOUNT
Begin DoDot:2
+77 if $LENGTH(MODIFIER)
SET MODIFIER=MODIFIER_"~"
+78 SET MODIEN=@MODDATA@(2,I)
+79 SET MODIFIER=MODIFIER_@MODDATA@("ID",MODIEN,.01,"E")_"|"_^("I")
+80 QUIT
End DoDot:2
+81 SET $PIECE(ORDER,"^",3)=MODIFIER
+82 ;
+83 SET ARRAY(1)=ARRAY(1)+1
SET ARRAY(ARRAY(1)+1)=ORDER
+84 QUIT
End DoDot:1
+85 ; cleanup
if $DATA(MAGTMPEXAM)
KILL @MAGTMPEXAM
if $DATA(MAGTMPMOD)
KILL @MAGTMPMOD
+86 QUIT
+87 ;
ORDERERR(ARRAY,MSG,ERRNUMB) ; handle FileMan errors in ORDER subroutine
+1 NEW I,NODE
+2 KILL ARRAY
+3 SET I=1
SET NODE="MSG"
+4 FOR
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
Begin DoDot:1
+5 SET I=I+1
SET ARRAY(I)=NODE
+6 IF $DATA(@NODE)
SET ARRAY(I)=ARRAY(I)_"="_@NODE
+7 QUIT
End DoDot:1
+8 SET ARRAY(1)="-100,Fatal FileMan error #"_ERRNUMB
+9 QUIT
+10 ;
IMAGELOC(RESULT,RAOIEN,RAMLC) ; RPC = MAG DICOM SET IMAGING LOCATION
+1 NEW DIERR,MAGFDA,MAGMSG
+2 ;
+3 KILL RESULT
+4 SET RAOIEN=$GET(RAOIEN)
+5 IF (RAOIEN'>0)!(RAOIEN'=+RAOIEN)
Begin DoDot:1
+6 SET RESULT="-1,Invalid or missing Radiology Order pointer: """_RAOIEN_"""."
+7 QUIT
End DoDot:1
QUIT
+8 ;
+9 SET RAMLC=$GET(RAMLC)
+10 IF (RAMLC'>0)!(RAMLC'=+RAMLC)
Begin DoDot:1
+11 SET RESULT="-2,Invalid or missing Radiology Image Location identifier: """_RAMLC_"""."
+12 QUIT
End DoDot:1
QUIT
+13 ;
+14 ; ICR 3074
IF $$GET1^DIQ(75.1,RAOIEN,.01)=""
Begin DoDot:1
+15 SET RESULT="-3,Missing Radiology Order for pointer: """_RAOIEN_"""."
+16 QUIT
End DoDot:1
QUIT
+17 ;
+18 ; ICR 5357
IF $$GET1^DIQ(79.1,RAMLC,.01)=""
Begin DoDot:1
+19 SET RESULT="-4,Missing Radiology Image Location for pointer: """_RAMLC_"""."
+20 QUIT
End DoDot:1
QUIT
+21 ;
+22 ; ICR 3074
IF $$GET1^DIQ(75.1,RAOIEN,20)=""
Begin DoDot:1
+23 ; IMAGING LOCATION
SET MAGFDA(75.1,RAOIEN_",",20)=RAMLC
+24 ; ICR 3074
DO FILE^DIE("","MAGFDA","MAGMSG")
+25 IF $DATA(MAGMSG)
SET RESULT="-5,Error setting Radiology Image Location"
QUIT
+26 SET RESULT="1,Radiology Image Location set for pointer: """_RAOIEN_"""."
+27 QUIT
End DoDot:1
QUIT
+28 IF '$TEST
Begin DoDot:1
+29 SET RESULT="2,Radiology Image Location already set for pointer: """_RAOIEN_""", operation ignored."
+30 QUIT
End DoDot:1
+31 QUIT
+32 ;
ADDROOM(RETURN,RAEXAM) ; RPC = MAG DICOM ADD CAMERA EQUIP RM
+1 NEW HIT,I,IENS,LOCNAME,OUTSIDESTUDY,MAGFDA,MAGMSG,RADIMGLOC,ROOMS
+2 KILL RETURN
+3 ;
+4 IF $LENGTH($GET(RAEXAM),"^")<2
SET RETURN(0)="-1,Invalid or missing Radiology Exam pointer: """_RAEXAM_"""."
QUIT
+5 ;
+6 ; get the Radiology IMAGING LOCATION
+7 SET IENS=$PIECE(RAEXAM,"^",2)_","_$PIECE(RAEXAM,"^",1)_","
+8 ; ICR 1172
SET RADIMGLOC=$$GET1^DIQ(70.02,IENS,4,"I")
+9 IF 'RADIMGLOC
SET RETURN(0)="-2,Invalid or missing Radiology IMAGING LOCATION for Exam pointer: """_RAEXAM_"""."
QUIT
+10 SET LOCNAME=$$GET1^DIQ(79.1,RADIMGLOC,.01)
+11 ;
+12 ; check if the IMAGING LOCATION has the OUTSIDE STUDY Camera/Equipment/Room
+13 ; designated name
SET OUTSIDESTUDY="OUTSIDE STUDY"
+14 DO LIST^DIC(79.12,","_RADIMGLOC_",","@;.01","",,,,,,,"ROOMS","MAGMSG")
+15 ; fatal FileMan error
IF $DATA(MAGMSG)
DO ORDERERR(.RETURN,.MAGMSG,-3)
QUIT
+16 SET HIT=0
FOR I=1:1:ROOMS("DILIST",0)
Begin DoDot:1
+17 IF ROOMS("DILIST","ID",I,".01")=OUTSIDESTUDY
SET HIT=1
+18 QUIT
End DoDot:1
if HIT
QUIT
+19 IF HIT
SET RETURN(0)="2,"_OUTSIDESTUDY_" is already defined for """_LOCNAME_"""."
QUIT
+20 ;
+21 ; add the OUTSIDE STUDY Camera/Equipment/Room to the IMAGING LOCATION
+22 SET MAGFDA(79.12,"+1,"_RADIMGLOC_",",.01)=OUTSIDESTUDY
+23 ; ICR 5357
DO UPDATE^DIE("E","MAGFDA","MAGIENS","MAGMSG")
+24 ; fatal FileMan error
IF $DATA(MAGMSG)
DO ORDERERR(.RETURN,.MAGMSG,-4)
QUIT
+25 SET RETURN(0)="1,"_OUTSIDESTUDY_" has been added for """_LOCNAME_"""."
+26 QUIT
+27 ;
+28 ;+++ FileMan Screen code for the RAD TECHNOLOGIST field (#300) of the
+29 ; IMAGING SITE PARAMETERS file (#2006.1).
+30 ;
+31 ; The direct "ARC" cross-reference read is supported by IA #3544.
+32 ;
YNRADIST(DUZ,RADCLASS) ;
+1 ;
+2 NEW YN
SET YN=0
+3 NEW X
FOR X=1:1:$LENGTH(RADCLASS)
IF $DATA(^VA(200,"ARC",$EXTRACT(RADCLASS,X),DUZ))
SET YN=1
QUIT
+4 QUIT YN
+5 ;
+6 ; MAGVIM07
