- 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 Feb 18, 2025@23:26:48 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_