MAGDIR81 ;WOIFO/PMK - Read a DICOM image file ; 03 Jul 2013 9:12 AM
;;3.0;IMAGING;**11,30,51,50,46,54,53,123,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. |
;; +---------------------------------------------------------------+
;;
; M2MB server
;
; This routine is invoked by the ^MAGDIR8 for the "STORE1/STORE2"
; REQUEST items when there is an image to be stored into the database.
; It adds it to the ^MAG global with appropriate pointers to the
; "parent data files".
;
ENTRY ; process one image
N MEDATA ;--- medicine pkg patient & study data (set in ^MAGDIR8A)
N FILEDATA ;- array of data to be passed between routines
N FIRSTDCM ;- patient first name from the image header (ie, PNAMEDCM)
N GMRCIEN ;-- internal entry number of consult/procedure request
N IMPORTER ;- flag set by a gateway that is running the IMPORTER app
N LASTDCM ;-- patient last name from the image header (ie, PNAMEDCM)
N LRDFN ;---- patient ien in LAB DATA file (#60)
N LRI ;------ inverse date for LAB DATA file (#60)
N LRSS ;----- lab section (CY, EM, or SP)
N MEDIA ;---- source of DICOM object for Importer (D=disk, T=transmission)
N MAGGP ;---- image's group pointer in ^MAG(2005)
N MAGIEN ;--- pointer to the entry for the image in ^MAG(2005)
N MIDCM ;---- patient middle initial from the image header (PNAMEDCM)
N OLDPATH ;-- original path for imported images (set by Importer)
N ORIGINDX ;- origin index (file 2005, field 45)
N PNAMEVAH ;- patient name from VADM(1)
N PROCDESC ;- procedure description (VA's name)
N RADATA ;--- radiology pkg patient & study data (set in ^MAGDIR8A)
N VADM ;----- array of demographic variables filled in by DEM^VADPT
N I,MAG0,MAG1,MAG2,QUIT,X
;
N ACNUMB,ARG2,CASENUMB,EMAIL,FROMPATH,IMAGEUID,IMAGNAME,IMAGNUMB,IMGSVC
N INSTLOC,INSTNAME,LASTIMG,LOCATION,MACHID,MFGR,MODALITY,MODEL,MODPARMS
N MULTFRAM,PID,PNAMEDCM,ROUTRULE,SERINUMB,SERIEUID,SOPCLASS,STAMP,STATUS
N STUDYDAT,STUDYTIM,STUDYDAT,STUDYTIM,STUDYUID,SYSTITLE
S STATUS=$P(ARGS,"|",1),LOCATION=$P(ARGS,"|",2)
S MACHID=$P(ARGS,"|",3),IMGSVC=$P(ARGS,"|",4)
S INSTNAME=$P(ARGS,"|",5),FROMPATH=$P(ARGS,"|",6)
S PID=$P(ARGS,"|",7),PNAMEDCM=$P(ARGS,"|",8)
S CASENUMB=$P(ARGS,"|",9),ACNUMB=$P(ARGS,"|",10)
S STUDYDAT=$P(ARGS,"|",11),STUDYTIM=$P(ARGS,"|",12)
S IMPORTER=$P(ARGS,"|",13),MODALITY=$P(ARGS,"|",14)
S IMAGNAME=$P(ARGS,"|",15),MODPARMS=$P(ARGS,"|",16)
S SERINUMB=$P(ARGS,"|",17),IMAGNUMB=$P(ARGS,"|",18)
S INSTLOC=$P(ARGS,"|",19),MULTFRAM=$P(ARGS,"|",20)
S SYSTITLE=$P(ARGS,"|",21),EMAIL=$P(ARGS,"|",22)
S IREQUEST=IREQUEST+1,OPCODE=$P(REQUEST(IREQUEST),"|")
I OPCODE'="STORE2" D Q
. D RESULT^MAGDIR8("STORE","-101 Expecting STORE2, got """_OPCODE_"""")
. Q
S ARG2=$P(REQUEST(IREQUEST),"|",2,999)
S STUDYUID=$P(ARG2,"|",1),SERIEUID=$P(ARG2,"|",2)
S IMAGEUID=$P(ARG2,"|",3),SOPCLASS=$P(ARG2,"|",4)
S LASTIMG=$P(ARG2,"|",5),ROUTRULE=$P(ARG2,"|",6)
S MFGR=$P(ARG2,"|",7),MODEL=$P(ARG2,"|",8)
S STAMP=$P(ARG2,"|",9),ORIGINDX=$P(ARG2,"|",10)
S MEDIA=$P(ARG2,"|",11),OLDPATH=$P(ARG2,"|",12)
;
; get a pointer to the image, if it is already on file
S MAGIEN=$O(^MAG(2005,"P",IMAGEUID,0))
;
; the following line will have to be adjusted for DICOM SR
S FILEDATA("TYPE")=$O(^MAG(2005.83,"B","IMAGE",""))
;
I MULTFRAM,MAGIEN D ; subsequent image of a multiframe object
. D MULTFRAM ; require both MULTFRAM and MAGIEN to be non-zero
. Q
E D Q:ERRCODE ; new image
. S ERRCODE=$$NEWIMAGE()
. I ERRCODE D ; error - abort image processing
. . D ERROR^MAGDIR8("STORE",ERRCODE,.MSG,$T(+0))
. . Q
. Q
;
;create the image pointer
I MODPARMS="<DICOM>" D ; store DICOM image type in VistA
. S FILEDATA("OBJECT TYPE")=100 ; DICOM image type
. S FILEDATA("EXTENSION")="EXT^DCM" ; specify the DICOM file extension
. Q
E D ; convert DICOM image type to TGA and store it in VistA
. S FILEDATA("OBJECT TYPE")=3 ; XRAY image type
. S FILEDATA("EXTENSION")="EXT^TGA" ; specify the TGA file extension
. Q
S FILEDATA("ABSTRACT")="ABS^STUFFONLY" ; specify the abstract net loc
;
S ERRCODE=$$ERRCHECK($$IMAGE^MAGDIR9B,"MAGDIR9B",.MSG) ; create the ^MAG(2005) entry for the image
I ERRCODE D ; error - abort image processing
. D ERROR^MAGDIR8("STORE",ERRCODE,.MSG,$T(+0))
. Q
E D ; no error
. S X="0|"_RETURN
. ; save pname, pid, dob, age, and sex from DEM^VADPT for gateway
. F I=1:1:5 S X=X_"|"_VADM(I)
. I $T(GETICN^MPIF001)'="" S X=X_"|"_$$GETICN^MPIF001(DFN) ; save ICN value
. E S X=X_"|" ;P123 - for sites that have not implemented the MPI package
. D RESULT^MAGDIR8("STORE",X)
. Q
Q
;
NEWIMAGE() ; processing for a new image
N ERRORMSG ;- error message causing processing to stop
N PIDCHECK ;- return value of from $$PIDCHECK^MAGDIR8A()
;
I MAGIEN D I $L(ERRORMSG) Q ERRORMSG
. N I,X
. K MSG S I=0
. I IMAGEUID=$$GETUID(MACHID) D ; same image as last one
. . ; process the image again, after software crash
. . ; If the software crashed processing the first image, it might
. . ; delete the image without ever writing it to the file server.
. . ; Now, the image processing software has a second chance.
. . S I=I+1,MSG(I)="Reprocessing image """_FROMPATH_""""
. . S I=I+1,MSG(I)="which is partially in the database (#"_MAGIEN_") for"
. . D ERROR^MAGDIR8("STORE","1 Image partially in the database",.MSG,$T(+0))
. . S ERRORMSG="" ; this is not an error!
. . Q
. E D ; don't accept images with duplicate UIDs
. . S I=I+1,MSG(I)="Image """_FROMPATH_""""
. . S I=I+1,MSG(I)="is already in the database (#"_MAGIEN_") for"
. . S ERRORMSG="-1 Image already in database"
. . Q
. S X=$P($G(^MAG(2005,MAGIEN,2)),"^",1)
. S X=$S(X:$$FMTE^XLFDT(X,1),1:"<no date known>")
. S I=I+1,MSG(I)=""""_$P($G(^MAG(2005,MAGIEN,0)),"^")_""""
. S I=I+1,MSG(I)="Entered into VistA database on "_X
. S I=I+1,MSG(I)="UID = "_IMAGEUID
. Q
;
D SAVEUID(MACHID,IMAGEUID) ; record the UID of the image being processed
;
; lookup the study by ACNUMB/CASENUMB, get DFN, and double-check PID
S ERRCODE=$$LOOKUP Q:ERRCODE ERRCODE
;
S PIDCHECK=$$PIDCHECK^MAGDIR8A()
I PIDCHECK D Q "-2 Image Association Problem" ; didn't find the study
. N CASETEXT,COLUMNS,MFGR,MODEL,MODIEN,OFFSET,ROWS
. ; formulate error message
. K MSG
. S MSG(1)=PIDCHECK
. S (ROWS,COLUMNS,OFFSET,MODIEN,MFGR,MODEL,CASETEXT)=""
. I 'IMPORTER D
. . D MOVE^MAGDLBAA
. . Q
. E D
. . D STORE^MAGDIR8R ; record miss-matched image
. . Q
. Q
; create the group pointer
I IMGSVC="RAD" D Q:ERRCODE ERRCODE
. S ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9A,"MAGDIR9A",.MSG)
. Q
E I IMGSVC="CON" D Q:ERRCODE ERRCODE
. S ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9E,"MAGDIR9E",.MSG)
. Q
E I IMGSVC="LAB" D Q:ERRCODE ERRCODE
. S ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9F,"MAGDIR9F",.MSG)
. Q
E D Q 3 ; undefined imaging service - same as error #4 in LOOKUP
. K MSG
. S MSG(1)="Undefined Imaging Service: "_IMGSVC
. D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. Q
; delete import reconciliation entry
I IMPORTER,$L(OLDPATH) Q $$DELETE^MAGDIR8R(IMAGEUID,MACHID,OLDPATH)
Q 0
;
SAVEUID(MACHID,UID) ; record the UID of the image being processed
N D0,X
S D0=$O(^MAGD(2006.5715,"B",MACHID,"")) D:'D0
. L +^MAGD(2006.5715):1E9 ; Background process MUST wait
. S D0=$O(^MAGD(2006.5715," "),-1)+1
. S X=$G(^MAGD(2006.5715,0))
. S $P(X,"^",1,2)="CURRENT IMAGE^2006.5715"
. S $P(X,"^",3)=D0
. S $P(X,"^",4)=$P(X,"^",4)+1
. S ^MAGD(2006.5715,0)=X
. S ^MAGD(2006.5715,D0,0)=MACHID
. S ^MAGD(2006.5715,"B",MACHID,D0)=""
. L -^MAGD(2006.5715)
. Q
S $P(^MAGD(2006.5715,D0,0),"^",2)=UID
Q
;
GETUID(MACHID) ; lookup the UID of the last image processed
N D0
S D0=+$O(^MAGD(2006.5715,"B",MACHID,""))
Q $P($G(^MAGD(2006.5715,D0,0)),"^",2)
;
MULTFRAM ; Handle additional images in a multiframe object
; Get the information from the first image for the additional ones
;
N DIQUIET,INAME,MAG0,MAG40,MAG100,MAGPACS
N SOPCLASP ; pointer to SOP Class file (#2006.532)
S MAG0=^MAG(2005,MAGIEN,0),MAG1=$G(^(1)),MAG2=$G(^(2))
S MAG40=$G(^MAG(2005,MAGIEN,40)),MAG100=$G(^(100))
S MAGPACS=$G(^MAG(2005,MAGIEN,"PACS"))
S INAME=$P(MAG0,"^",1) ; field .01
S PNAMEVAH=$P(INAME," ",1),DCMPID=$P(INAME," ",2)
S DFN=$P(MAG0,"^",7) ; field 5
S MAGGP=$P(MAG0,"^",10) ; field 14
S DATETIME=$P(MAG2,"^",5) ; field 15
S FILEDATA("MODALITY")=MODALITY
S FILEDATA("PARENT FILE")=$P(MAG2,"^",6) ; field 16
S FILEDATA("PARENT IEN")=$P(MAG2,"^",7) ; field 17
S FILEDATA("PARENT FILE PTR")=$P(MAG2,"^",8) ; field 18
S FILEDATA("RAD REPORT")=$P(MAGPACS,"^",2) ; field 61
S FILEDATA("RAD PROC PTR")=$P(MAGPACS,"^",3) ; field 62
S FILEDATA("PACKAGE")=$P(MAG40,"^",1) ; field 40
; field 41 is not needed
S FILEDATA("TYPE")=$P(MAG40,"^",3) ; field 42
S FILEDATA("PROC/EVENT")=$P(MAG40,"^",4) ; field 43
S FILEDATA("SPEC/SUBSPEC")=$P(MAG40,"^",5) ; field 44
S FILEDATA("ACQUISITION DEVICE")=$P(MAG100,"^",4) ; field 107
; get the SOP Class pointer (file 2005, field 251)
S SOPCLASP=$O(^MAG(2006.532,"B",SOPCLASS,""))
S FILEDATA("SOP CLASS POINTER")=SOPCLASP
S PROCDESC=$P(MAG2,"^",4) ; field 10
; S X="" F S X=$O(FILEDATA(X)) Q:X="" I FILEDATA(X)="" K FILEDATA(X)
I PROCDESC?.E1" (#".N1")" S PROCDESC=$P(PROCDESC," (#")
; lookup patient in VistA database - needed to build VADM array
S DIQUIET=1 D DEM^VADPT
Q
;
LOOKUP() ; lookup the patient/study using cross-reference
K DFN
S ACNUMB=CASENUMB
I IMGSVC="RAD" D ; radiology storage SCP port
. D RADLKUP^MAGDIR8A
. I '$D(DFN) D ; may be a consult procedure
. . D CONLKUP^MAGDIR8A
. . I $D(DFN) S IMGSVC="CON" ; it was a consult
. . E D ; may be a lab procedure
. . . D LABLKUP^MAGDIR8A
. . . I $D(DFN) S IMGSVC="LAB" ; it was a lab procedure
. . Q
. Q
E I IMGSVC="CON" D ; consult storage SCP port
. D CONLKUP^MAGDIR8A
. I '$D(DFN) D ; may be a radiology or lab procedure
. . D RADLKUP^MAGDIR8A
. . I $D(DFN) S IMGSVC="RAD" ; it was a radiology procedure
. . E D ; may be a lab procedure
. . . D LABLKUP^MAGDIR8A
. . . I $D(DFN) S IMGSVC="LAB" ; it was a lab procedure
. . . Q
. . Q
. Q
E I IMGSVC="LAB" D ; lab lookup
. D LABLKUP^MAGDIR8A
. I '$D(DFN) D ; may be a radiology or consult procedure
. . D RADLKUP^MAGDIR8A
. . I $D(DFN) S IMGSVC="RAD" ; it was a radiology procedure
. . E D ; may be a consult procedure
. . . D CONLKUP^MAGDIR8A
. . . I $D(DFN) S IMGSVC="CON" ; it was a consult
. . . Q
. . Q
. Q
E D Q 4 ; undefined imaging service - same as error #3 in NEWIMAGE
. K MSG
. S MSG(1)="Undefined Imaging Service: "_IMGSVC
. D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. Q
Q 0
;
ERRCHECK(FUNCTION,ROUTINE,MSG) ; check the return code of the function
N ERRCODE
S ERRCODE=FUNCTION
I ERRCODE D
. N I
. S I=$O(MSG(""),-1)
. S I=I+1,MSG(I)="A problem was encountered by routine "_ROUTINE_ " Error Code: """_ERRCODE_""""
. Q
Q ERRCODE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIR81 12023 printed Apr 09, 2024@21:04:23 Page 2
MAGDIR81 ;WOIFO/PMK - Read a DICOM image file ; 03 Jul 2013 9:12 AM
+1 ;;3.0;IMAGING;**11,30,51,50,46,54,53,123,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 ; M2MB server
+18 ;
+19 ; This routine is invoked by the ^MAGDIR8 for the "STORE1/STORE2"
+20 ; REQUEST items when there is an image to be stored into the database.
+21 ; It adds it to the ^MAG global with appropriate pointers to the
+22 ; "parent data files".
+23 ;
ENTRY ; process one image
+1 ;--- medicine pkg patient & study data (set in ^MAGDIR8A)
NEW MEDATA
+2 ;- array of data to be passed between routines
NEW FILEDATA
+3 ;- patient first name from the image header (ie, PNAMEDCM)
NEW FIRSTDCM
+4 ;-- internal entry number of consult/procedure request
NEW GMRCIEN
+5 ;- flag set by a gateway that is running the IMPORTER app
NEW IMPORTER
+6 ;-- patient last name from the image header (ie, PNAMEDCM)
NEW LASTDCM
+7 ;---- patient ien in LAB DATA file (#60)
NEW LRDFN
+8 ;------ inverse date for LAB DATA file (#60)
NEW LRI
+9 ;----- lab section (CY, EM, or SP)
NEW LRSS
+10 ;---- source of DICOM object for Importer (D=disk, T=transmission)
NEW MEDIA
+11 ;---- image's group pointer in ^MAG(2005)
NEW MAGGP
+12 ;--- pointer to the entry for the image in ^MAG(2005)
NEW MAGIEN
+13 ;---- patient middle initial from the image header (PNAMEDCM)
NEW MIDCM
+14 ;-- original path for imported images (set by Importer)
NEW OLDPATH
+15 ;- origin index (file 2005, field 45)
NEW ORIGINDX
+16 ;- patient name from VADM(1)
NEW PNAMEVAH
+17 ;- procedure description (VA's name)
NEW PROCDESC
+18 ;--- radiology pkg patient & study data (set in ^MAGDIR8A)
NEW RADATA
+19 ;----- array of demographic variables filled in by DEM^VADPT
NEW VADM
+20 NEW I,MAG0,MAG1,MAG2,QUIT,X
+21 ;
+22 NEW ACNUMB,ARG2,CASENUMB,EMAIL,FROMPATH,IMAGEUID,IMAGNAME,IMAGNUMB,IMGSVC
+23 NEW INSTLOC,INSTNAME,LASTIMG,LOCATION,MACHID,MFGR,MODALITY,MODEL,MODPARMS
+24 NEW MULTFRAM,PID,PNAMEDCM,ROUTRULE,SERINUMB,SERIEUID,SOPCLASS,STAMP,STATUS
+25 NEW STUDYDAT,STUDYTIM,STUDYDAT,STUDYTIM,STUDYUID,SYSTITLE
+26 SET STATUS=$PIECE(ARGS,"|",1)
SET LOCATION=$PIECE(ARGS,"|",2)
+27 SET MACHID=$PIECE(ARGS,"|",3)
SET IMGSVC=$PIECE(ARGS,"|",4)
+28 SET INSTNAME=$PIECE(ARGS,"|",5)
SET FROMPATH=$PIECE(ARGS,"|",6)
+29 SET PID=$PIECE(ARGS,"|",7)
SET PNAMEDCM=$PIECE(ARGS,"|",8)
+30 SET CASENUMB=$PIECE(ARGS,"|",9)
SET ACNUMB=$PIECE(ARGS,"|",10)
+31 SET STUDYDAT=$PIECE(ARGS,"|",11)
SET STUDYTIM=$PIECE(ARGS,"|",12)
+32 SET IMPORTER=$PIECE(ARGS,"|",13)
SET MODALITY=$PIECE(ARGS,"|",14)
+33 SET IMAGNAME=$PIECE(ARGS,"|",15)
SET MODPARMS=$PIECE(ARGS,"|",16)
+34 SET SERINUMB=$PIECE(ARGS,"|",17)
SET IMAGNUMB=$PIECE(ARGS,"|",18)
+35 SET INSTLOC=$PIECE(ARGS,"|",19)
SET MULTFRAM=$PIECE(ARGS,"|",20)
+36 SET SYSTITLE=$PIECE(ARGS,"|",21)
SET EMAIL=$PIECE(ARGS,"|",22)
+37 SET IREQUEST=IREQUEST+1
SET OPCODE=$PIECE(REQUEST(IREQUEST),"|")
+38 IF OPCODE'="STORE2"
Begin DoDot:1
+39 DO RESULT^MAGDIR8("STORE","-101 Expecting STORE2, got """_OPCODE_"""")
+40 QUIT
End DoDot:1
QUIT
+41 SET ARG2=$PIECE(REQUEST(IREQUEST),"|",2,999)
+42 SET STUDYUID=$PIECE(ARG2,"|",1)
SET SERIEUID=$PIECE(ARG2,"|",2)
+43 SET IMAGEUID=$PIECE(ARG2,"|",3)
SET SOPCLASS=$PIECE(ARG2,"|",4)
+44 SET LASTIMG=$PIECE(ARG2,"|",5)
SET ROUTRULE=$PIECE(ARG2,"|",6)
+45 SET MFGR=$PIECE(ARG2,"|",7)
SET MODEL=$PIECE(ARG2,"|",8)
+46 SET STAMP=$PIECE(ARG2,"|",9)
SET ORIGINDX=$PIECE(ARG2,"|",10)
+47 SET MEDIA=$PIECE(ARG2,"|",11)
SET OLDPATH=$PIECE(ARG2,"|",12)
+48 ;
+49 ; get a pointer to the image, if it is already on file
+50 SET MAGIEN=$ORDER(^MAG(2005,"P",IMAGEUID,0))
+51 ;
+52 ; the following line will have to be adjusted for DICOM SR
+53 SET FILEDATA("TYPE")=$ORDER(^MAG(2005.83,"B","IMAGE",""))
+54 ;
+55 ; subsequent image of a multiframe object
IF MULTFRAM
IF MAGIEN
Begin DoDot:1
+56 ; require both MULTFRAM and MAGIEN to be non-zero
DO MULTFRAM
+57 QUIT
End DoDot:1
+58 ; new image
IF '$TEST
Begin DoDot:1
+59 SET ERRCODE=$$NEWIMAGE()
+60 ; error - abort image processing
IF ERRCODE
Begin DoDot:2
+61 DO ERROR^MAGDIR8("STORE",ERRCODE,.MSG,$TEXT(+0))
+62 QUIT
End DoDot:2
+63 QUIT
End DoDot:1
if ERRCODE
QUIT
+64 ;
+65 ;create the image pointer
+66 ; store DICOM image type in VistA
IF MODPARMS="<DICOM>"
Begin DoDot:1
+67 ; DICOM image type
SET FILEDATA("OBJECT TYPE")=100
+68 ; specify the DICOM file extension
SET FILEDATA("EXTENSION")="EXT^DCM"
+69 QUIT
End DoDot:1
+70 ; convert DICOM image type to TGA and store it in VistA
IF '$TEST
Begin DoDot:1
+71 ; XRAY image type
SET FILEDATA("OBJECT TYPE")=3
+72 ; specify the TGA file extension
SET FILEDATA("EXTENSION")="EXT^TGA"
+73 QUIT
End DoDot:1
+74 ; specify the abstract net loc
SET FILEDATA("ABSTRACT")="ABS^STUFFONLY"
+75 ;
+76 ; create the ^MAG(2005) entry for the image
SET ERRCODE=$$ERRCHECK($$IMAGE^MAGDIR9B,"MAGDIR9B",.MSG)
+77 ; error - abort image processing
IF ERRCODE
Begin DoDot:1
+78 DO ERROR^MAGDIR8("STORE",ERRCODE,.MSG,$TEXT(+0))
+79 QUIT
End DoDot:1
+80 ; no error
IF '$TEST
Begin DoDot:1
+81 SET X="0|"_RETURN
+82 ; save pname, pid, dob, age, and sex from DEM^VADPT for gateway
+83 FOR I=1:1:5
SET X=X_"|"_VADM(I)
+84 ; save ICN value
IF $TEXT(GETICN^MPIF001)'=""
SET X=X_"|"_$$GETICN^MPIF001(DFN)
+85 ;P123 - for sites that have not implemented the MPI package
IF '$TEST
SET X=X_"|"
+86 DO RESULT^MAGDIR8("STORE",X)
+87 QUIT
End DoDot:1
+88 QUIT
+89 ;
NEWIMAGE() ; processing for a new image
+1 ;- error message causing processing to stop
NEW ERRORMSG
+2 ;- return value of from $$PIDCHECK^MAGDIR8A()
NEW PIDCHECK
+3 ;
+4 IF MAGIEN
Begin DoDot:1
+5 NEW I,X
+6 KILL MSG
SET I=0
+7 ; same image as last one
IF IMAGEUID=$$GETUID(MACHID)
Begin DoDot:2
+8 ; process the image again, after software crash
+9 ; If the software crashed processing the first image, it might
+10 ; delete the image without ever writing it to the file server.
+11 ; Now, the image processing software has a second chance.
+12 SET I=I+1
SET MSG(I)="Reprocessing image """_FROMPATH_""""
+13 SET I=I+1
SET MSG(I)="which is partially in the database (#"_MAGIEN_") for"
+14 DO ERROR^MAGDIR8("STORE","1 Image partially in the database",.MSG,$TEXT(+0))
+15 ; this is not an error!
SET ERRORMSG=""
+16 QUIT
End DoDot:2
+17 ; don't accept images with duplicate UIDs
IF '$TEST
Begin DoDot:2
+18 SET I=I+1
SET MSG(I)="Image """_FROMPATH_""""
+19 SET I=I+1
SET MSG(I)="is already in the database (#"_MAGIEN_") for"
+20 SET ERRORMSG="-1 Image already in database"
+21 QUIT
End DoDot:2
+22 SET X=$PIECE($GET(^MAG(2005,MAGIEN,2)),"^",1)
+23 SET X=$SELECT(X:$$FMTE^XLFDT(X,1),1:"<no date known>")
+24 SET I=I+1
SET MSG(I)=""""_$PIECE($GET(^MAG(2005,MAGIEN,0)),"^")_""""
+25 SET I=I+1
SET MSG(I)="Entered into VistA database on "_X
+26 SET I=I+1
SET MSG(I)="UID = "_IMAGEUID
+27 QUIT
End DoDot:1
IF $LENGTH(ERRORMSG)
QUIT ERRORMSG
+28 ;
+29 ; record the UID of the image being processed
DO SAVEUID(MACHID,IMAGEUID)
+30 ;
+31 ; lookup the study by ACNUMB/CASENUMB, get DFN, and double-check PID
+32 SET ERRCODE=$$LOOKUP
if ERRCODE
QUIT ERRCODE
+33 ;
+34 SET PIDCHECK=$$PIDCHECK^MAGDIR8A()
+35 ; didn't find the study
IF PIDCHECK
Begin DoDot:1
+36 NEW CASETEXT,COLUMNS,MFGR,MODEL,MODIEN,OFFSET,ROWS
+37 ; formulate error message
+38 KILL MSG
+39 SET MSG(1)=PIDCHECK
+40 SET (ROWS,COLUMNS,OFFSET,MODIEN,MFGR,MODEL,CASETEXT)=""
+41 IF 'IMPORTER
Begin DoDot:2
+42 DO MOVE^MAGDLBAA
+43 QUIT
End DoDot:2
+44 IF '$TEST
Begin DoDot:2
+45 ; record miss-matched image
DO STORE^MAGDIR8R
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
QUIT "-2 Image Association Problem"
+48 ; create the group pointer
+49 IF IMGSVC="RAD"
Begin DoDot:1
+50 SET ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9A,"MAGDIR9A",.MSG)
+51 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+52 IF '$TEST
IF IMGSVC="CON"
Begin DoDot:1
+53 SET ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9E,"MAGDIR9E",.MSG)
+54 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+55 IF '$TEST
IF IMGSVC="LAB"
Begin DoDot:1
+56 SET ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9F,"MAGDIR9F",.MSG)
+57 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+58 ; undefined imaging service - same as error #4 in LOOKUP
IF '$TEST
Begin DoDot:1
+59 KILL MSG
+60 SET MSG(1)="Undefined Imaging Service: "_IMGSVC
+61 DO ERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+62 QUIT
End DoDot:1
QUIT 3
+63 ; delete import reconciliation entry
+64 IF IMPORTER
IF $LENGTH(OLDPATH)
QUIT $$DELETE^MAGDIR8R(IMAGEUID,MACHID,OLDPATH)
+65 QUIT 0
+66 ;
SAVEUID(MACHID,UID) ; record the UID of the image being processed
+1 NEW D0,X
+2 SET D0=$ORDER(^MAGD(2006.5715,"B",MACHID,""))
if 'D0
Begin DoDot:1
+3 ; Background process MUST wait
LOCK +^MAGD(2006.5715):1E9
+4 SET D0=$ORDER(^MAGD(2006.5715," "),-1)+1
+5 SET X=$GET(^MAGD(2006.5715,0))
+6 SET $PIECE(X,"^",1,2)="CURRENT IMAGE^2006.5715"
+7 SET $PIECE(X,"^",3)=D0
+8 SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
+9 SET ^MAGD(2006.5715,0)=X
+10 SET ^MAGD(2006.5715,D0,0)=MACHID
+11 SET ^MAGD(2006.5715,"B",MACHID,D0)=""
+12 LOCK -^MAGD(2006.5715)
+13 QUIT
End DoDot:1
+14 SET $PIECE(^MAGD(2006.5715,D0,0),"^",2)=UID
+15 QUIT
+16 ;
GETUID(MACHID) ; lookup the UID of the last image processed
+1 NEW D0
+2 SET D0=+$ORDER(^MAGD(2006.5715,"B",MACHID,""))
+3 QUIT $PIECE($GET(^MAGD(2006.5715,D0,0)),"^",2)
+4 ;
MULTFRAM ; Handle additional images in a multiframe object
+1 ; Get the information from the first image for the additional ones
+2 ;
+3 NEW DIQUIET,INAME,MAG0,MAG40,MAG100,MAGPACS
+4 ; pointer to SOP Class file (#2006.532)
NEW SOPCLASP
+5 SET MAG0=^MAG(2005,MAGIEN,0)
SET MAG1=$GET(^(1))
SET MAG2=$GET(^(2))
+6 SET MAG40=$GET(^MAG(2005,MAGIEN,40))
SET MAG100=$GET(^(100))
+7 SET MAGPACS=$GET(^MAG(2005,MAGIEN,"PACS"))
+8 ; field .01
SET INAME=$PIECE(MAG0,"^",1)
+9 SET PNAMEVAH=$PIECE(INAME," ",1)
SET DCMPID=$PIECE(INAME," ",2)
+10 ; field 5
SET DFN=$PIECE(MAG0,"^",7)
+11 ; field 14
SET MAGGP=$PIECE(MAG0,"^",10)
+12 ; field 15
SET DATETIME=$PIECE(MAG2,"^",5)
+13 SET FILEDATA("MODALITY")=MODALITY
+14 ; field 16
SET FILEDATA("PARENT FILE")=$PIECE(MAG2,"^",6)
+15 ; field 17
SET FILEDATA("PARENT IEN")=$PIECE(MAG2,"^",7)
+16 ; field 18
SET FILEDATA("PARENT FILE PTR")=$PIECE(MAG2,"^",8)
+17 ; field 61
SET FILEDATA("RAD REPORT")=$PIECE(MAGPACS,"^",2)
+18 ; field 62
SET FILEDATA("RAD PROC PTR")=$PIECE(MAGPACS,"^",3)
+19 ; field 40
SET FILEDATA("PACKAGE")=$PIECE(MAG40,"^",1)
+20 ; field 41 is not needed
+21 ; field 42
SET FILEDATA("TYPE")=$PIECE(MAG40,"^",3)
+22 ; field 43
SET FILEDATA("PROC/EVENT")=$PIECE(MAG40,"^",4)
+23 ; field 44
SET FILEDATA("SPEC/SUBSPEC")=$PIECE(MAG40,"^",5)
+24 ; field 107
SET FILEDATA("ACQUISITION DEVICE")=$PIECE(MAG100,"^",4)
+25 ; get the SOP Class pointer (file 2005, field 251)
+26 SET SOPCLASP=$ORDER(^MAG(2006.532,"B",SOPCLASS,""))
+27 SET FILEDATA("SOP CLASS POINTER")=SOPCLASP
+28 ; field 10
SET PROCDESC=$PIECE(MAG2,"^",4)
+29 ; S X="" F S X=$O(FILEDATA(X)) Q:X="" I FILEDATA(X)="" K FILEDATA(X)
+30 IF PROCDESC?.E1" (#".N1")"
SET PROCDESC=$PIECE(PROCDESC," (#")
+31 ; lookup patient in VistA database - needed to build VADM array
+32 SET DIQUIET=1
DO DEM^VADPT
+33 QUIT
+34 ;
LOOKUP() ; lookup the patient/study using cross-reference
+1 KILL DFN
+2 SET ACNUMB=CASENUMB
+3 ; radiology storage SCP port
IF IMGSVC="RAD"
Begin DoDot:1
+4 DO RADLKUP^MAGDIR8A
+5 ; may be a consult procedure
IF '$DATA(DFN)
Begin DoDot:2
+6 DO CONLKUP^MAGDIR8A
+7 ; it was a consult
IF $DATA(DFN)
SET IMGSVC="CON"
+8 ; may be a lab procedure
IF '$TEST
Begin DoDot:3
+9 DO LABLKUP^MAGDIR8A
+10 ; it was a lab procedure
IF $DATA(DFN)
SET IMGSVC="LAB"
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 ; consult storage SCP port
IF '$TEST
IF IMGSVC="CON"
Begin DoDot:1
+14 DO CONLKUP^MAGDIR8A
+15 ; may be a radiology or lab procedure
IF '$DATA(DFN)
Begin DoDot:2
+16 DO RADLKUP^MAGDIR8A
+17 ; it was a radiology procedure
IF $DATA(DFN)
SET IMGSVC="RAD"
+18 ; may be a lab procedure
IF '$TEST
Begin DoDot:3
+19 DO LABLKUP^MAGDIR8A
+20 ; it was a lab procedure
IF $DATA(DFN)
SET IMGSVC="LAB"
+21 QUIT
End DoDot:3
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 ; lab lookup
IF '$TEST
IF IMGSVC="LAB"
Begin DoDot:1
+25 DO LABLKUP^MAGDIR8A
+26 ; may be a radiology or consult procedure
IF '$DATA(DFN)
Begin DoDot:2
+27 DO RADLKUP^MAGDIR8A
+28 ; it was a radiology procedure
IF $DATA(DFN)
SET IMGSVC="RAD"
+29 ; may be a consult procedure
IF '$TEST
Begin DoDot:3
+30 DO CONLKUP^MAGDIR8A
+31 ; it was a consult
IF $DATA(DFN)
SET IMGSVC="CON"
+32 QUIT
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 ; undefined imaging service - same as error #3 in NEWIMAGE
IF '$TEST
Begin DoDot:1
+36 KILL MSG
+37 SET MSG(1)="Undefined Imaging Service: "_IMGSVC
+38 DO ERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+39 QUIT
End DoDot:1
QUIT 4
+40 QUIT 0
+41 ;
ERRCHECK(FUNCTION,ROUTINE,MSG) ; check the return code of the function
+1 NEW ERRCODE
+2 SET ERRCODE=FUNCTION
+3 IF ERRCODE
Begin DoDot:1
+4 NEW I
+5 SET I=$ORDER(MSG(""),-1)
+6 SET I=I+1
SET MSG(I)="A problem was encountered by routine "_ROUTINE_
