[613] | 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 | ;
|
---|