| 1 | MAGDLBAA ;WOIFO/LB - Routine to move failed dicom images to ^MAG(2006.575 ; 03/08/2005  07:04
 | 
|---|
| 2 |  ;;3.0;IMAGING;**11,51**;26-August-2005
 | 
|---|
| 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 |  ;; |                                                               |
 | 
|---|
| 11 |  ;; | The Food and Drug Administration classifies this software as  |
 | 
|---|
| 12 |  ;; | a medical device.  As such, it may not be changed in any way. |
 | 
|---|
| 13 |  ;; | Modifications to this software may result in an adulterated   |
 | 
|---|
| 14 |  ;; | medical device under 21CFR820, the use of which is considered |
 | 
|---|
| 15 |  ;; | to be a violation of US Federal Statutes.                     |
 | 
|---|
| 16 |  ;; +---------------------------------------------------------------+
 | 
|---|
| 17 |  ;;
 | 
|---|
| 18 |  Q
 | 
|---|
| 19 | MOVE ;called from MAGDIR1 to move entries not matching Radiology case #.
 | 
|---|
| 20 |  ;Not done thru FM because the system should be independent.
 | 
|---|
| 21 |  ;These variable are needed to be defined before using this routine:
 | 
|---|
| 22 |  ;PIDCHECK, FIRSTDCM, IMGSVC, MIDCM, MACHID,ACNUMB, CASENUMB, PNAMEDCM, PID
 | 
|---|
| 23 |  ;MODALITY, CASETEXT
 | 
|---|
| 24 |  N DATE,REASON,IEN,NIEN,ORIG,DCMPNME,CASE,CASENUM,PATIENT
 | 
|---|
| 25 |  D NOW^%DTC S DATE=X
 | 
|---|
| 26 |  ;ADD ENTRY
 | 
|---|
| 27 |  L +^MAGD(2006.575,0):1E9 ; Background process MUST wait
 | 
|---|
| 28 |  S X=$G(^MAGD(2006.575,0))
 | 
|---|
| 29 |  S $P(X,"^",1,2)="DICOM FAILED IMAGES^2006.575"
 | 
|---|
| 30 |  S IEN=$O(^MAGD(2006.575," "),-1)+1,$P(X,"^",3)=IEN
 | 
|---|
| 31 |  S $P(X,"^",4)=$P(X,"^",4)+1 ; # entries
 | 
|---|
| 32 |  S ^MAGD(2006.575,0)=X
 | 
|---|
| 33 |  ;
 | 
|---|
| 34 |  S REASON=$P(PIDCHECK,",",2)
 | 
|---|
| 35 |  S PATIENT=LASTDCM_","_FIRSTDCM_$S($L(MIDCM)>0:" "_MIDCM,1:"")
 | 
|---|
| 36 |  S MACHID=$G(MACHID,"A")
 | 
|---|
| 37 |  ; PNAMEDCM usually contains an "^" between last & first name
 | 
|---|
| 38 |  ; CHANGE ^ TO ~
 | 
|---|
| 39 |  S CASE=$TR(ACNUMB,"^","~"),CASENUM=$TR(CASENUMB,"^","~")
 | 
|---|
| 40 |  S DCMPNME=$TR(PNAMEDCM,"^","~")
 | 
|---|
| 41 |  S ^MAGD(2006.575,IEN,0)=FROMPATH_"^"_REASON_"^"_PID_"^"_PATIENT_"^"_DCMPNME
 | 
|---|
| 42 |  S ^MAGD(2006.575,IEN,1)=CASE_"^"_CASENUM_"^"_DATE_"^"_MACHID_"^"_LOCATION
 | 
|---|
| 43 |  S ^MAGD(2006.575,IEN,"AIUID")=$G(IMAGEUID)
 | 
|---|
| 44 |  S ^MAGD(2006.575,IEN,"ASUID")=STUDYUID
 | 
|---|
| 45 |  S ^MAGD(2006.575,IEN,"AMFG")=$G(INSTNAME)_"^"_$G(ROWS)_"^"_$G(COLUMNS)_"^"_$G(OFFSET)_"^"_$G(MODIEN)_"^"_$G(MODALITY)_"^"_$$UP^MAGDFCNV($G(MFGR))_"^"_$$UP^MAGDFCNV($G(MODEL))_"^"_LOCATION
 | 
|---|
| 46 |  S ^MAGD(2006.575,IEN,"ACSTXT")=$G(CASETEXT)
 | 
|---|
| 47 |  ; Image type can be RAD, MEDICINE, SURGERY, etc.
 | 
|---|
| 48 |  S ^MAGD(2006.575,IEN,"TYPE")=$G(IMGSVC)
 | 
|---|
| 49 |  ;Setting xrefs
 | 
|---|
| 50 |  S ^MAGD(2006.575,"B",FROMPATH,IEN)=""
 | 
|---|
| 51 |  ; Clean up---no longer need this cross reference
 | 
|---|
| 52 |  K ^MAGD(2006.575,"D") ; Used for Consults only
 | 
|---|
| 53 |  L -^MAGD(2006.575,0)
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 |  ;The following xref ("F") will be set on the 1st entry having a unique
 | 
|---|
| 56 |  ;STUDYUID. The remaining entries with the same # will be added
 | 
|---|
| 57 |  ;to the RELATED IMAGES multiple field for the entry that set the
 | 
|---|
| 58 |  ;F xref.
 | 
|---|
| 59 |  S ORIG=0
 | 
|---|
| 60 |  I '$D(^MAGD(2006.575,"F",LOCATION,STUDYUID)) D  Q  ; Quit if 1st entry
 | 
|---|
| 61 |  . S ^MAGD(2006.575,"F",LOCATION,STUDYUID,IEN)=""
 | 
|---|
| 62 |  . Q
 | 
|---|
| 63 |  S ORIG=$O(^MAGD(2006.575,"F",LOCATION,STUDYUID,0))
 | 
|---|
| 64 |  Q:'ORIG
 | 
|---|
| 65 |  I ORIG'=IEN D
 | 
|---|
| 66 |  . I '$D(^MAGD(2006.575,ORIG,"RLATE",0)) D
 | 
|---|
| 67 |  . . S ^MAGD(2006.575,ORIG,"RLATE",0)="^2006.57526PA^^"
 | 
|---|
| 68 |  . S NIEN=$P(^MAGD(2006.575,ORIG,"RLATE",0),"^",3),NIEN=NIEN+1
 | 
|---|
| 69 |  . S $P(^MAGD(2006.575,ORIG,"RLATE",0),"^",3)=NIEN ; #next ien entry
 | 
|---|
| 70 |  . S $P(^MAGD(2006.575,ORIG,"RLATE",0),"^",4)=$P(^MAGD(2006.575,ORIG,"RLATE",0),"^",4)+1 ; #record for multiple field
 | 
|---|
| 71 |  . S ^MAGD(2006.575,ORIG,"RLATE",NIEN,0)=IEN
 | 
|---|
| 72 |  . S ^MAGD(2006.575,ORIG,"RLATE","B",IEN,NIEN)=""
 | 
|---|
| 73 |  . Q
 | 
|---|
| 74 |  Q
 | 
|---|
| 75 |  ;
 | 
|---|