MAGVIM06 ;WOIFO/DAC/MAT/NST/BT - Utilities for RPC calls for DICOM file processing ; 23 Oct 2012 10:30 AM
;;3.0;IMAGING;**118,138**;Mar 19, 2002;Build 5380;Sep 03, 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
;
;+++ The first tag is carryover code from MAGVIM01, and is called from
; several points in that routine.
;
VALIDATE(FDA,ERR) ; Validate data - delete invalid data - report warnings
N FILE,IENS,FNUM,VALID,VALUE
S FILE=""
F S FILE=$O(FDA(FILE)) Q:($G(ERR)'="")!(FILE="") D
. S IENS=""
. F S IENS=$O(FDA(FILE,IENS)) Q:($G(ERR)'="")!(IENS="") D
. . S FNUM=""
. . F S FNUM=$O(FDA(FILE,IENS,FNUM)) Q:($G(ERR)'="")!(FNUM="") D
. . . S VALUE=FDA(FILE,IENS,FNUM)
. . . ; Check if data is valid for file and field number provided
. . . D CHK^DIE(FILE,FNUM,"E",VALUE,.VALID)
. . . I VALID="^" D
. . . . K FDA(FILE,IENS,FNUM)
. . . . I $G(ERR)="" S ERR="Invalid data:"_VALUE_" Field: #"_FILE_","_FNUM
. . . . Q
. . . Q
. . Q
. Q
Q
; RPC: MAGV CONFIRM RAD ORDER
;
; Inputs
; ======
;
; OUT Target array to hold output.
; UIDS `(1) Study Instance UID
; (2) Series Instance UID
; (3) SOP Instance UID
;
; Output
; ======
;
; S OUT="1011|PATIENT,ONEZEROONEONE|000-00-1011|19450610|M|1006170647V052871|121798-29|19981217|"
; S OUT=OUT_"|CT HEAD W/O CONT|"
;
; (0)
; `(01) 0 or <0 if error
; (02) line count or Error message
; (1)
; |(01) Patient IEN in RAD/NUC MED PATIENT file (#70)
; (02) Patient Name
; (03) Patient SSN (?3N1"-"2N1"-"4N)
; (04) Patient DOB (YYYYMMDD)
; (05) Patient Sex
; (06) Patient ICN
; (07) Accession Number
; (08) Study Date
; (09) Procedure
; (10) Procedure Modifiers
; ~(1..n)
; (11) Order IEN of RAD/NUC MED ORDERS file (#75.1)
; (12) Order Date
; (13) Order Location
; (14) Exam Status
; (15) Order Reason
;
; Notes
; =====
;
; Output type is ARRAY only to support interface conventions. The RPC
; output is at most one line of patient-study data.
;
CONFIRM(OUT,UIDS) ;
;
;--- Initialize.
N IENSTUDY
K MAGV,UID
N SSEP S SSEP=$$STATSEP^MAGVIM01
N ISEP S ISEP=$$INPUTSEP^MAGVIM01
N OSEP S OSEP=$$OUTSEP^MAGVIM01
;--- Validate input.
I '$D(UIDS) S OUT(0)=-6_SSEP_"No UIDs provided" Q
S UID("STUDY")=$P(UIDS,ISEP,1)
I $G(UID("STUDY"))="" S OUT(0)=-1_SSEP_"No study UID provided" Q
S UID("SERIES")=$P(UIDS,ISEP,2)
I $G(UID("SERIES"))="" S OUT(0)=-2_SSEP_"No series UID provided" Q
S UID("SOP")=$P(UIDS,ISEP,3)
I $G(UID("SOP"))="" S OUT(0)=-3_SSEP_"No SOP UID provided" Q
;--- Process an object in legacy structure (<MAG*3.0*34).
I $D(^MAG(2005,"P",UID("SOP"))) D
. ;--- Lookup by IMAGE file (#2005) IEN. Quit if error.
. N MAGIEN S MAGIEN=$O(^MAG(2005,"P",UID("SOP"),""))
. I MAGIEN="" S OUT(0)=-1_SSEP_"Null IMAGE file IEN." Q
. D LOOKUP^MAGDRPCA(.RETURN,MAGIEN)
. I +RETURN<0 S OUT(0)=-1_SSEP_$P(RETURN,",",2) Q
. ;--- Shift to compensate for first piece reserved for error flag.
. S OUT=$P(RETURN,U,2,999) K RETURN
. ;
. N ACN S ACN=$P(OUT,U,7)
. I ACN="" S OUT(0)=-1_SSEP_"Null Accession Number." Q
. I $$GMRCIEN^MAGDFCNV(ACN) D PATHCON,PATHOUT Q ; Process through CONsult pathway.
. ;
. ;
. D PATHRAD,PATHOUT
. Q
;--- Process an object in new structure (>=MAG*3.0*34).
E D
. ;
. ;--- Lookup via IMAGE STUDY file (#2005.62) entry.
. I '$P($G(^MAGV(2005.62,0)),U,4) D Q
. . S OUT(0)=0_SSEP_"No data in IMAGE STUDY file." Q
. I '$D(^MAGV(2005.62,"B",UID("STUDY"))) D Q
. . S OUT(0)=-1_SSEP_"Study Instance UID not found in IMAGE STUDY file."
. S IENSTUDY=$O(^MAGV(2005.62,"B",UID("STUDY"),""))
. ;
. ;--- Get IMAGING PATIENT REFERENCE file (#2005.62) pointer.
. N IENPTREF S IENPTREF=$$GET1^DIQ(2005.62,IENSTUDY,13,"I")
. N IENPCREF S IENPCREF=$$GET1^DIQ(2005.62,IENSTUDY,11,"I") ; IMAGING PROCEDURE REFERENCE
. N STUDYDTM S STUDYDTM=$$GET1^DIQ(2005.62,IENSTUDY,4)
. N ENTPATID S ENTPATID=$$GET1^DIQ(2005.6,IENPTREF,.01)
. N ENTIDTYP S ENTIDTYP=$$GET1^DIQ(2005.6,IENPTREF,.03)
. N PROCEDUR S PROCEDUR=$$GET1^DIQ(2005.61,IENPCREF,43)
. ;D
. ;. I ENTIDTYPE="D" Q ; A DFN: Query PATIENT file (#2).
. ;. I ENTIDTYPE="I" Q ; An ICN: Lookup DFN and goto ("D").
. ;. I ENTIDTYPE="M" Q ; An MRN: ???
. ;
. ;--- Procedure ID TYPE ('RAD', 'CON', 'LAB')
. N IDPROC S IDPROC=$$GET1^DIQ(2005.61,IENPCREF,.03,"I")
. ;
. ;--- Get ACCESSION NUMBER.
. N ACN S ACN=$$GET1^DIQ(2005.61,IENPCREF,.01)
. I ACN="" S OUT(0)=-1_SSEP_"Null Accession Number." Q
. S RETURN=$$LOOKUP1(ENTPATID)
. I +RETURN<0 S OUT(0)=-1_SSEP_$P(RETURN,",",2) Q
. ;
. S OUT=$P(RETURN,U,2,999) K RETURN
. S $P(OUT,U,7)=ACN
. S $P(OUT,U,8)=STUDYDTM
. S $P(OUT,U,9)=PROCEDUR
. ;
. ;--- Pathway for PROCEDURE ??? TYPE="RAD"
. D:IDPROC="RAD" PATHRAD
. ;--- Pathway for PROCEDURE ID TYPE="CON"
. D:IDPROC="CON" PATHCON
. ;--- Pathway for PROCEDURE TYPE="LAB" (Future Use)
. S:IDPROC="LAB" OUT(0)=-1_SSEP_"Procedure Type 'LAB' Currently Unsupported."
. ;--- Quit if subroutine returns error output.
. Q:+$G(OUT(0))<0
. D PATHOUT
. Q
;
K MAGV,UID
Q
;--- Get RAD/NUC MED ORDERS Procedure Modifiers (adapted from MAGDRPCB).
PROCMODS(MAGRAOIEN) ;
N MAGMSG,MAGTMPMOD,MAGVMOD,MODDATA
S MAGTMPMOD=$NA(MAGVMOD(0)),MODDATA=$NA(@MAGTMPMOD@("DILIST"))
K @MAGTMPMOD
N MODIFIERS S MODIFIERS=""
;--- Get modifiers via FileMan list. IA #3074
D LIST^DIC(75.1125,","_MAGRAOIEN_",","@;.01;.01I;IX","",,,,,,,MAGTMPMOD,"MAGMSG")
I $D(MAGMSG) D
. S MODIFIERS="Unavailable" ; fatal FileMan error
E D
. N I,MODCOUNT S MODCOUNT=+@MODDATA@(0)
. F I=1:1:MODCOUNT D
. . N MODIEN S MODIEN=@MODDATA@(2,I)
. . N THIS S THIS=@MODDATA@("ID",MODIEN,.01,"E") ;_"|"_@MODDATA@("ID",MODIEN,.01,"I")
. . I $L(MODIFIERS) S MODIFIERS=MODIFIERS_"~"_THIS Q
. . S MODIFIERS=THIS
. . Q
. Q
K:$D(MAGTMPMOD) @MAGTMPMOD ; cleanup
Q MODIFIERS
;
;--- Patient Demographic Lookup (Adapted from MAGDRPCA).
;
LOOKUP1(PATDFN) ; patient and accession number lookup
N DFN,I,NUMBER,OUT,TMP,VA,VADM,X
S DFN=PATDFN
D ; Protect variables that are referenced by the DEM^VADPT
. N A,I,J,K,K1,NC,NF,NQ,T,VAHOW,VAPTYP,VAROOT,X
. D DEM^VADPT ; Supported IA (#10061)
. Q
S X="^"_DFN ; piece 1 is for an error message
S X=X_"^"_VADM(1) ; patient name
S X=X_"^"_VA("PID") ; patient id (ssn)
S TMP=$S(VADM(3)>0:17000000+VADM(3),1:"-1,Invalid date of birth")
S X=X_"^"_TMP ; Patient DOB
S X=X_"^"_$P(VADM(5),"^",1) ; patient sex
; $$GETICN^MPIF001 can return error code and message separated
; by "^". If this happens, the "^" is replaced by comma.
S TMP=$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI") ; Supported IA (#2701)
S X=X_"^"_$TR(TMP,"^",",") ; ICN
Q X
;
PATHCON ;--- Next 6 lines adapted from MAGDRPCA.
N GMRCIEN,MODIFIER,PROCNAME,STUDYDAT,TMP
S GMRCIEN=$$GMRCIEN^MAGDFCNV(ACN)
S TMP=$$GET1^DIQ(123,GMRCIEN,.01,"I")\1
S STUDYDAT=$S(TMP>0:17000000+TMP,1:"-1,Invalid study date")
S PROCNAME=$$GET1^DIQ(123,GMRCIEN,1) ; TO SERVICE
S MODIFIER=$$GET1^DIQ(123,GMRCIEN,4) ; PROCEDURE
S MAGV("OERRIEN")=$$GET1^DIQ(123,GMRCIEN,.03)
S MAGV("PATLCN")=$$GET1^DIQ(123,GMRCIEN,.04)
S MAGV("CPRSSTAT")=$$GET1^DIQ(123,GMRCIEN,8)
;
;--- Assemble remaining output.
S $P(OUT,U,9)=PROCNAME
S $P(OUT,U,10)=MODIFIER
S $P(OUT,U,11)=MAGV("OERRIEN")
S $P(OUT,U,12)=STUDYDAT
S $P(OUT,U,13)=MAGV("PATLCN")
S $P(OUT,U,14)=MAGV("CPRSSTAT")
N STUDYRSN S STUDYRSN=$$GET1^DIQ(123.01,"1,"_GMRCIEN_",",.01) ;Reason for study
S $P(OUT,U,15)=STUDYRSN
Q
PATHOUT ;--- Translate output separator.
S OUT(0)=0_SSEP_1
S OUT(1)=$TR(OUT,U,OSEP)
Q
PATHRAD ;--- Assemble remaining RAD output.
;--- Get RAD/NUC MED ORDER file (#75.1) IEN from RAD/NUC MED PATIENT file (#70).
D ACNUMB^MAGDRPCA(.RETURN,ACN)
I +RETURN<0 S OUT(0)=-1_SSEP_$P(RETURN,U,2) Q
;
;--- Set RAD/NUC MED PATIENT var's.
N RACNI,RADFN,RADPT
S RACNI=$P(RETURN,U,1),RADPT=$P(RETURN,U,2),RADFN=$P(RETURN,U,3)
;--- Set RAD/NUC MED ORDER var's.
S MAGV("RAOIEN")=$$GET1^DIQ(70.03,RACNI_","_RADFN_","_RADPT_",",11,"I",,"MAGERR")
S MAGV("RAODAT")=$$GET1^DIQ(75.1,MAGV("RAOIEN"),16)
S MAGV("RAOLCN")=$$GET1^DIQ(75.1,MAGV("RAOIEN"),22)
S MAGV("RAORSN")=$$GET1^DIQ(75.1,MAGV("RAOIEN"),1.1)
;--- Set Exam Status.
N EXSTP
S EXSTP=$$GET1^DIQ(70.03,RACNI_","_RADFN_","_RADPT_",",3,"I",,"MAGERR")
S MAGV("EXAMSTAT")=$$GET1^DIQ(72,EXSTP,.01)
;
S $P(OUT,U,10)=$$PROCMODS(MAGV("RAOIEN"))
S $P(OUT,U,11)=MAGV("RAOIEN")
S $P(OUT,U,12)=MAGV("RAODAT")
S $P(OUT,U,13)=MAGV("RAOLCN")
S $P(OUT,U,14)=MAGV("EXAMSTAT")
S $P(OUT,U,15)=MAGV("RAORSN")
Q
;
; MAGVIM06
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM06 9766 printed Dec 13, 2024@02:09:53 Page 2
MAGVIM06 ;WOIFO/DAC/MAT/NST/BT - Utilities for RPC calls for DICOM file processing ; 23 Oct 2012 10:30 AM
+1 ;;3.0;IMAGING;**118,138**;Mar 19, 2002;Build 5380;Sep 03, 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 ;+++ The first tag is carryover code from MAGVIM01, and is called from
+20 ; several points in that routine.
+21 ;
VALIDATE(FDA,ERR) ; Validate data - delete invalid data - report warnings
+1 NEW FILE,IENS,FNUM,VALID,VALUE
+2 SET FILE=""
+3 FOR
SET FILE=$ORDER(FDA(FILE))
if ($GET(ERR)'="")!(FILE="")
QUIT
Begin DoDot:1
+4 SET IENS=""
+5 FOR
SET IENS=$ORDER(FDA(FILE,IENS))
if ($GET(ERR)'="")!(IENS="")
QUIT
Begin DoDot:2
+6 SET FNUM=""
+7 FOR
SET FNUM=$ORDER(FDA(FILE,IENS,FNUM))
if ($GET(ERR)'="")!(FNUM="")
QUIT
Begin DoDot:3
+8 SET VALUE=FDA(FILE,IENS,FNUM)
+9 ; Check if data is valid for file and field number provided
+10 DO CHK^DIE(FILE,FNUM,"E",VALUE,.VALID)
+11 IF VALID="^"
Begin DoDot:4
+12 KILL FDA(FILE,IENS,FNUM)
+13 IF $GET(ERR)=""
SET ERR="Invalid data:"_VALUE_" Field: #"_FILE_","_FNUM
+14 QUIT
End DoDot:4
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT
+19 ; RPC: MAGV CONFIRM RAD ORDER
+20 ;
+21 ; Inputs
+22 ; ======
+23 ;
+24 ; OUT Target array to hold output.
+25 ; UIDS `(1) Study Instance UID
+26 ; (2) Series Instance UID
+27 ; (3) SOP Instance UID
+28 ;
+29 ; Output
+30 ; ======
+31 ;
+32 ; S OUT="1011|PATIENT,ONEZEROONEONE|000-00-1011|19450610|M|1006170647V052871|121798-29|19981217|"
+33 ; S OUT=OUT_"|CT HEAD W/O CONT|"
+34 ;
+35 ; (0)
+36 ; `(01) 0 or <0 if error
+37 ; (02) line count or Error message
+38 ; (1)
+39 ; |(01) Patient IEN in RAD/NUC MED PATIENT file (#70)
+40 ; (02) Patient Name
+41 ; (03) Patient SSN (?3N1"-"2N1"-"4N)
+42 ; (04) Patient DOB (YYYYMMDD)
+43 ; (05) Patient Sex
+44 ; (06) Patient ICN
+45 ; (07) Accession Number
+46 ; (08) Study Date
+47 ; (09) Procedure
+48 ; (10) Procedure Modifiers
+49 ; ~(1..n)
+50 ; (11) Order IEN of RAD/NUC MED ORDERS file (#75.1)
+51 ; (12) Order Date
+52 ; (13) Order Location
+53 ; (14) Exam Status
+54 ; (15) Order Reason
+55 ;
+56 ; Notes
+57 ; =====
+58 ;
+59 ; Output type is ARRAY only to support interface conventions. The RPC
+60 ; output is at most one line of patient-study data.
+61 ;
CONFIRM(OUT,UIDS) ;
+1 ;
+2 ;--- Initialize.
+3 NEW IENSTUDY
+4 KILL MAGV,UID
+5 NEW SSEP
SET SSEP=$$STATSEP^MAGVIM01
+6 NEW ISEP
SET ISEP=$$INPUTSEP^MAGVIM01
+7 NEW OSEP
SET OSEP=$$OUTSEP^MAGVIM01
+8 ;--- Validate input.
+9 IF '$DATA(UIDS)
SET OUT(0)=-6_SSEP_"No UIDs provided"
QUIT
+10 SET UID("STUDY")=$PIECE(UIDS,ISEP,1)
+11 IF $GET(UID("STUDY"))=""
SET OUT(0)=-1_SSEP_"No study UID provided"
QUIT
+12 SET UID("SERIES")=$PIECE(UIDS,ISEP,2)
+13 IF $GET(UID("SERIES"))=""
SET OUT(0)=-2_SSEP_"No series UID provided"
QUIT
+14 SET UID("SOP")=$PIECE(UIDS,ISEP,3)
+15 IF $GET(UID("SOP"))=""
SET OUT(0)=-3_SSEP_"No SOP UID provided"
QUIT
+16 ;--- Process an object in legacy structure (<MAG*3.0*34).
+17 IF $DATA(^MAG(2005,"P",UID("SOP")))
Begin DoDot:1
+18 ;--- Lookup by IMAGE file (#2005) IEN. Quit if error.
+19 NEW MAGIEN
SET MAGIEN=$ORDER(^MAG(2005,"P",UID("SOP"),""))
+20 IF MAGIEN=""
SET OUT(0)=-1_SSEP_"Null IMAGE file IEN."
QUIT
+21 DO LOOKUP^MAGDRPCA(.RETURN,MAGIEN)
+22 IF +RETURN<0
SET OUT(0)=-1_SSEP_$PIECE(RETURN,",",2)
QUIT
+23 ;--- Shift to compensate for first piece reserved for error flag.
+24 SET OUT=$PIECE(RETURN,U,2,999)
KILL RETURN
+25 ;
+26 NEW ACN
SET ACN=$PIECE(OUT,U,7)
+27 IF ACN=""
SET OUT(0)=-1_SSEP_"Null Accession Number."
QUIT
+28 ; Process through CONsult pathway.
IF $$GMRCIEN^MAGDFCNV(ACN)
DO PATHCON
DO PATHOUT
QUIT
+29 ;
+30 ;
+31 DO PATHRAD
DO PATHOUT
+32 QUIT
End DoDot:1
+33 ;--- Process an object in new structure (>=MAG*3.0*34).
+34 IF '$TEST
Begin DoDot:1
+35 ;
+36 ;--- Lookup via IMAGE STUDY file (#2005.62) entry.
+37 IF '$PIECE($GET(^MAGV(2005.62,0)),U,4)
Begin DoDot:2
+38 SET OUT(0)=0_SSEP_"No data in IMAGE STUDY file."
QUIT
End DoDot:2
QUIT
+39 IF '$DATA(^MAGV(2005.62,"B",UID("STUDY")))
Begin DoDot:2
+40 SET OUT(0)=-1_SSEP_"Study Instance UID not found in IMAGE STUDY file."
End DoDot:2
QUIT
+41 SET IENSTUDY=$ORDER(^MAGV(2005.62,"B",UID("STUDY"),""))
+42 ;
+43 ;--- Get IMAGING PATIENT REFERENCE file (#2005.62) pointer.
+44 NEW IENPTREF
SET IENPTREF=$$GET1^DIQ(2005.62,IENSTUDY,13,"I")
+45 ; IMAGING PROCEDURE REFERENCE
NEW IENPCREF
SET IENPCREF=$$GET1^DIQ(2005.62,IENSTUDY,11,"I")
+46 NEW STUDYDTM
SET STUDYDTM=$$GET1^DIQ(2005.62,IENSTUDY,4)
+47 NEW ENTPATID
SET ENTPATID=$$GET1^DIQ(2005.6,IENPTREF,.01)
+48 NEW ENTIDTYP
SET ENTIDTYP=$$GET1^DIQ(2005.6,IENPTREF,.03)
+49 NEW PROCEDUR
SET PROCEDUR=$$GET1^DIQ(2005.61,IENPCREF,43)
+50 ;D
+51 ;. I ENTIDTYPE="D" Q ; A DFN: Query PATIENT file (#2).
+52 ;. I ENTIDTYPE="I" Q ; An ICN: Lookup DFN and goto ("D").
+53 ;. I ENTIDTYPE="M" Q ; An MRN: ???
+54 ;
+55 ;--- Procedure ID TYPE ('RAD', 'CON', 'LAB')
+56 NEW IDPROC
SET IDPROC=$$GET1^DIQ(2005.61,IENPCREF,.03,"I")
+57 ;
+58 ;--- Get ACCESSION NUMBER.
+59 NEW ACN
SET ACN=$$GET1^DIQ(2005.61,IENPCREF,.01)
+60 IF ACN=""
SET OUT(0)=-1_SSEP_"Null Accession Number."
QUIT
+61 SET RETURN=$$LOOKUP1(ENTPATID)
+62 IF +RETURN<0
SET OUT(0)=-1_SSEP_$PIECE(RETURN,",",2)
QUIT
+63 ;
+64 SET OUT=$PIECE(RETURN,U,2,999)
KILL RETURN
+65 SET $PIECE(OUT,U,7)=ACN
+66 SET $PIECE(OUT,U,8)=STUDYDTM
+67 SET $PIECE(OUT,U,9)=PROCEDUR
+68 ;
+69 ;--- Pathway for PROCEDURE ??? TYPE="RAD"
+70 if IDPROC="RAD"
DO PATHRAD
+71 ;--- Pathway for PROCEDURE ID TYPE="CON"
+72 if IDPROC="CON"
DO PATHCON
+73 ;--- Pathway for PROCEDURE TYPE="LAB" (Future Use)
+74 if IDPROC="LAB"
SET OUT(0)=-1_SSEP_"Procedure Type 'LAB' Currently Unsupported."
+75 ;--- Quit if subroutine returns error output.
+76 if +$GET(OUT(0))<0
QUIT
+77 DO PATHOUT
+78 QUIT
End DoDot:1
+79 ;
+80 KILL MAGV,UID
+81 QUIT
+82 ;--- Get RAD/NUC MED ORDERS Procedure Modifiers (adapted from MAGDRPCB).
PROCMODS(MAGRAOIEN) ;
+1 NEW MAGMSG,MAGTMPMOD,MAGVMOD,MODDATA
+2 SET MAGTMPMOD=$NAME(MAGVMOD(0))
SET MODDATA=$NAME(@MAGTMPMOD@("DILIST"))
+3 KILL @MAGTMPMOD
+4 NEW MODIFIERS
SET MODIFIERS=""
+5 ;--- Get modifiers via FileMan list. IA #3074
+6 DO LIST^DIC(75.1125,","_MAGRAOIEN_",","@;.01;.01I;IX","",,,,,,,MAGTMPMOD,"MAGMSG")
+7 IF $DATA(MAGMSG)
Begin DoDot:1
+8 ; fatal FileMan error
SET MODIFIERS="Unavailable"
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 NEW I,MODCOUNT
SET MODCOUNT=+@MODDATA@(0)
+11 FOR I=1:1:MODCOUNT
Begin DoDot:2
+12 NEW MODIEN
SET MODIEN=@MODDATA@(2,I)
+13 ;_"|"_@MODDATA@("ID",MODIEN,.01,"I")
NEW THIS
SET THIS=@MODDATA@("ID",MODIEN,.01,"E")
+14 IF $LENGTH(MODIFIERS)
SET MODIFIERS=MODIFIERS_"~"_THIS
QUIT
+15 SET MODIFIERS=THIS
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 ; cleanup
if $DATA(MAGTMPMOD)
KILL @MAGTMPMOD
+19 QUIT MODIFIERS
+20 ;
+21 ;--- Patient Demographic Lookup (Adapted from MAGDRPCA).
+22 ;
LOOKUP1(PATDFN) ; patient and accession number lookup
+1 NEW DFN,I,NUMBER,OUT,TMP,VA,VADM,X
+2 SET DFN=PATDFN
+3 ; Protect variables that are referenced by the DEM^VADPT
Begin DoDot:1
+4 NEW A,I,J,K,K1,NC,NF,NQ,T,VAHOW,VAPTYP,VAROOT,X
+5 ; Supported IA (#10061)
DO DEM^VADPT
+6 QUIT
End DoDot:1
+7 ; piece 1 is for an error message
SET X="^"_DFN
+8 ; patient name
SET X=X_"^"_VADM(1)
+9 ; patient id (ssn)
SET X=X_"^"_VA("PID")
+10 SET TMP=$SELECT(VADM(3)>0:17000000+VADM(3),1:"-1,Invalid date of birth")
+11 ; Patient DOB
SET X=X_"^"_TMP
+12 ; patient sex
SET X=X_"^"_$PIECE(VADM(5),"^",1)
+13 ; $$GETICN^MPIF001 can return error code and message separated
+14 ; by "^". If this happens, the "^" is replaced by comma.
+15 ; Supported IA (#2701)
SET TMP=$SELECT($TEXT(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI")
+16 ; ICN
SET X=X_"^"_$TRANSLATE(TMP,"^",",")
+17 QUIT X
+18 ;
PATHCON ;--- Next 6 lines adapted from MAGDRPCA.
+1 NEW GMRCIEN,MODIFIER,PROCNAME,STUDYDAT,TMP
+2 SET GMRCIEN=$$GMRCIEN^MAGDFCNV(ACN)
+3 SET TMP=$$GET1^DIQ(123,GMRCIEN,.01,"I")\1
+4 SET STUDYDAT=$SELECT(TMP>0:17000000+TMP,1:"-1,Invalid study date")
+5 ; TO SERVICE
SET PROCNAME=$$GET1^DIQ(123,GMRCIEN,1)
+6 ; PROCEDURE
SET MODIFIER=$$GET1^DIQ(123,GMRCIEN,4)
+7 SET MAGV("OERRIEN")=$$GET1^DIQ(123,GMRCIEN,.03)
+8 SET MAGV("PATLCN")=$$GET1^DIQ(123,GMRCIEN,.04)
+9 SET MAGV("CPRSSTAT")=$$GET1^DIQ(123,GMRCIEN,8)
+10 ;
+11 ;--- Assemble remaining output.
+12 SET $PIECE(OUT,U,9)=PROCNAME
+13 SET $PIECE(OUT,U,10)=MODIFIER
+14 SET $PIECE(OUT,U,11)=MAGV("OERRIEN")
+15 SET $PIECE(OUT,U,12)=STUDYDAT
+16 SET $PIECE(OUT,U,13)=MAGV("PATLCN")
+17 SET $PIECE(OUT,U,14)=MAGV("CPRSSTAT")
+18 ;Reason for study
NEW STUDYRSN
SET STUDYRSN=$$GET1^DIQ(123.01,"1,"_GMRCIEN_",",.01)
+19 SET $PIECE(OUT,U,15)=STUDYRSN
+20 QUIT
PATHOUT ;--- Translate output separator.
+1 SET OUT(0)=0_SSEP_1
+2 SET OUT(1)=$TRANSLATE(OUT,U,OSEP)
+3 QUIT
PATHRAD ;--- Assemble remaining RAD output.
+1 ;--- Get RAD/NUC MED ORDER file (#75.1) IEN from RAD/NUC MED PATIENT file (#70).
+2 DO ACNUMB^MAGDRPCA(.RETURN,ACN)
+3 IF +RETURN<0
SET OUT(0)=-1_SSEP_$PIECE(RETURN,U,2)
QUIT
+4 ;
+5 ;--- Set RAD/NUC MED PATIENT var's.
+6 NEW RACNI,RADFN,RADPT
+7 SET RACNI=$PIECE(RETURN,U,1)
SET RADPT=$PIECE(RETURN,U,2)
SET RADFN=$PIECE(RETURN,U,3)
+8 ;--- Set RAD/NUC MED ORDER var's.
+9 SET MAGV("RAOIEN")=$$GET1^DIQ(70.03,RACNI_","_RADFN_","_RADPT_",",11,"I",,"MAGERR")
+10 SET MAGV("RAODAT")=$$GET1^DIQ(75.1,MAGV("RAOIEN"),16)
+11 SET MAGV("RAOLCN")=$$GET1^DIQ(75.1,MAGV("RAOIEN"),22)
+12 SET MAGV("RAORSN")=$$GET1^DIQ(75.1,MAGV("RAOIEN"),1.1)
+13 ;--- Set Exam Status.
+14 NEW EXSTP
+15 SET EXSTP=$$GET1^DIQ(70.03,RACNI_","_RADFN_","_RADPT_",",3,"I",,"MAGERR")
+16 SET MAGV("EXAMSTAT")=$$GET1^DIQ(72,EXSTP,.01)
+17 ;
+18 SET $PIECE(OUT,U,10)=$$PROCMODS(MAGV("RAOIEN"))
+19 SET $PIECE(OUT,U,11)=MAGV("RAOIEN")
+20 SET $PIECE(OUT,U,12)=MAGV("RAODAT")
+21 SET $PIECE(OUT,U,13)=MAGV("RAOLCN")
+22 SET $PIECE(OUT,U,14)=MAGV("EXAMSTAT")
+23 SET $PIECE(OUT,U,15)=MAGV("RAORSN")
+24 QUIT
+25 ;
+26 ; MAGVIM06
