source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDMEDJ.m@ 1147

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1MAGDMEDJ ;WOIFO/LB - Routine to fix failed DICOM entries ; [ 06/20/2001 08:56 ]
2 ;;3.0;IMAGING;;Mar 01, 2002
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
19L ;Loop thru the entire file for entries that need processing
20 ;The "F" xref is set for unique Study UIDs. The entry setting this xref
21 ;will also have a "RLATE" node with all the Xray images associated with
22 ;that unique Study UID.
23 N ANS,CASEDATE,CASENO,COMNT1,DATA,DATA1,DATA2,DATE,FILE,FOUND,MACHID,MAGDY,MAGIEN,MAGDIMG
24 N MAGDIEN,MOD,MODEL,MSG,MAGPAT,MAGTYPE,MEDFILE
25 N NEWCAS,NEWDFN,NEWDTI,NEWDTIM,NEWMUL,NEWNME,NEWPIEN,NEWPROC,NEWSSN
26 N OOUT,OUT,PAT,PID,REASON,STUDYUID,JJ,ITEM
27 I '$D(^MAGD(2006.575,"F")) W !,"Nothing to process!" Q
28 S (MAGIEN,STUDYUID,OOUT,OUT)=0
29 F S STUDYUID=$O(^MAGD(2006.575,"F",STUDYUID)) Q:STUDYUID<1!(OOUT) D
30 . S MAGIEN=$O(^MAGD(2006.575,"F",STUDYUID,0)) Q:'MAGIEN
31 . Q:'$D(^MAGD(2006.575,MAGIEN,0))
32 . Q:$P($G(^MAGD(2006.575,MAGIEN,"FIXD")),"^") ;Already fixed.
33 . ; Only Medicine images
34 . S MAGTYPE=$G(^MAGD(2006.575,MAGIEN,"TYPE"))
35 . Q:MAGTYPE'["MED"
36 . ; Only Medicine images need to be fixed thru this program.
37 . S DATA=^MAGD(2006.575,MAGIEN,0),FILE=$P(^(0),"^")
38 . S DATA1=^MAGD(2006.575,MAGIEN,1) ;Case no. info
39 . S DATA2=^MAGD(2006.575,MAGIEN,"AMFG") ;Modality info
40 . S PAT=$P(DATA,"^",4),PID=$P(DATA,"^",3),REASON=$P(DATA,"^",2)
41 . S MOD=$P(DATA2,"^"),MODEL=$P(DATA2,"^",6)
42 . S CASENO=$P(DATA1,"^",2),CASEDATE=$P(DATA1,"^",3)
43 . S MACHID=$P(DATA1,"^",4),DATE=CASEDATE
44 . S COMNT1=$G(^MAGD(2006.575,MAGIEN,"ACSTXT")) ;1st line comment.
45 . ; Use patient information send via DICOM FILE
46 . S MEDFILE=$$FILE^MAGDMEDI($P(CASENO,"-"))
47 . D DISPLAY S ANS=$$ASK^MAGDLB1 I ANS="Q"!(ANS["^") S (OOUT,OUT)=1 Q
48 . I ANS="N" S OUT=1 Q
49 . I ANS="D" D SETDEL Q
50 . Q:OUT
51 . K MAGDY W !," Lookup patient name",!
52 . S MAGPAT=$$PATLK^MCARUTL2
53 . I 'MAGPAT D Q
54 . . W !,"Can not update if patient can not be identified.",$C(7)
55 . ; If patient name could not be determined then we can not correct.
56 . D PATSUB^MAGDMEDK(.MAGSUB,MAGPAT)
57 . Q:'$D(MAGSUB)#10 ;No subspecialties found
58 . ;Q:'$D(MAGMC)#10 ;No Medicine entries found
59 . ; Select subspecialty
60 . S SUB=$$DISPLAY^MAGDMEDL(.MAGSUB) I 'SUB D Q
61 . . W !,"No specialty selected"
62 . S SUB=$P(MAGSUB(SUB),"^"),SUB=$P(SUB,"(",2),SUB=$P(SUB,")",1)
63 . D SUB^MAGDMEDK(SUB,MAGPAT)
64 . I '$D(MAGMC)#10 D Q
65 . . W !,"No entries were found for the selected specialty."
66 . D LOOP^MAGDMEDL(.XX,MAGPAT,SUB,CASEDATE)
67 . ;S ITEM=$$DISPLAY^MAGDMEDL(.XX) I 'ITEM D
68 . ;. W !,"No entry selected."
69 . I $D(XX(0)),$P(XX(0),"^")=0 D Q:MAGDOUT
70 . . S MAGDOUT=0
71 . . W !,"No Medicine file entries found for this patient"
72 . . W !,"on the date/time the image was captured."
73 . . S FOUND=$$ASKMORE^MAGDMEDL I 'FOUND S MAGDOUT=1
74 . S ITEM=$$DISPLAY^MAGDMEDL(.XX) I 'ITEM D Q
75 . . W !,"Can not update if Medicine file entry can not be found.",$C(7)
76 . D NEWCASE,CHK,NEWDIS S ANS=$$ASK^MAGDLB1 I ANS="D" D SETDEL Q
77 . I ANS="Q"!(ANS["^") S (OOUT,OUT)=1 Q
78 . I ANS="N" S OUT=1 Q
79 . Q:OUT D UPDT
80 K OUT,OOUT,ANS,MAGDOUT,MAGMC,MAGSUB,SUB,XX
81 Q
82DISPLAY ;
83 D DISPLAY^MAGDLB1
84 Q
85NEWCASE ;
86 Q:'$D(XX(0))
87 Q:'$D(XX(ITEM,1))
88 S MAGDY=$G(XX(ITEM,1)) ;W !,MAGDY
89 I MAGDY="" Q
90 S NEWDFN=MAGPAT,NEWNME=$P(MAGDY,"^",2),NEWSSN=$P(MAGDY,"^",3)
91 S NEWCAS=$P(MAGDY,"^",1),NEWPROC=$P(MAGDY,"^",5),NEWDTI=$P(MAGDY,"^",4)
92 S NEWPIEN=$P(MAGDY,"^",6),MAGDIMG=$P(MAGDY,"^",7),MEDFILE=$P(MAGDY,"^",8)
93 Q
94CHK ;remove any punctuation before doing comparison on SSN
95 ;stop on 1st check.
96 N OLD,I
97 Q:MAGDY=""
98 S OLD="" F I=1:1:$L(PID) I $E(PID,I)?1AN S OLD=OLD_$E(PID,I)
99 I NEWSSN'=OLD D Q
100 . S MSG="Social Security numbers do not match. Update?"
101 I NEWNME'=PAT D
102 . S MSG="Patient names do not match. Update?"
103 ;Finally the problem is with the case number/DICOM ID
104 S MSG="DICOM ID number is different. Update?"
105 Q
106NEWDIS ;
107 D NEWDIS^MAGDLB1
108 Q
109UPDT ;
110 ;S OUT=1 W !,"Will change the following: " D NEWDIS
111 W !,"Are you sure you want to CORRECT?" S %=2 D YN^DICN
112 I %=-1!(%=2) S OUT=1 Q
113 W !,"Updating the file."
114 S ^MAGD(2006.575,MAGIEN,"FIXD")="1^"_NEWDFN_"^"_NEWNME_"^"_NEWSSN_"^"_NEWCAS_"^"_NEWDTI_"^^^"_NEWPIEN W "."
115 S ^MAGD(2006.575,MAGIEN,"FIXPR")=NEWPIEN_"^"_NEWPROC_"^"_$G(MAGDIMG)_"^"_MEDFILE W "."
116 S MACHID=$S(MACHID="":"A",1:MACHID) ;Server ID
117 S ^MAGD(2006.575,"AFX",MACHID,MAGIEN)="" W "."
118 Q
119SETDEL ;Entry to be deleted
120 D SETDEL^MAGDLB1
121 Q
122ASKWHCH ;More than one patient found with same name
123 S MAGPAT=""
124 N ITEM
125 Q:'$D(JJ(0))
126 S ITEM=$$DISPLAY^MAGDMEDL(.JJ)
127 I ITEM S MAGPAT=$P(JJ(+ITEM,1),"^",3)
128 Q
Note: See TracBrowser for help on using the repository browser.