| 1 | MAGDCCS ;WOIFO/MLH - DICOM Correct - Clinical Specialties ; 12/15/2006 13:50
|
|---|
| 2 | ;;3.0;IMAGING;**10,11,85**;16-March-2007;;Build 1039
|
|---|
| 3 | ;; Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;; +---------------------------------------------------------------+
|
|---|
| 5 | ;; | Property of the US Government. |
|
|---|
| 6 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 7 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 8 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 9 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 10 | ;; | telephone (301) 734-0100. |
|
|---|
| 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 | L ;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,ANSR,CASENO,COMNT1,DATA,DATA1,DATA2,DATE,FILE,FIRST,FIRSTS
|
|---|
| 24 | N MACHID,MAGDY,MAGDIEN,MAGIEN,MAGTYPE,MSG,START,STOP
|
|---|
| 25 | N MOD,MODEL,NEWCAS,NEWDFN,NEWDTI,NEWDTIM,NEWMUL,NEWNME,NEWPIEN,NEWPROC
|
|---|
| 26 | N NEWSSN,OK,OOUT,OUT,PAT,PID,PP,PREV,PREVS,REASON,STUDYUID,WHY,MAGFIX
|
|---|
| 27 | N KFIXALL ; --- does user hold MAGDFIX ALL key
|
|---|
| 28 | N GWLOC ; -- gateway site
|
|---|
| 29 | ;
|
|---|
| 30 | S KFIXALL=$$SECKEY^MAGDLB12()
|
|---|
| 31 | I '$D(^MAGD(2006.575,"F")) W !,"Nothing to process!" Q
|
|---|
| 32 | S (OOUT,OUT,PREV,FIRST)=0
|
|---|
| 33 | S GWLOC=0
|
|---|
| 34 | F S GWLOC=$O(^MAGD(2006.575,"F",GWLOC)) Q:'GWLOC D
|
|---|
| 35 | . S SUID=""
|
|---|
| 36 | . F S SUID=$O(^MAGD(2006.575,"F",GWLOC,SUID)) Q:SUID=""!(OOUT) D
|
|---|
| 37 | . . S MAGIEN=$O(^MAGD(2006.575,"F",GWLOC,SUID,0)) Q:'MAGIEN
|
|---|
| 38 | . . ; if no main failed image rec, there's a xref prob, so bail
|
|---|
| 39 | . . I '$D(^MAGD(2006.575,MAGIEN,0)) D Q ; clean up xref
|
|---|
| 40 | . . . K ^MAGD(2006.575,"F",GWLOC,SUID,MAGIEN)
|
|---|
| 41 | . . . Q
|
|---|
| 42 | . . ;Only process clinical specialties images... radiology and medicine images done by other rtns.
|
|---|
| 43 | . . S MAGTYPE=$P($G(^MAGD(2006.575,MAGIEN,"TYPE")),"^") I MAGTYPE'="CON" Q
|
|---|
| 44 | . . I $D(^MAGD(2006.575,MAGIEN,"FIXD")),$P(^MAGD(2006.575,MAGIEN,"FIXD"),"^") Q
|
|---|
| 45 | . . I 'FIRST S PREV=MAGIEN,PREVS=SUID,FIRST=MAGIEN
|
|---|
| 46 | . . D SET
|
|---|
| 47 | . Q
|
|---|
| 48 | Q
|
|---|
| 49 | DISPLAY ;
|
|---|
| 50 | S OUT=0
|
|---|
| 51 | W !,"**************Processing entry**********"
|
|---|
| 52 | W !!,?2,"PATIENT: ",PAT,?50,"SSN: ",PID,!,"Request/Consultation #: ",CASENO
|
|---|
| 53 | W !,?2,"Equipment: ",MOD,?50,"Model: ",MODEL
|
|---|
| 54 | W !,?2,"Date Processed: ",DATE,?50,"Problem with: ",REASON
|
|---|
| 55 | W !,?2,"Comment: ",COMNT1
|
|---|
| 56 | W !,?2,"Correcting file on server ID: ",MACHID,!,?5,FILE
|
|---|
| 57 | S MSG="Do you want to Correct this entry? "
|
|---|
| 58 | Q
|
|---|
| 59 | NEWCASE ;
|
|---|
| 60 | S NEWDFN=$P(MAGDY,"^"),NEWNME=$P(MAGDY,"^",2),NEWSSN=$P(MAGDY,"^",3)
|
|---|
| 61 | S NEWCAS=$P(MAGDY,"^",4),NEWPROC=$P(MAGDY,"^",5),NEWDTI=$P(MAGDY,"^",6)
|
|---|
| 62 | S NEWMUL=$P(MAGDY,"^",7),NEWPIEN=$P(MAGDY,"^",8),PP=$P(MAGDY,"^",9)
|
|---|
| 63 | Q
|
|---|
| 64 | ASK() ;
|
|---|
| 65 | N ANS,ASK
|
|---|
| 66 | ASK1 S ASK="Y/N/D/Q"
|
|---|
| 67 | I $G(PREV)'=$G(MAGIEN),MAGTYPE="CON" S ASK=ASK_"/P"
|
|---|
| 68 | W !,$G(MSG),"("_ASK_")// " R ANS:600
|
|---|
| 69 | I '$T!(ANS["^") Q "^"
|
|---|
| 70 | I ANS="" Q "N"
|
|---|
| 71 | I "YNDPQyndpq"'[$E(ANS) D G ASK1
|
|---|
| 72 | . W !,"Please respond with one of the following codes."
|
|---|
| 73 | . W !,"Legend: Y=yes, N=no, D=delete, P=Previous entry, and Q=quit",!
|
|---|
| 74 | S ANS=$TR(ANS,"yndpq","YNDPQ")
|
|---|
| 75 | Q $E(ANS)
|
|---|
| 76 | CHK ;remove any punctuation before doing comparison on SSN
|
|---|
| 77 | ;stop on 1st check.
|
|---|
| 78 | N OLD,I
|
|---|
| 79 | S OLD="" F I=1:1:$L(PID) I $E(PID,I)?1AN S OLD=OLD_$E(PID,I)
|
|---|
| 80 | I NEWSSN'=OLD D Q
|
|---|
| 81 | . S MSG="Social Security numbers do not match. Update? "
|
|---|
| 82 | I NEWNME'=PAT D Q
|
|---|
| 83 | . S MSG="Patient names do not match. Update? "
|
|---|
| 84 | ;Finally the problem is with the case number...either no longer in "C"
|
|---|
| 85 | ;xref or invalid number provided
|
|---|
| 86 | S MSG="Accession number different. Update? "
|
|---|
| 87 | Q
|
|---|
| 88 | NEWDIS ;
|
|---|
| 89 | W !,?2,"****Please review the following: *****"
|
|---|
| 90 | W !,?2,"Previous name: ",PAT,!,?2," New name: ",NEWNME
|
|---|
| 91 | W !,?2,"Previous ssn: ",PID,!,?2," New ssn: ",NEWSSN
|
|---|
| 92 | W !,?2,"Previous request/consultation #: ",CASENO,!,?2," New request/consultation #: ",NEWCAS
|
|---|
| 93 | ; Variable PP already has text message about being part of printset.
|
|---|
| 94 | Q
|
|---|
| 95 | UPDT ;
|
|---|
| 96 | N GWLOC ; -- gateway location
|
|---|
| 97 | W !,"Will change the following: " D NEWDIS
|
|---|
| 98 | W !,"Are you sure you want to correct this entry? " S %=2 D YN^DICN
|
|---|
| 99 | I %=-1!(%=2) S OUT=1 Q
|
|---|
| 100 | W !,"Updating the file."
|
|---|
| 101 | S NEWDTIM=$TR(NEWDTI,"0123456789","9876543210")
|
|---|
| 102 | S ^MAGD(2006.575,MAGIEN,"FIXD")="1^"_NEWDFN_"^"_NEWNME_"^"_NEWSSN_"^"_NEWCAS_"^"_NEWDTI_"^"_NEWMUL_"^"_NEWDTIM W "."
|
|---|
| 103 | S ^MAGD(2006.575,MAGIEN,"FIXPR")=NEWPIEN_"^"_NEWPROC W "."
|
|---|
| 104 | ;Same as ^radpt(newdfn,"DT",newdti,"P",newmul,0) & ^RAMIS(71,newpien,0)
|
|---|
| 105 | S GWLOC=$P($G(^MAGD(2006.575,MAGIEN,1)),"^",5)
|
|---|
| 106 | S MACHID=$S(MACHID="":"A",1:MACHID) ; server ID
|
|---|
| 107 | I GWLOC S ^MAGD(2006.575,"AFX",GWLOC,MACHID,MAGIEN)="" W "."
|
|---|
| 108 | E W !,"Gateway place not defined on image entry "_MAGIEN_", continuing.."
|
|---|
| 109 | ;Xref to loop & process entries; processing will be minimal.
|
|---|
| 110 | S MAGFIX(MAGIEN)="F"
|
|---|
| 111 | Q
|
|---|
| 112 | SETDEL ;Entry to be deleted
|
|---|
| 113 | N GWLOC ; -- gateway location
|
|---|
| 114 | D LOGERR I ANS="^" S OUT=1 Q
|
|---|
| 115 | S GWLOC=$P($G(^MAGD(2006.575,MAGIEN,1)),"^",5)
|
|---|
| 116 | I GWLOC S ^MAGD(2006.575,"AFX",GWLOC,MACHID,MAGIEN)="D" W "."
|
|---|
| 117 | E W !,"Gateway place not defined on image entry "_MAGIEN_", continuing.."
|
|---|
| 118 | S $P(^MAGD(2006.575,MAGIEN,0),"^",6)="1"
|
|---|
| 119 | S ^MAGD(2006.575,MAGIEN,"FIXD")=1
|
|---|
| 120 | S MAGFIX(MAGIEN)="D"
|
|---|
| 121 | Q
|
|---|
| 122 | LOGERR ;Need to record error
|
|---|
| 123 | N DIR,DIRUT,DTOUT,ENTRY,I,MAGERR,MAGOUT,X,Y,WHY,WHO
|
|---|
| 124 | W !! F I=1:1:80 W "*"
|
|---|
| 125 | W !,"*** Will log in error log (file 2006.599). ****"
|
|---|
| 126 | D NOW^%DTC
|
|---|
| 127 | S DIR(0)="F^3:30"
|
|---|
| 128 | S DIR("A")="Reason for deletion"
|
|---|
| 129 | S DIR("A",1)="Please enter a reason for deleting."
|
|---|
| 130 | S DIR("A",2)="For example: TEST PATIENT"
|
|---|
| 131 | D ^DIR
|
|---|
| 132 | I $D(DIRUT)!($D(DTOUT))!(Y="") D S ANS="^" Q
|
|---|
| 133 | . W !,"Can not delete if a reason is not provided."
|
|---|
| 134 | . Q
|
|---|
| 135 | S WHY=Y,WHO=$G(DUZ)
|
|---|
| 136 | I WHO D
|
|---|
| 137 | . D GETS^DIQ(200,DUZ,".01","E","MAGOUT","MAGERR")
|
|---|
| 138 | . Q:$D(MAGERR("DIERR"))
|
|---|
| 139 | . S WHO=$G(MAGOUT(200,DUZ_",",.01,"E"))
|
|---|
| 140 | I WHO="" S WHO="UNKNOWN"
|
|---|
| 141 | I '$D(^MAGD(2006.599,0)) D
|
|---|
| 142 | . S ^MAGD(2006.599,0)="Dicom Error Log^2006.599^^"
|
|---|
| 143 | . Q
|
|---|
| 144 | S ENTRY=$P(^MAGD(2006.599,0),"^",3)+1
|
|---|
| 145 | S $P(^MAGD(2006.599,0),"^",3)=ENTRY
|
|---|
| 146 | S $P(^MAGD(2006.599,0),"^",4)=$P(^MAGD(2006.599,0),"^",4)+1
|
|---|
| 147 | S ^MAGD(2006.599,ENTRY,0)=%_"^"_WHY_"^"_FILE_"^"_MODEL
|
|---|
| 148 | S ^MAGD(2006.599,ENTRY,1)=WHO_"^"_PAT_"^"_PID_"^"_CASENO_"^"_MACHID
|
|---|
| 149 | S ^MAGD(2006.599,"B",%,ENTRY)=""
|
|---|
| 150 | Q
|
|---|
| 151 | SET ;
|
|---|
| 152 | S MAGTYPE=$P(^MAGD(2006.575,MAGIEN,"TYPE"),"^")
|
|---|
| 153 | Q:$P($G(^MAGD(2006.575,MAGIEN,"FIXD")),"^") ;Already fixed.
|
|---|
| 154 | ;Only process Clinical Specialties images...radiology & medicine images done by other rtns.
|
|---|
| 155 | I $E(MAGTYPE,1,3)'="CON" Q
|
|---|
| 156 | S DATA=^MAGD(2006.575,MAGIEN,0)
|
|---|
| 157 | S FILE=$P(^MAGD(2006.575,MAGIEN,0),"^")
|
|---|
| 158 | S DATA1=^MAGD(2006.575,MAGIEN,1) ;Case no. info
|
|---|
| 159 | S DATA2=^MAGD(2006.575,MAGIEN,"AMFG") ;Modality info
|
|---|
| 160 | S PAT=$P(DATA,"^",4),PID=$P(DATA,"^",3),REASON=$P(DATA,"^",2)
|
|---|
| 161 | S MOD=$P(DATA2,"^"),MODEL=$P(DATA2,"^",6)
|
|---|
| 162 | S CASENO=$P(DATA1,"^",2),MACHID=$P(DATA1,"^",4)
|
|---|
| 163 | S Y=$P(DATA1,"^",3) X ^DD("DD") S DATE=Y
|
|---|
| 164 | S COMNT1=$G(^MAGD(2006.575,MAGIEN,"ACSTXT")) ;1st line comment.
|
|---|
| 165 | S MACHID=$P(DATA1,"^",4)
|
|---|
| 166 | S ANS="" D DISPLAY S ANS=$$ASK
|
|---|
| 167 | I ANS="Q"!(ANS["^") S (OOUT,OUT)=1 D SETPREV Q
|
|---|
| 168 | I ANS="N" S OUT=1 D SETPREV Q
|
|---|
| 169 | I ANS="P" D CHKPREV Q
|
|---|
| 170 | I ANS="D" D SETDEL,SETPREV Q
|
|---|
| 171 | Q:OUT
|
|---|
| 172 | K MAGDY W !," Lookup by case number or patient name"
|
|---|
| 173 | LOOK ;
|
|---|
| 174 | ;D ^MAGDLB2 Q:'$D(MAGDY) Q:MAGDY'[""
|
|---|
| 175 | D EN^MAGDCCS2 Q:'$D(MAGDY) Q:MAGDY'[""
|
|---|
| 176 | D NEWCASE,CHK,NEWDIS S ANS=$$ASK
|
|---|
| 177 | ;W !,"Sorry, under construction (",$T(+0),")... please try again later.",! Q
|
|---|
| 178 | I ANS="Q"!(ANS["^") S (OOUT,OUT)=1 D SETPREV Q
|
|---|
| 179 | I ANS="D" D SETDEL,SETPREV Q
|
|---|
| 180 | I ANS="P" D CHKPREV Q
|
|---|
| 181 | I ANS="N" S OUT=1 D SETPREV Q
|
|---|
| 182 | Q:OUT
|
|---|
| 183 | D UPDT
|
|---|
| 184 | I ANS="P" D CHKPREV Q
|
|---|
| 185 | D SETMAG
|
|---|
| 186 | Q
|
|---|
| 187 | DATELOOP(START,STOP) ;Loop thru the "AD" cross reference
|
|---|
| 188 | N MAGIEN,SUID,THEDT,FIRST,OOUT,MAGFIX
|
|---|
| 189 | S THEDT=START-.1,(OOUT,FIRST)=0
|
|---|
| 190 | F S THEDT=$O(^MAGD(2006.575,"AD",THEDT)) Q:'THEDT!(THEDT>STOP)!(OOUT) D
|
|---|
| 191 | . S MAGIEN=0
|
|---|
| 192 | . F S MAGIEN=$O(^MAGD(2006.575,"AD",THEDT,MAGIEN)) Q:'MAGIEN D
|
|---|
| 193 | . . I '$D(^MAGD(2006.575,MAGIEN,0)) K ^MAGD(2006.575,"AD",THEDT,MAGIEN)
|
|---|
| 194 | . . I $D(^MAGD(2006.575,MAGIEN,"TYPE")),$E($P(^MAGD(2006.575,MAGIEN,"TYPE"),"^"),1,3)'="CON" Q
|
|---|
| 195 | . . I 'FIRST S PREV=MAGIEN,FIRST=1
|
|---|
| 196 | . . D SET
|
|---|
| 197 | . . Q
|
|---|
| 198 | . Q
|
|---|
| 199 | Q
|
|---|
| 200 | SETPREV ;
|
|---|
| 201 | S PREV=MAGIEN,PREVS=$G(SUID)
|
|---|
| 202 | Q
|
|---|
| 203 | SETMAG ;
|
|---|
| 204 | S FIRST=MAGIEN,FIRSTS=$G(SUID),MAGIEN=PREV,SUID=$G(PREVS)
|
|---|
| 205 | S PREV=FIRST,PREVS=FIRSTS
|
|---|
| 206 | Q
|
|---|
| 207 | CHKPREV ;
|
|---|
| 208 | S OUT=1 N STATUS
|
|---|
| 209 | I '$D(MAGFIX(PREV)) D SETMAG G SET
|
|---|
| 210 | S STATUS=$S($G(MAGFIX(PREV))="D":"deleted",1:"corrected")
|
|---|
| 211 | W !,"Previous entry has been "_STATUS_".",$C(7)
|
|---|
| 212 | G SET
|
|---|
| 213 | Q
|
|---|
