Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDIR81

MAGDIR81.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ; M2MB server
  1. ;
  1. ; This routine is invoked by the ^MAGDIR8 for the "STORE1/STORE2"
  1. ; REQUEST items when there is an image to be stored into the database.
  1. ; It adds it to the ^MAG global with appropriate pointers to the
  1. ; "parent data files".
  1. ;
  1. ENTRY ; process one image
  1. N MEDATA ;--- medicine pkg patient & study data (set in ^MAGDIR8A)
  1. N FILEDATA ;- array of data to be passed between routines
  1. N FIRSTDCM ;- patient first name from the image header (ie, PNAMEDCM)
  1. N GMRCIEN ;-- internal entry number of consult/procedure request
  1. N IMPORTER ;- flag set by a gateway that is running the IMPORTER app
  1. N LASTDCM ;-- patient last name from the image header (ie, PNAMEDCM)
  1. N LRDFN ;---- patient ien in LAB DATA file (#60)
  1. N LRI ;------ inverse date for LAB DATA file (#60)
  1. N LRSS ;----- lab section (CY, EM, or SP)
  1. N MEDIA ;---- source of DICOM object for Importer (D=disk, T=transmission)
  1. N MAGGP ;---- image's group pointer in ^MAG(2005)
  1. N MAGIEN ;--- pointer to the entry for the image in ^MAG(2005)
  1. N MIDCM ;---- patient middle initial from the image header (PNAMEDCM)
  1. N OLDPATH ;-- original path for imported images (set by Importer)
  1. N ORIGINDX ;- origin index (file 2005, field 45)
  1. N PNAMEVAH ;- patient name from VADM(1)
  1. N PROCDESC ;- procedure description (VA's name)
  1. N RADATA ;--- radiology pkg patient & study data (set in ^MAGDIR8A)
  1. N VADM ;----- array of demographic variables filled in by DEM^VADPT
  1. N I,MAG0,MAG1,MAG2,QUIT,X
  1. ;
  1. N ACNUMB,ARG2,CASENUMB,EMAIL,FROMPATH,IMAGEUID,IMAGNAME,IMAGNUMB,IMGSVC
  1. N INSTLOC,INSTNAME,LASTIMG,LOCATION,MACHID,MFGR,MODALITY,MODEL,MODPARMS
  1. N MULTFRAM,PID,PNAMEDCM,ROUTRULE,SERINUMB,SERIEUID,SOPCLASS,STAMP,STATUS
  1. N STUDYDAT,STUDYTIM,STUDYDAT,STUDYTIM,STUDYUID,SYSTITLE
  1. S STATUS=$P(ARGS,"|",1),LOCATION=$P(ARGS,"|",2)
  1. S MACHID=$P(ARGS,"|",3),IMGSVC=$P(ARGS,"|",4)
  1. S INSTNAME=$P(ARGS,"|",5),FROMPATH=$P(ARGS,"|",6)
  1. S PID=$P(ARGS,"|",7),PNAMEDCM=$P(ARGS,"|",8)
  1. S CASENUMB=$P(ARGS,"|",9),ACNUMB=$P(ARGS,"|",10)
  1. S STUDYDAT=$P(ARGS,"|",11),STUDYTIM=$P(ARGS,"|",12)
  1. S IMPORTER=$P(ARGS,"|",13),MODALITY=$P(ARGS,"|",14)
  1. S IMAGNAME=$P(ARGS,"|",15),MODPARMS=$P(ARGS,"|",16)
  1. S SERINUMB=$P(ARGS,"|",17),IMAGNUMB=$P(ARGS,"|",18)
  1. S INSTLOC=$P(ARGS,"|",19),MULTFRAM=$P(ARGS,"|",20)
  1. S SYSTITLE=$P(ARGS,"|",21),EMAIL=$P(ARGS,"|",22)
  1. S IREQUEST=IREQUEST+1,OPCODE=$P(REQUEST(IREQUEST),"|")
  1. I OPCODE'="STORE2" D Q
  1. . D RESULT^MAGDIR8("STORE","-101 Expecting STORE2, got """_OPCODE_"""")
  1. . Q
  1. S ARG2=$P(REQUEST(IREQUEST),"|",2,999)
  1. S STUDYUID=$P(ARG2,"|",1),SERIEUID=$P(ARG2,"|",2)
  1. S IMAGEUID=$P(ARG2,"|",3),SOPCLASS=$P(ARG2,"|",4)
  1. S LASTIMG=$P(ARG2,"|",5),ROUTRULE=$P(ARG2,"|",6)
  1. S MFGR=$P(ARG2,"|",7),MODEL=$P(ARG2,"|",8)
  1. S STAMP=$P(ARG2,"|",9),ORIGINDX=$P(ARG2,"|",10)
  1. S MEDIA=$P(ARG2,"|",11),OLDPATH=$P(ARG2,"|",12)
  1. ;
  1. ; get a pointer to the image, if it is already on file
  1. S MAGIEN=$O(^MAG(2005,"P",IMAGEUID,0))
  1. ;
  1. ; the following line will have to be adjusted for DICOM SR
  1. S FILEDATA("TYPE")=$O(^MAG(2005.83,"B","IMAGE",""))
  1. ;
  1. I MULTFRAM,MAGIEN D ; subsequent image of a multiframe object
  1. . D MULTFRAM ; require both MULTFRAM and MAGIEN to be non-zero
  1. . Q
  1. E D Q:ERRCODE ; new image
  1. . S ERRCODE=$$NEWIMAGE()
  1. . I ERRCODE D ; error - abort image processing
  1. . . D ERROR^MAGDIR8("STORE",ERRCODE,.MSG,$T(+0))
  1. . . Q
  1. . Q
  1. ;
  1. ;create the image pointer
  1. I MODPARMS="<DICOM>" D ; store DICOM image type in VistA
  1. . S FILEDATA("OBJECT TYPE")=100 ; DICOM image type
  1. . S FILEDATA("EXTENSION")="EXT^DCM" ; specify the DICOM file extension
  1. . Q
  1. E D ; convert DICOM image type to TGA and store it in VistA
  1. . S FILEDATA("OBJECT TYPE")=3 ; XRAY image type
  1. . S FILEDATA("EXTENSION")="EXT^TGA" ; specify the TGA file extension
  1. . Q
  1. S FILEDATA("ABSTRACT")="ABS^STUFFONLY" ; specify the abstract net loc
  1. ;
  1. S ERRCODE=$$ERRCHECK($$IMAGE^MAGDIR9B,"MAGDIR9B",.MSG) ; create the ^MAG(2005) entry for the image
  1. I ERRCODE D ; error - abort image processing
  1. . D ERROR^MAGDIR8("STORE",ERRCODE,.MSG,$T(+0))
  1. . Q
  1. E D ; no error
  1. . S X="0|"_RETURN
  1. . ; save pname, pid, dob, age, and sex from DEM^VADPT for gateway
  1. . F I=1:1:5 S X=X_"|"_VADM(I)
  1. . I $T(GETICN^MPIF001)'="" S X=X_"|"_$$GETICN^MPIF001(DFN) ; save ICN value
  1. . E S X=X_"|" ;P123 - for sites that have not implemented the MPI package
  1. . D RESULT^MAGDIR8("STORE",X)
  1. . Q
  1. Q
  1. ;
  1. NEWIMAGE() ; processing for a new image
  1. N ERRORMSG ;- error message causing processing to stop
  1. N PIDCHECK ;- return value of from $$PIDCHECK^MAGDIR8A()
  1. ;
  1. I MAGIEN D I $L(ERRORMSG) Q ERRORMSG
  1. . N I,X
  1. . K MSG S I=0
  1. . I IMAGEUID=$$GETUID(MACHID) D ; same image as last one
  1. . . ; process the image again, after software crash
  1. . . ; If the software crashed processing the first image, it might
  1. . . ; delete the image without ever writing it to the file server.
  1. . . ; Now, the image processing software has a second chance.
  1. . . S I=I+1,MSG(I)="Reprocessing image """_FROMPATH_""""
  1. . . S I=I+1,MSG(I)="which is partially in the database (#"_MAGIEN_") for"
  1. . . D ERROR^MAGDIR8("STORE","1 Image partially in the database",.MSG,$T(+0))
  1. . . S ERRORMSG="" ; this is not an error!
  1. . . Q
  1. . E D ; don't accept images with duplicate UIDs
  1. . . S I=I+1,MSG(I)="Image """_FROMPATH_""""
  1. . . S I=I+1,MSG(I)="is already in the database (#"_MAGIEN_") for"
  1. . . S ERRORMSG="-1 Image already in database"
  1. . . Q
  1. . S X=$P($G(^MAG(2005,MAGIEN,2)),"^",1)
  1. . S X=$S(X:$$FMTE^XLFDT(X,1),1:"<no date known>")
  1. . S I=I+1,MSG(I)=""""_$P($G(^MAG(2005,MAGIEN,0)),"^")_""""
  1. . S I=I+1,MSG(I)="Entered into VistA database on "_X
  1. . S I=I+1,MSG(I)="UID = "_IMAGEUID
  1. . Q
  1. ;
  1. D SAVEUID(MACHID,IMAGEUID) ; record the UID of the image being processed
  1. ;
  1. ; lookup the study by ACNUMB/CASENUMB, get DFN, and double-check PID
  1. S ERRCODE=$$LOOKUP Q:ERRCODE ERRCODE
  1. ;
  1. S PIDCHECK=$$PIDCHECK^MAGDIR8A()
  1. I PIDCHECK D Q "-2 Image Association Problem" ; didn't find the study
  1. . N CASETEXT,COLUMNS,MFGR,MODEL,MODIEN,OFFSET,ROWS
  1. . ; formulate error message
  1. . K MSG
  1. . S MSG(1)=PIDCHECK
  1. . S (ROWS,COLUMNS,OFFSET,MODIEN,MFGR,MODEL,CASETEXT)=""
  1. . I 'IMPORTER D
  1. . . D MOVE^MAGDLBAA
  1. . . Q
  1. . E D
  1. . . D STORE^MAGDIR8R ; record miss-matched image
  1. . . Q
  1. . Q
  1. ; create the group pointer
  1. I IMGSVC="RAD" D Q:ERRCODE ERRCODE
  1. . S ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9A,"MAGDIR9A",.MSG)
  1. . Q
  1. E I IMGSVC="CON" D Q:ERRCODE ERRCODE
  1. . S ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9E,"MAGDIR9E",.MSG)
  1. . Q
  1. E I IMGSVC="LAB" D Q:ERRCODE ERRCODE
  1. . S ERRCODE=$$ERRCHECK($$GROUP^MAGDIR9F,"MAGDIR9F",.MSG)
  1. . Q
  1. E D Q 3 ; undefined imaging service - same as error #4 in LOOKUP
  1. . K MSG
  1. . S MSG(1)="Undefined Imaging Service: "_IMGSVC
  1. . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
  1. . Q
  1. ; delete import reconciliation entry
  1. I IMPORTER,$L(OLDPATH) Q $$DELETE^MAGDIR8R(IMAGEUID,MACHID,OLDPATH)
  1. Q 0
  1. ;
  1. SAVEUID(MACHID,UID) ; record the UID of the image being processed
  1. N D0,X
  1. S D0=$O(^MAGD(2006.5715,"B",MACHID,"")) D:'D0
  1. . L +^MAGD(2006.5715):1E9 ; Background process MUST wait
  1. . S D0=$O(^MAGD(2006.5715," "),-1)+1
  1. . S X=$G(^MAGD(2006.5715,0))
  1. . S $P(X,"^",1,2)="CURRENT IMAGE^2006.5715"
  1. . S $P(X,"^",3)=D0
  1. . S $P(X,"^",4)=$P(X,"^",4)+1
  1. . S ^MAGD(2006.5715,0)=X
  1. . S ^MAGD(2006.5715,D0,0)=MACHID
  1. . S ^MAGD(2006.5715,"B",MACHID,D0)=""
  1. . L -^MAGD(2006.5715)
  1. . Q
  1. S $P(^MAGD(2006.5715,D0,0),"^",2)=UID
  1. Q
  1. ;
  1. GETUID(MACHID) ; lookup the UID of the last image processed
  1. N D0
  1. S D0=+$O(^MAGD(2006.5715,"B",MACHID,""))
  1. Q $P($G(^MAGD(2006.5715,D0,0)),"^",2)
  1. ;
  1. MULTFRAM ; Handle additional images in a multiframe object
  1. ; Get the information from the first image for the additional ones
  1. ;
  1. N DIQUIET,INAME,MAG0,MAG40,MAG100,MAGPACS
  1. N SOPCLASP ; pointer to SOP Class file (#2006.532)
  1. S MAG0=^MAG(2005,MAGIEN,0),MAG1=$G(^(1)),MAG2=$G(^(2))
  1. S MAG40=$G(^MAG(2005,MAGIEN,40)),MAG100=$G(^(100))
  1. S MAGPACS=$G(^MAG(2005,MAGIEN,"PACS"))
  1. S INAME=$P(MAG0,"^",1) ; field .01
  1. S PNAMEVAH=$P(INAME," ",1),DCMPID=$P(INAME," ",2)
  1. S DFN=$P(MAG0,"^",7) ; field 5
  1. S MAGGP=$P(MAG0,"^",10) ; field 14
  1. S DATETIME=$P(MAG2,"^",5) ; field 15
  1. S FILEDATA("MODALITY")=MODALITY
  1. S FILEDATA("PARENT FILE")=$P(MAG2,"^",6) ; field 16
  1. S FILEDATA("PARENT IEN")=$P(MAG2,"^",7) ; field 17
  1. S FILEDATA("PARENT FILE PTR")=$P(MAG2,"^",8) ; field 18
  1. S FILEDATA("RAD REPORT")=$P(MAGPACS,"^",2) ; field 61
  1. S FILEDATA("RAD PROC PTR")=$P(MAGPACS,"^",3) ; field 62
  1. S FILEDATA("PACKAGE")=$P(MAG40,"^",1) ; field 40
  1. ; field 41 is not needed
  1. S FILEDATA("TYPE")=$P(MAG40,"^",3) ; field 42
  1. S FILEDATA("PROC/EVENT")=$P(MAG40,"^",4) ; field 43
  1. S FILEDATA("SPEC/SUBSPEC")=$P(MAG40,"^",5) ; field 44
  1. S FILEDATA("ACQUISITION DEVICE")=$P(MAG100,"^",4) ; field 107
  1. ; get the SOP Class pointer (file 2005, field 251)
  1. S SOPCLASP=$O(^MAG(2006.532,"B",SOPCLASS,""))
  1. S FILEDATA("SOP CLASS POINTER")=SOPCLASP
  1. S PROCDESC=$P(MAG2,"^",4) ; field 10
  1. ; S X="" F S X=$O(FILEDATA(X)) Q:X="" I FILEDATA(X)="" K FILEDATA(X)
  1. I PROCDESC?.E1" (#".N1")" S PROCDESC=$P(PROCDESC," (#")
  1. ; lookup patient in VistA database - needed to build VADM array
  1. S DIQUIET=1 D DEM^VADPT
  1. Q
  1. ;
  1. LOOKUP() ; lookup the patient/study using cross-reference
  1. K DFN
  1. S ACNUMB=CASENUMB
  1. I IMGSVC="RAD" D ; radiology storage SCP port
  1. . D RADLKUP^MAGDIR8A
  1. . I '$D(DFN) D ; may be a consult procedure
  1. . . D CONLKUP^MAGDIR8A
  1. . . I $D(DFN) S IMGSVC="CON" ; it was a consult
  1. . . E D ; may be a lab procedure
  1. . . . D LABLKUP^MAGDIR8A
  1. . . . I $D(DFN) S IMGSVC="LAB" ; it was a lab procedure
  1. . . Q
  1. . Q
  1. E I IMGSVC="CON" D ; consult storage SCP port
  1. . D CONLKUP^MAGDIR8A
  1. . I '$D(DFN) D ; may be a radiology or lab procedure
  1. . . D RADLKUP^MAGDIR8A
  1. . . I $D(DFN) S IMGSVC="RAD" ; it was a radiology procedure
  1. . . E D ; may be a lab procedure
  1. . . . D LABLKUP^MAGDIR8A
  1. . . . I $D(DFN) S IMGSVC="LAB" ; it was a lab procedure
  1. . . . Q
  1. . . Q
  1. . Q
  1. E I IMGSVC="LAB" D ; lab lookup
  1. . D LABLKUP^MAGDIR8A
  1. . I '$D(DFN) D ; may be a radiology or consult procedure
  1. . . D RADLKUP^MAGDIR8A
  1. . . I $D(DFN) S IMGSVC="RAD" ; it was a radiology procedure
  1. . . E D ; may be a consult procedure
  1. . . . D CONLKUP^MAGDIR8A
  1. . . . I $D(DFN) S IMGSVC="CON" ; it was a consult
  1. . . . Q
  1. . . Q
  1. . Q
  1. E D Q 4 ; undefined imaging service - same as error #3 in NEWIMAGE
  1. . K MSG
  1. . S MSG(1)="Undefined Imaging Service: "_IMGSVC
  1. . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
  1. . Q
  1. Q 0
  1. ;
  1. ERRCHECK(FUNCTION,ROUTINE,MSG) ; check the return code of the function
  1. N ERRCODE
  1. S ERRCODE=FUNCTION
  1. I ERRCODE D
  1. . N I
  1. . S I=$O(MSG(""),-1)
  1. . S I=I+1,MSG(I)="A problem was encountered by routine "_ROUTINE_ " Error Code: """_ERRCODE_""""
  1. . Q
  1. Q ERRCODE