source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDLBAA.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1MAGDLBAA ;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
19MOVE ;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 ;
Note: See TracBrowser for help on using the repository browser.