- MAGDIR8R ;WOIFO/PMK - Automatic Import Reconciliation Workflow ; 27 Sep 2010 1:00 PM
- ;;3.0;IMAGING;**53,49**;Mar 19, 2002;Build 2033;Apr 07, 2011
- ;; Per VHA Directive 2004-038, this routine should not be modified.
- ;; +---------------------------------------------------------------+
- ;; | Property of the US Government. |
- ;; | No permission to copy or redistribute this software is given. |
- ;; | Use of unreleased versions of this software requires the user |
- ;; | to execute a written test agreement with the VistA Imaging |
- ;; | Development Office of the Department of Veterans Affairs, |
- ;; | telephone (301) 734-0100. |
- ;; | The Food and Drug Administration classifies this software as |
- ;; | a medical device. As such, it may not be changed in any way. |
- ;; | Modifications to this software may result in an adulterated |
- ;; | medical device under 21CFR820, the use of which is considered |
- ;; | to be a violation of US Federal Statutes. |
- ;; +---------------------------------------------------------------+
- ;;
- ;
- DISPLAY ;Display a study
- N HEADING ;-- title of display
- N IEN ;------ internal entry number in DATAFILE
- N MACHID ;--- machine id (hostname)
- N MODALITY ;- DICOM modality, for counting how many images
- N NONE ;----- flag indicating whether or not there are studies
- N PNAMEDCM ;- patient name in DICOM format
- N SERIEUID ;- DICOM series instance uid
- N STUDYUID ;- DICOM study instance uid array
- N I,J,K,X
- ;
- S IOF="#" ; remove this later
- ;
- S HEADING="DICOM Images that need to be Reconciled and Imported"
- S X=$$BUILD()
- S NONE=1,MACHID=""
- F S MACHID=$O(^TMP("MAG",$J,"IRWF",MACHID)) Q:MACHID="" D
- . D DISPLAY1
- . D CONTINUE
- . Q
- I NONE W !!,"No images to correct" D CONTINUE
- Q
- ;
- DISPLAY1 ; Display for one machine
- N DATA ;----- data about the entry
- D HEADING
- S I=0 F S I=$O(^TMP("MAG",$J,"IRWF",MACHID,I)) Q:'I D
- . I '$$GETDATA(I,"LIST",.DATA) Q
- . S NONE=0 ; there are studies to correct
- . I $Y>43 D CONTINUE,HEADING
- . W !,$J(I,3),")"
- . W ?5,$J(DATA("PID"),14) ; DoD pid is 14 characters: FP/123-45-6789
- . W ?20,$E($$NAME(DATA("PNAMEDCM")),1,25)
- . W ?47,DATA("ACNUMB"),?64,$$DATE(DATA("STUDYDAT"),"S")
- . W ?72
- . S MODALITY=""
- . F S MODALITY=$O(^TMP("MAG",$J,"IRWF",MACHID,I,"MOD",MODALITY)) Q:MODALITY="" D
- . . W " ",MODALITY,"=",^TMP("MAG",$J,"IRWF",MACHID,I,"MOD",MODALITY)
- . . Q
- . Q
- Q
- ;
- HEADING ; output the heading
- N TAB,X
- S X=HEADING_" ("_MACHID_")"
- S TAB=(80-$L(X))/2
- W @IOF,?TAB,X
- W !?TAB,$TR($J("",$L(X))," ","-")
- W !!," #",?7,"Patient ID",?22,"DICOM Patient Name"
- W ?49,"Accession #",?66,"Date",?73,"Images"
- W !,"----",?5,"--------------",?20,"-------------------------",?47,"----------------"
- W ?64,"--------",?73,"------"
- Q
- ;
- NAME(NAME) ; convert person name from DICOM format to displayable one
- N CHAR,I,X
- S X=""
- F I=1:1:$L(NAME) D
- . S CHAR=$E(NAME,I)
- . I CHAR="^" D
- . . ; the first "^" becomes a comma, while the others become spaces
- . . S X=X_$S($F(NAME,"^")=(I+1):",",1:" ")
- . . Q
- . E S X=X_$E(NAME,I)
- Q X
- ;
- DATE(YYYYMMDD,FORMAT) ; convert date from DICOM format to displayable one
- ; FORMAT: B for birthday mm/dd/yyyy, S for short mm/dd/yy, L for long
- N M
- S FORMAT=$G(FORMAT)
- I FORMAT'="B",FORMAT'="S",FORMAT'="L" Q "Wrong format: "_FORMAT
- I YYYYMMDD="" Q ""
- I YYYYMMDD="<unknown>" Q YYYYMMDD
- I FORMAT="B" Q $E(YYYYMMDD,5,6)_"/"_$E(YYYYMMDD,7,8)_"/"_$E(YYYYMMDD,1,4)
- I FORMAT="S" Q $E(YYYYMMDD,5,6)_"/"_$E(YYYYMMDD,7,8)_"/"_$E(YYYYMMDD,3,4)
- S M=+$E(YYYYMMDD,5,6),M=(3*(M-1))+1
- S M=$E("JanFebMarAprMayJunJulAugSepOctNovDec",M,M+2)
- Q M_" "_(+$E(YYYYMMDD,7,8))_", "_$E(YYYYMMDD,1,4)
- ;
- CONTINUE ; prompt
- R !!,"Press <Enter> to continue...",X:$G(DTIME,1E5)
- Q
- ;
- BUILD() ;
- N COUNT ;---- count of images
- N DATA ;----- data about the entry
- ;
- K ^TMP("MAG",$J,"IRWF")
- S COUNT=0
- ; prevent update of DATAFILE while someone is starting Importer
- L +^MAGD(2006.5752,0):1E9
- S IEN=0 F S IEN=$O(^MAGD(2006.5752,IEN)) Q:'IEN D
- . S X=$$GETDATA(IEN,"IEN",.DATA)
- . S MACHID=DATA("MACHID")
- . S MODALITY=DATA("MODALITY")
- . S STUDYUID=DATA("STUDYUID")
- . S SERIEUID=DATA("SERIEUID")
- . S I=$G(STUDYUID(STUDYUID))
- . I I="" S (I,COUNT)=COUNT+1,STUDYUID(STUDYUID)=COUNT
- . S ^TMP("MAG",$J,"IRWF",MACHID,I,"IEN",SERIEUID,IEN)=""
- . S ^(MODALITY)=$G(^TMP("MAG",$J,"IRWF",MACHID,I,"MOD",MODALITY))+1
- . Q
- L -^MAGD(2006.5752,0)
- Q COUNT
- ;
- GETDATA(I,MODE,DATA) ; get the data from the I-th entry in the DATAFILE
- ; if MODE="LIST", then I is the index into the LIST
- ; if MODE="IEN", then I is the actual internal entry number
- N IEN,J,K,SERIEUID,VARS,X
- K DATA Q:'$G(I) 0 Q:'$D(MODE) 0
- I MODE="LIST" D
- . S SERIEUID=$O(^TMP("MAG",$J,"IRWF",MACHID,I,"IEN",""))
- . S IEN=$O(^TMP("MAG",$J,"IRWF",MACHID,I,"IEN",SERIEUID,""))
- . Q
- E I MODE="IEN" S IEN=I
- E Q 0
- M X=^MAGD(2006.5752,IEN)
- F J=0:1:3 F K=1:1:$L(X(J),"^") I $P(X(J),"^",K)="<unknown>" S $P(X(J),"^",K)=""
- S VARS(0)="PNAME^PID^MACHID" ; 0 = patient level
- S VARS(1)="STUDYDAT^ACNUMB^STUDYUID" ; 1 = study level
- S VARS(2)="MODALITY^SERIEUID" ; 2 = series level
- S VARS(3)="FROMPATH^IMAGEUID" ; 3 = instance level
- F J=0:1:3 D ; iterate through the levels
- . F K=1:1:$L(VARS(J),"^") S DATA($P(VARS(J),"^",K))=$P(X(J),"^",K)
- . Q
- S DATA("PNAMEDCM")=$TR(DATA("PNAME"),"|","^") K DATA("PNAME")
- Q 1
- ;
- STORE ; store an entry
- N I,IEN,PNAME,X
- ; patient data
- S PNAME=$TR(PNAMEDCM,"^","|")
- ; patient data
- S X(0)=PNAME_"^"_PID_"^"_MACHID
- ; study data
- S X(1)=STUDYDAT_"^"_ACNUMB_"^"_STUDYUID
- ; series data
- S X(2)=MODALITY_"^"_SERIEUID
- ; object data
- S X(3)=FROMPATH_"^"_IMAGEUID
- ;
- ; prevent update of DATAFILE while someone is starting Importer
- L +^MAGD(2006.5752,0):1E9 ; serialize name generation code
- I '$D(^MAGD(2006.5752,0)) S ^MAGD(2006.5752,0)="Importable DICOM Objects^^0^0"
- S IEN=$P(^MAGD(2006.5752,0),"^",3)+1
- S $P(^MAGD(2006.5752,0),"^",3,4)=IEN_"^"_IEN
- M ^MAGD(2006.5752,IEN)=X
- L -^MAGD(2006.5752,0)
- S ^MAGD(2006.5752,"C",IMAGEUID,IEN)="" ; index by SOP Instance UID
- S ^MAGD(2006.5752,"D",MACHID,FROMPATH,IEN)="" ; index by file path
- Q
- ;
- DELETE(IMAGEUID,MACHID,OLDPATH) ; remove an entry
- N DUPIEN,RETURN
- L +^MAGD(2006.5752,0):1E9 ; serialize name generation code
- S RETURN=$$DELETE1(IMAGEUID,MACHID,OLDPATH)
- ;
- ; check for duplicate SOP Instances and delete them
- F S DUPIEN=$O(^MAGD(2006.5752,"C",IMAGEUID,"")) Q:'DUPIEN D
- . N MACHID,OLDPATH,RETURN,X
- . M X=^MAGD(2006.5752,DUPIEN)
- . S MACHID=$P(X(0),"^",3),OLDPATH=$P(X(3),"^",1)
- . S RETURN=$$DELETE1(IMAGEUID,MACHID,OLDPATH)
- . Q
- ;
- L -^MAGD(2006.5752,0)
- Q RETURN
- ;
- DELETE1(IMAGEUID,MACHID,OLDPATH) ; remove the single entry
- ; Note: ^MAGD(2006.5752,0) must be locked prior to invocation
- N EXIST,IEN,X
- S IEN=$O(^MAGD(2006.5752,"D",MACHID,OLDPATH,"")) Q:'IEN 0
- M X=^MAGD(2006.5752,IEN)
- ; image uid's should match (defined as zero for MAGDRPCA call)
- I IMAGEUID'=$P(X(3),"^",2) D Q -99
- . K I,MSG
- . S I=0
- . S I=I+1,MSG(I)="IMPORT RECONCILIATION DATABASE FILE DELETION ERROR:"
- . S I=I+1,MSG(I)="The DICOM SOP Instance UIDs don't agree."
- . S I=I+1,MSG(I)="Current UID: "_IMAGEUID
- . S I=I+1,MSG(I)="Previous UID: "_$P(X(3),"^",2)
- . S I=I+1,MSG(I)="Dump of File ^MAGD(2006.5752,"_IEN_")"
- . S I=I+1,MSG(I)="^MAGD(2006.5752,"_IEN_",0)="_X(0)
- . S I=I+1,MSG(I)="^MAGD(2006.5752,"_IEN_",1)="_X(1)
- . S I=I+1,MSG(I)="^MAGD(2006.5752,"_IEN_",2)="_X(2)
- . S I=I+1,MSG(I)="^MAGD(2006.5752,"_IEN_",3)="_X(3)
- . S I=I+1,MSG(I)="Argument 1: "_ARGS
- . S I=I+1,MSG(I)="Argument 2: "_ARG2
- . D BADERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
- . Q
- ; remove the entry
- S EXIST=$D(^MAGD(2006.5752,IEN))
- K ^MAGD(2006.5752,IEN)
- K ^MAGD(2006.5752,"C",IMAGEUID,IEN) ; index by SOP Instance UID
- K ^MAGD(2006.5752,"D",MACHID,OLDPATH,IEN) ; index by file path
- ; Only subtract 1 from #entries, if we're actually deleting one
- I EXIST S $P(^(0),"^",4)=$P(^MAGD(2006.5752,0),"^",4)-1
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIR8R 8167 printed Jan 18, 2025@03:01:39 Page 2
- MAGDIR8R ;WOIFO/PMK - Automatic Import Reconciliation Workflow ; 27 Sep 2010 1:00 PM
- +1 ;;3.0;IMAGING;**53,49**;Mar 19, 2002;Build 2033;Apr 07, 2011
- +2 ;; Per VHA Directive 2004-038, this routine should not be modified.
- +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 ;; | The Food and Drug Administration classifies this software as |
- +11 ;; | a medical device. As such, it may not be changed in any way. |
- +12 ;; | Modifications to this software may result in an adulterated |
- +13 ;; | medical device under 21CFR820, the use of which is considered |
- +14 ;; | to be a violation of US Federal Statutes. |
- +15 ;; +---------------------------------------------------------------+
- +16 ;;
- +17 ;
- DISPLAY ;Display a study
- +1 ;-- title of display
- NEW HEADING
- +2 ;------ internal entry number in DATAFILE
- NEW IEN
- +3 ;--- machine id (hostname)
- NEW MACHID
- +4 ;- DICOM modality, for counting how many images
- NEW MODALITY
- +5 ;----- flag indicating whether or not there are studies
- NEW NONE
- +6 ;- patient name in DICOM format
- NEW PNAMEDCM
- +7 ;- DICOM series instance uid
- NEW SERIEUID
- +8 ;- DICOM study instance uid array
- NEW STUDYUID
- +9 NEW I,J,K,X
- +10 ;
- +11 ; remove this later
- SET IOF="#"
- +12 ;
- +13 SET HEADING="DICOM Images that need to be Reconciled and Imported"
- +14 SET X=$$BUILD()
- +15 SET NONE=1
- SET MACHID=""
- +16 FOR
- SET MACHID=$ORDER(^TMP("MAG",$JOB,"IRWF",MACHID))
- if MACHID=""
- QUIT
- Begin DoDot:1
- +17 DO DISPLAY1
- +18 DO CONTINUE
- +19 QUIT
- End DoDot:1
- +20 IF NONE
- WRITE !!,"No images to correct"
- DO CONTINUE
- +21 QUIT
- +22 ;
- DISPLAY1 ; Display for one machine
- +1 ;----- data about the entry
- NEW DATA
- +2 DO HEADING
- +3 SET I=0
- FOR
- SET I=$ORDER(^TMP("MAG",$JOB,"IRWF",MACHID,I))
- if 'I
- QUIT
- Begin DoDot:1
- +4 IF '$$GETDATA(I,"LIST",.DATA)
- QUIT
- +5 ; there are studies to correct
- SET NONE=0
- +6 IF $Y>43
- DO CONTINUE
- DO HEADING
- +7 WRITE !,$JUSTIFY(I,3),")"
- +8 ; DoD pid is 14 characters: FP/123-45-6789
- WRITE ?5,$JUSTIFY(DATA("PID"),14)
- +9 WRITE ?20,$EXTRACT($$NAME(DATA("PNAMEDCM")),1,25)
- +10 WRITE ?47,DATA("ACNUMB"),?64,$$DATE(DATA("STUDYDAT"),"S")
- +11 WRITE ?72
- +12 SET MODALITY=""
- +13 FOR
- SET MODALITY=$ORDER(^TMP("MAG",$JOB,"IRWF",MACHID,I,"MOD",MODALITY))
- if MODALITY=""
- QUIT
- Begin DoDot:2
- +14 WRITE " ",MODALITY,"=",^TMP("MAG",$JOB,"IRWF",MACHID,I,"MOD",MODALITY)
- +15 QUIT
- End DoDot:2
- +16 QUIT
- End DoDot:1
- +17 QUIT
- +18 ;
- HEADING ; output the heading
- +1 NEW TAB,X
- +2 SET X=HEADING_" ("_MACHID_")"
- +3 SET TAB=(80-$LENGTH(X))/2
- +4 WRITE @IOF,?TAB,X
- +5 WRITE !?TAB,$TRANSLATE($JUSTIFY("",$LENGTH(X))," ","-")
- +6 WRITE !!," #",?7,"Patient ID",?22,"DICOM Patient Name"
- +7 WRITE ?49,"Accession #",?66,"Date",?73,"Images"
- +8 WRITE !,"----",?5,"--------------",?20,"-------------------------",?47,"----------------"
- +9 WRITE ?64,"--------",?73,"------"
- +10 QUIT
- +11 ;
- NAME(NAME) ; convert person name from DICOM format to displayable one
- +1 NEW CHAR,I,X
- +2 SET X=""
- +3 FOR I=1:1:$LENGTH(NAME)
- Begin DoDot:1
- +4 SET CHAR=$EXTRACT(NAME,I)
- +5 IF CHAR="^"
- Begin DoDot:2
- +6 ; the first "^" becomes a comma, while the others become spaces
- +7 SET X=X_$SELECT($FIND(NAME,"^")=(I+1):",",1:" ")
- +8 QUIT
- End DoDot:2
- +9 IF '$TEST
- SET X=X_$EXTRACT(NAME,I)
- End DoDot:1
- +10 QUIT X
- +11 ;
- DATE(YYYYMMDD,FORMAT) ; convert date from DICOM format to displayable one
- +1 ; FORMAT: B for birthday mm/dd/yyyy, S for short mm/dd/yy, L for long
- +2 NEW M
- +3 SET FORMAT=$GET(FORMAT)
- +4 IF FORMAT'="B"
- IF FORMAT'="S"
- IF FORMAT'="L"
- QUIT "Wrong format: "_FORMAT
- +5 IF YYYYMMDD=""
- QUIT ""
- +6 IF YYYYMMDD="<unknown>"
- QUIT YYYYMMDD
- +7 IF FORMAT="B"
- QUIT $EXTRACT(YYYYMMDD,5,6)_"/"_$EXTRACT(YYYYMMDD,7,8)_"/"_$EXTRACT(YYYYMMDD,1,4)
- +8 IF FORMAT="S"
- QUIT $EXTRACT(YYYYMMDD,5,6)_"/"_$EXTRACT(YYYYMMDD,7,8)_"/"_$EXTRACT(YYYYMMDD,3,4)
- +9 SET M=+$EXTRACT(YYYYMMDD,5,6)
- SET M=(3*(M-1))+1
- +10 SET M=$EXTRACT("JanFebMarAprMayJunJulAugSepOctNovDec",M,M+2)
- +11 QUIT M_" "_(+$EXTRACT(YYYYMMDD,7,8))_", "_$EXTRACT(YYYYMMDD,1,4)
- +12 ;
- CONTINUE ; prompt
- +1 READ !!,"Press <Enter> to continue...",X:$GET(DTIME,1E5)
- +2 QUIT
- +3 ;
- BUILD() ;
- +1 ;---- count of images
- NEW COUNT
- +2 ;----- data about the entry
- NEW DATA
- +3 ;
- +4 KILL ^TMP("MAG",$JOB,"IRWF")
- +5 SET COUNT=0
- +6 ; prevent update of DATAFILE while someone is starting Importer
- +7 LOCK +^MAGD(2006.5752,0):1E9
- +8 SET IEN=0
- FOR
- SET IEN=$ORDER(^MAGD(2006.5752,IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +9 SET X=$$GETDATA(IEN,"IEN",.DATA)
- +10 SET MACHID=DATA("MACHID")
- +11 SET MODALITY=DATA("MODALITY")
- +12 SET STUDYUID=DATA("STUDYUID")
- +13 SET SERIEUID=DATA("SERIEUID")
- +14 SET I=$GET(STUDYUID(STUDYUID))
- +15 IF I=""
- SET (I,COUNT)=COUNT+1
- SET STUDYUID(STUDYUID)=COUNT
- +16 SET ^TMP("MAG",$JOB,"IRWF",MACHID,I,"IEN",SERIEUID,IEN)=""
- +17 SET ^(MODALITY)=$GET(^TMP("MAG",$JOB,"IRWF",MACHID,I,"MOD",MODALITY))+1
- +18 QUIT
- End DoDot:1
- +19 LOCK -^MAGD(2006.5752,0)
- +20 QUIT COUNT
- +21 ;
- GETDATA(I,MODE,DATA) ; get the data from the I-th entry in the DATAFILE
- +1 ; if MODE="LIST", then I is the index into the LIST
- +2 ; if MODE="IEN", then I is the actual internal entry number
- +3 NEW IEN,J,K,SERIEUID,VARS,X
- +4 KILL DATA
- if '$GET(I)
- QUIT 0
- if '$DATA(MODE)
- QUIT 0
- +5 IF MODE="LIST"
- Begin DoDot:1
- +6 SET SERIEUID=$ORDER(^TMP("MAG",$JOB,"IRWF",MACHID,I,"IEN",""))
- +7 SET IEN=$ORDER(^TMP("MAG",$JOB,"IRWF",MACHID,I,"IEN",SERIEUID,""))
- +8 QUIT
- End DoDot:1
- +9 IF '$TEST
- IF MODE="IEN"
- SET IEN=I
- +10 IF '$TEST
- QUIT 0
- +11 MERGE X=^MAGD(2006.5752,IEN)
- +12 FOR J=0:1:3
- FOR K=1:1:$LENGTH(X(J),"^")
- IF $PIECE(X(J),"^",K)="<unknown>"
- SET $PIECE(X(J),"^",K)=""
- +13 ; 0 = patient level
- SET VARS(0)="PNAME^PID^MACHID"
- +14 ; 1 = study level
- SET VARS(1)="STUDYDAT^ACNUMB^STUDYUID"
- +15 ; 2 = series level
- SET VARS(2)="MODALITY^SERIEUID"
- +16 ; 3 = instance level
- SET VARS(3)="FROMPATH^IMAGEUID"
- +17 ; iterate through the levels
- FOR J=0:1:3
- Begin DoDot:1
- +18 FOR K=1:1:$LENGTH(VARS(J),"^")
- SET DATA($PIECE(VARS(J),"^",K))=$PIECE(X(J),"^",K)
- +19 QUIT
- End DoDot:1
- +20 SET DATA("PNAMEDCM")=$TRANSLATE(DATA("PNAME"),"|","^")
- KILL DATA("PNAME")
- +21 QUIT 1
- +22 ;
- STORE ; store an entry
- +1 NEW I,IEN,PNAME,X
- +2 ; patient data
- +3 SET PNAME=$TRANSLATE(PNAMEDCM,"^","|")
- +4 ; patient data
- +5 SET X(0)=PNAME_"^"_PID_"^"_MACHID
- +6 ; study data
- +7 SET X(1)=STUDYDAT_"^"_ACNUMB_"^"_STUDYUID
- +8 ; series data
- +9 SET X(2)=MODALITY_"^"_SERIEUID
- +10 ; object data
- +11 SET X(3)=FROMPATH_"^"_IMAGEUID
- +12 ;
- +13 ; prevent update of DATAFILE while someone is starting Importer
- +14 ; serialize name generation code
- LOCK +^MAGD(2006.5752,0):1E9
- +15 IF '$DATA(^MAGD(2006.5752,0))
- SET ^MAGD(2006.5752,0)="Importable DICOM Objects^^0^0"
- +16 SET IEN=$PIECE(^MAGD(2006.5752,0),"^",3)+1
- +17 SET $PIECE(^MAGD(2006.5752,0),"^",3,4)=IEN_"^"_IEN
- +18 MERGE ^MAGD(2006.5752,IEN)=X
- +19 LOCK -^MAGD(2006.5752,0)
- +20 ; index by SOP Instance UID
- SET ^MAGD(2006.5752,"C",IMAGEUID,IEN)=""
- +21 ; index by file path
- SET ^MAGD(2006.5752,"D",MACHID,FROMPATH,IEN)=""
- +22 QUIT
- +23 ;
- DELETE(IMAGEUID,MACHID,OLDPATH) ; remove an entry
- +1 NEW DUPIEN,RETURN
- +2 ; serialize name generation code
- LOCK +^MAGD(2006.5752,0):1E9
- +3 SET RETURN=$$DELETE1(IMAGEUID,MACHID,OLDPATH)
- +4 ;
- +5 ; check for duplicate SOP Instances and delete them
- +6 FOR
- SET DUPIEN=$ORDER(^MAGD(2006.5752,"C",IMAGEUID,""))
- if 'DUPIEN
- QUIT
- Begin DoDot:1
- +7 NEW MACHID,OLDPATH,RETURN,X
- +8 MERGE X=^MAGD(2006.5752,DUPIEN)
- +9 SET MACHID=$PIECE(X(0),"^",3)
- SET OLDPATH=$PIECE(X(3),"^",1)
- +10 SET RETURN=$$DELETE1(IMAGEUID,MACHID,OLDPATH)
- +11 QUIT
- End DoDot:1
- +12 ;
- +13 LOCK -^MAGD(2006.5752,0)
- +14 QUIT RETURN
- +15 ;
- DELETE1(IMAGEUID,MACHID,OLDPATH) ; remove the single entry
- +1 ; Note: ^MAGD(2006.5752,0) must be locked prior to invocation
- +2 NEW EXIST,IEN,X
- +3 SET IEN=$ORDER(^MAGD(2006.5752,"D",MACHID,OLDPATH,""))
- if 'IEN
- QUIT 0
- +4 MERGE X=^MAGD(2006.5752,IEN)
- +5 ; image uid's should match (defined as zero for MAGDRPCA call)
- +6 IF IMAGEUID'=$PIECE(X(3),"^",2)
- Begin DoDot:1
- +7 KILL I,MSG
- +8 SET I=0
- +9 SET I=I+1
- SET MSG(I)="IMPORT RECONCILIATION DATABASE FILE DELETION ERROR:"
- +10 SET I=I+1
- SET MSG(I)="The DICOM SOP Instance UIDs don't agree."
- +11 SET I=I+1
- SET MSG(I)="Current UID: "_IMAGEUID
- +12 SET I=I+1
- SET MSG(I)="Previous UID: "_$PIECE(X(3),"^",2)
- +13 SET I=I+1
- SET MSG(I)="Dump of File ^MAGD(2006.5752,"_IEN_")"
- +14 SET I=I+1
- SET MSG(I)="^MAGD(2006.5752,"_IEN_",0)="_X(0)
- +15 SET I=I+1
- SET MSG(I)="^MAGD(2006.5752,"_IEN_",1)="_X(1)
- +16 SET I=I+1
- SET MSG(I)="^MAGD(2006.5752,"_IEN_",2)="_X(2)
- +17 SET I=I+1
- SET MSG(I)="^MAGD(2006.5752,"_IEN_",3)="_X(3)
- +18 SET I=I+1
- SET MSG(I)="Argument 1: "_ARGS
- +19 SET I=I+1
- SET MSG(I)="Argument 2: "_ARG2
- +20 DO BADERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
- +21 QUIT
- End DoDot:1
- QUIT -99
- +22 ; remove the entry
- +23 SET EXIST=$DATA(^MAGD(2006.5752,IEN))
- +24 KILL ^MAGD(2006.5752,IEN)
- +25 ; index by SOP Instance UID
- KILL ^MAGD(2006.5752,"C",IMAGEUID,IEN)
- +26 ; index by file path
- KILL ^MAGD(2006.5752,"D",MACHID,OLDPATH,IEN)
- +27 ; Only subtract 1 from #entries, if we're actually deleting one
- +28 IF EXIST
- SET $PIECE(^(0),"^",4)=$PIECE(^MAGD(2006.5752,0),"^",4)-1
- +29 QUIT 0