MAGD350I ;WOIFO/PMK - Fix problem with JPEG DCM files; Sep 25, 2024@11:14:40
;;3.0;IMAGING;**350**;Mar 19, 2002;Build 4
;; 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. |
;; +---------------------------------------------------------------+
;;
; Private IA #4389 to read the INSTALL file (#9.7)
;;
;;
; These RPC fix a problem caused by MAG*3.0*226 which changed
; the way that Clinical Capture DICOM images were stored so that
; instead of storing them as DICOM objects, they were stored as
; raw JPEG images with a DCM extension.
;
; No other RPCs are to be included in this routine.
Q
;
; FIND JPEG IMAGES THAT HAVE *.DCM EXTENSIONS
ENTRY(OUT,MAXCOUNT,MAGIEN) ; RPC = MAG DICOM P350 MAKE LIST
N ASSOCSITEID,COUNT,IMAGESAVEDT,INST,INSTALLDATE
N PREVIOUSMAGIEN,RETURN,SITE,SITEID,SITELIST,TYPECONSULT
K OUT
S SITEID=$G(DUZ(2)) ; P350 PMK 07/26/2024
I 'SITEID S SITEID=$$KSP^XUPARAM("INST") ; pointer to INSTITUTION file (#4)
;
; build SITELIST - P350 PMK 07/29/2024
S SITE=$O(^MAG(2006.1,"B",SITEID,""))
S SITELIST(SITEID)=""
S INST=0 F S INST=$O(^MAG(2006.1,SITE,"INSTS",INST)) Q:'INST D
. S ASSOCSITEID=$G(^MAG(2006.1,SITE,"INSTS",INST,0))
. S SITELIST(ASSOCSITEID)=""
. Q
;
I '$G(MAXCOUNT) S MAXCOUNT=1000
S COUNT=0
S TYPECONSULT=$O(^MAG(2005.83,"B","CONSULT",""))
;
I '$G(MAGIEN) D ; get MAGIEN value automatically
. S MAGIEN=$G(^MAG(2006.59935,0,"LAST MAGIEN"),0)
. I MAGIEN=0 D ; find first image after MAG*3.0*226 install
. . N NEXTDATE
. . S INSTALLDATE=$$FINDDATE()
. . S MAGIEN=$O(^MAG(2005,"AD",INSTALLDATE,""))
. . I MAGIEN="" D
. . . S NEXTDATE=$O(^MAG(2005,"AD",INSTALLDATE))
. . . S MAGIEN=$O(^MAG(2005,"AD",NEXTDATE,""))
. . . Q
. . Q
. Q
;
F S MAGIEN=$O(^MAG(2005,MAGIEN)) Q:'MAGIEN D Q:COUNT>=MAXCOUNT
. S COUNT=COUNT+1
. S PREVIOUSMAGIEN=MAGIEN
. S RETURN=$$CHECK(MAGIEN,.IMAGESAVEDT,.SITELIST)
. I RETURN="" D
. . N FIXDT,STATUS
. . S STATUS="UNKNOWN"
. . S FIXDT=""
. . D SAVE(MAGIEN,IMAGESAVEDT,STATUS,FIXDT)
. . Q
. Q
S OUT(1)=4
S OUT(2)=COUNT
S OUT(3)=$P($G(^MAG(2006.59935,0)),"^",4)
S OUT(4)=MAGIEN
S OUT(5)=$G(PREVIOUSMAGIEN)
S OUT(6)=$G(IMAGESAVEDT)
Q
;
CHECK(MAGIEN,IMAGESAVEDT,SITELIST) ; check ^MAG(2005) for a *.DCM extension but wrong file type
N ACQSITE,CAPTUREAPP,EXTENSION,FILENAME,NODE0,NODE2,NODE40,SERIESUID,SOPUID,TYPEINDEX
S ACQSITE=$$GET1^DIQ(2005,MAGIEN,.05,"I")
I ACQSITE,'$D(SITELIST(ACQSITE)) Q "-8,Acquistion Site is different"
S NODE0=$G(^MAG(2005,MAGIEN,0)) I NODE0="" Q "-1,NODE0 is null"
S NODE2=$G(^MAG(2005,MAGIEN,2)) I NODE2="" Q "-2,NODE2 is null"
S NODE40=$G(^MAG(2005,MAGIEN,40)) I NODE40="" Q "-3,NODE40 is null"
S SOPUID=$G(^MAG(2005,MAGIEN,"PACS")) ; PACS UID (SOP Instance UID)
I SOPUID="" Q "-4,No SOP Instance UID (""PACS"")" ; can't do DICOM
S SERIESUID=$G(^MAG(2005,MAGIEN,"SERIESUID")) ; SERIES UID
I SERIESUID="" Q "-5,No Series Instance UID" ; can't do DICOM
S IMAGESAVEDT=$P(NODE2,"^",1) ; ; DATE/TIME IMAGE SAVED
S CAPTUREAPP=$P(NODE2,"^",12) ; CAPTURE APPLICATION
; S TYPEINDEX=$P(NODE40,"^",3) ; TYPE INDEX -- removed P350 PMK 09/25/2024
; I TYPEINDEX'=TYPECONSULT Q "1,Type Index is not Consult" -- removed P350 PMK 09/25/2024
S FILENAME=$P(NODE0,"^",2) ; FILEREF
S EXTENSION=$P(FILENAME,".",2) ; EXTENSION
I EXTENSION'="DCM" Q "-6,Not *.DCM file"
I CAPTUREAPP'="C" Q "-7,Not acquired by Capture Client"
Q ""
;
FINDDATE() ; find the install date for MAG*3.0*226
; Start date based on P226 install - P226 introduced the DICOM conversion issue
N A,INSTALLDATE
; shouldn't use FIND1^DIC because it fails if the patch was installed multiple times
D FIND^DIC(9.7,"","17I;@","B","MAG*3.0*226","","","","","A") ; ICR #4389
S INSTALLDATE=$G(A("DILIST","ID",1,17))
S INSTALLDATE=INSTALLDATE\1 ; remove the time
Q INSTALLDATE
;
SAVE(MAGIEN,IMAGESAVEDT,STATUS,FIXDT) ; SAVE/UPDATE
N AUDITIEN,D0,X
S AUDITIEN=MAGIEN ; IMAGE AUDIT file IEN is same as IMAGE file IEN
;
S D0=$O(^MAG(2006.59935,"B",MAGIEN,""))
I D0 Q ; only new entries - no duplicate entries
;
S X=$G(^MAG(2006.59935,0))
S $P(X,"^",1,2)="CLEANUP OF JPEG IMAGES STORED AS DICOM IMAGES^2006.59935"
S D0=$O(^MAG(2006.59935," "),-1)+1 ; Next number
S $P(X,"^",3)=D0
S $P(X,"^",4)=$P(X,"^",4)+1 ; Total count
S ^MAG(2006.59935,0)=X
S ^MAG(2006.59935,D0,0)=MAGIEN_"^"_IMAGESAVEDT_"^"_STATUS_"^"_FIXDT_"^^"_AUDITIEN_"^^^"
S ^MAG(2006.599350,"B",MAGIEN,D0)=""
S ^MAG(2006.599350,"C",STATUS,D0)=""
S ^MAG(2006.59935,0,"LAST MAGIEN")=MAGIEN
Q
;
KILL ; remove the global
K ^MAG(2006.59935)
Q
;
GETNEXT(OUT) ; RPC = MAG DICOM P350 GET NEXT TO FIX
N IEN
K OUT
S IEN=$O(^MAG(2006.59935,"C","UNKNOWN",""))
I IEN D
. S OUT=$G(^MAG(2006.59935,IEN,0))
. Q
E S OUT=""
Q
;
FIXONE(OUT,MAGIEN,NEWSTATUS,ERRORMSG,SOPUID) ; RPC = MAG DICOM P350 FIX ONE IMAGE
N D0,FIXDT,OLDSTATUS,REASONIEN,X
S REASONIEN=$O(^MAG(2005.88,"B","Corrected DICOM image generate",""))
S SOPUID=$G(SOPUID)
K OUT
S ERRORMSG=$G(ERRORMSG)
S D0=$O(^MAG(2006.59935,"B",MAGIEN,""))
I D0'="" D
. S X=$G(^MAG(2006.59935,D0,0)) Q:X=""
. S OLDSTATUS=$P(X,"^",3)
. K ^MAG(2006.59935,"C",OLDSTATUS,D0)
. S ^MAG(2006.59935,"C",NEWSTATUS,D0)=""
. S FIXDT=$$NOW^XLFDT()
. S $P(^MAG(2006.59935,D0,0),"^",3,5)=NEWSTATUS_"^"_FIXDT_"^"_ERRORMSG
. I SOPUID'="" S $P(^MAG(2006.59935,D0,0),"^",7)=SOPUID
. S OUT=0
. ; set STATUS REASON field 113.3 in IMAGE file (#2005)
. I NEWSTATUS="SUCCESS",REASONIEN D
. . N MAGERR,MAGIENS
. . S MAGFDA(2005,MAGIEN_",",113.3)=REASONIEN ; STATUS REASON (-> 2005.8)
. . D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
. . I $D(MAGERR) S OUT="1,Could not update IMAGE file (#2005) with STATUS REASON (#113.3)"
. . Q
. Q
E S OUT="-1,Entry #"_MAGIEN_" not found in file 2006.59935"
Q
;
FIXFAIL(OUT) ; RPC = MAG DICOM P350 FIX FAIL IMAGES
N COUNT,D0,LOWESTIEN,MAGIEN,RESULT,X
S COUNT=0,LOWESTIEN=999999999999999999
S D0="" F S D0=$O(^MAG(2006.59935,"C","FAIL",D0)) Q:D0="" D
. S X=$G(^MAG(2006.59935,D0,0)) Q:X=""
. S MAGIEN=$P(X,"^",1)
. I $O(^MAG(2006.59935,"B",MAGIEN,""))="" Q
. D FIXONE(.RESULT,MAGIEN,"UNKNOWN","1,Fixed for Reprocessing")
. I RESULT'=0 Q
. S COUNT=COUNT+1
. I MAGIEN<LOWESTIEN D
. . S LOWESTIEN=MAGIEN
. . S ^MAG(2006.59935,0,"LAST MAGIEN")=LOWESTIEN-1
. . Q
. Q
S OUT=COUNT
Q
;
UPDATE(OUT) ; RPC = MAG DICOM P350 UPDATE FIELDS
N D0,MAGIEN,NEWIMAGEIEN,REASON,REASONIEN,SOPUID,X
N DOCDATE,IPROCIDX,ISPECIDX,NEWGROUPIEN,SAVEDBY,SHORTDESC
N COMPLETED,ERROR1,ERROR2,NOTPROCESSED,UPDATED
S (COMPLETED,UPDATED,NOTPROCESSED,ERROR1,ERROR2)=0
S REASON="Corrected DICOM image generated by Patch MAG*3.0*350"
S REASONIEN=$O(^MAG(2005.88,"B",$E(REASON,1,30),""))
S (D0,ERROR)=0 F S D0=$O(^MAG(2006.59935,"C","SUCCESS",D0)) Q:D0="" D
. S X=$G(^MAG(2006.59935,D0,0)) I X="" S ERROR1=ERROR1+1 Q
. I $P(X,"^",9)'="" S COMPLETED=COMPLETED+1 Q ; already updated
. S MAGIEN=$P(X,"^",6),SOPUID=$P(X,"^",7)
. I SOPUID="" S ERROR2=ERROR2+1 Q
. S NEWIMAGEIEN=$O(^MAG(2005,"P",SOPUID,""))
. I NEWIMAGEIEN="" S NOTPROCESSED=NOTPROCESSED+1 Q
. S $P(^MAG(2006.59935,D0,0),"^",8)=NEWIMAGEIEN
. S UPDATED=UPDATED+1
. S NEWGROUPIEN=$$GET1^DIQ(2005,NEWIMAGEIEN,14,"I")
. ; get old values from original image in AUDIT file
. N ORIGIN,PACKAGEINDEX,PROCEDURE,TYPEINDEX
. S ORIGIN=$$GET1^DIQ(2005.1,MAGIEN,45,"I")
. S PACKAGEINDEX=$$GET1^DIQ(2005.1,MAGIEN,40,"I")
. S PROCEDURE=$$GET1^DIQ(2005.1,MAGIEN,6,"I")
. S SHORTDESC=$$GET1^DIQ(2005.1,MAGIEN,10,"I")
. S TYPEINDEX=$$GET1^DIQ(2005.1,MAGIEN,42,"I")
. S DOCDATE=$$GET1^DIQ(2005.1,MAGIEN,110,"I")
. S SAVEDBY=$$GET1^DIQ(2005.1,MAGIEN,8,"I")
. S ISPECIDX=$$GET1^DIQ(2005.1,MAGIEN,44,"I")
. S IPROCIDX=$$GET1^DIQ(2005.1,MAGIEN,43,"I")
. ;
. S ERROR=$$DBUPDATE(NEWIMAGEIEN) Q:ERROR ; update the new image
. S ERROR=$$DBUPDATE(NEWGROUPIEN) Q:ERROR ; update the new group
. ;
. S $P(^MAG(2006.59935,D0,0),"^",9)=$$NOW^XLFDT ; record update time
. Q
I ERROR Q
S OUT=COMPLETED_"^"_UPDATED_"^"_NOTPROCESSED_"^"_ERROR1_"^"_ERROR2
Q
;
DBUPDATE(IEN) ; update IMAGE file, either group or image entry
N IENS,MAGERR,MAGFDA
S IENS=IEN_","
; store old values into new entry in IMAGE file
S MAGFDA(2005,IENS,45)=ORIGIN ; ORIGIN
S MAGFDA(2005,IENS,40)=PACKAGEINDEX ; PACKAGE INDEX
S MAGFDA(2005,IENS,6)=PROCEDURE ; PROCEDURE
S MAGFDA(2005,IENS,10)=SHORTDESC ; SHORT DESCRIPTION
S MAGFDA(2005,IENS,42)=TYPEINDEX ; TYPE INDEX (->2005.83)
S MAGFDA(2005,IENS,113.3)=REASONIEN ; STATUS REASON (-> 2005.8)
S MAGFDA(2005,IENS,110)=DOCDATE ; DOCUMENT DATE
S MAGFDA(2005,IENS,8)=SAVEDBY ; IMAGE SAVE BY (->200)
S MAGFDA(2005,IENS,44)=ISPECIDX ; SPEC/SUBSPEC INDEX (-> 2005.84)
S MAGFDA(2005,IENS,43)=IPROCIDX ; PROC/EVENT INDEX (-> 2005.85)
;
D UPDATE^DIE("","MAGFDA","NEWIENS","MAGERR")
I $D(MAGERR) D Q -1
. D DBERROR("-1,Could not update IMAGE file (#2005) for new MAGIEN = "_IEN,.MAGERR)
. Q
K ^MAG(2005,IEN,99) ; remove AUDIT nodes
Q 0
;
DBERROR(CODE,MAGERR) ; generate error message
N I,J,X
K OUT
S X=" DB Error:"
S I="" F S I=$O(MAGERR("DIERR",I)) Q:'I D
. S J="" F J=$O(MAGERR("DIERR",I,"TEXT",J)) D
. . S X=X_" "_MAGERR("DIERR",I,"TEXT",J)
. . Q
. Q
S OUT=CODE_","_X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGD350I 10294 printed Nov 22, 2024@17:09:45 Page 2
MAGD350I ;WOIFO/PMK - Fix problem with JPEG DCM files; Sep 25, 2024@11:14:40
+1 ;;3.0;IMAGING;**350**;Mar 19, 2002;Build 4
+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 ; Private IA #4389 to read the INSTALL file (#9.7)
+18 ;;
+19 ;;
+20 ; These RPC fix a problem caused by MAG*3.0*226 which changed
+21 ; the way that Clinical Capture DICOM images were stored so that
+22 ; instead of storing them as DICOM objects, they were stored as
+23 ; raw JPEG images with a DCM extension.
+24 ;
+25 ; No other RPCs are to be included in this routine.
+26 QUIT
+27 ;
+28 ; FIND JPEG IMAGES THAT HAVE *.DCM EXTENSIONS
ENTRY(OUT,MAXCOUNT,MAGIEN) ; RPC = MAG DICOM P350 MAKE LIST
+1 NEW ASSOCSITEID,COUNT,IMAGESAVEDT,INST,INSTALLDATE
+2 NEW PREVIOUSMAGIEN,RETURN,SITE,SITEID,SITELIST,TYPECONSULT
+3 KILL OUT
+4 ; P350 PMK 07/26/2024
SET SITEID=$GET(DUZ(2))
+5 ; pointer to INSTITUTION file (#4)
IF 'SITEID
SET SITEID=$$KSP^XUPARAM("INST")
+6 ;
+7 ; build SITELIST - P350 PMK 07/29/2024
+8 SET SITE=$ORDER(^MAG(2006.1,"B",SITEID,""))
+9 SET SITELIST(SITEID)=""
+10 SET INST=0
FOR
SET INST=$ORDER(^MAG(2006.1,SITE,"INSTS",INST))
if 'INST
QUIT
Begin DoDot:1
+11 SET ASSOCSITEID=$GET(^MAG(2006.1,SITE,"INSTS",INST,0))
+12 SET SITELIST(ASSOCSITEID)=""
+13 QUIT
End DoDot:1
+14 ;
+15 IF '$GET(MAXCOUNT)
SET MAXCOUNT=1000
+16 SET COUNT=0
+17 SET TYPECONSULT=$ORDER(^MAG(2005.83,"B","CONSULT",""))
+18 ;
+19 ; get MAGIEN value automatically
IF '$GET(MAGIEN)
Begin DoDot:1
+20 SET MAGIEN=$GET(^MAG(2006.59935,0,"LAST MAGIEN"),0)
+21 ; find first image after MAG*3.0*226 install
IF MAGIEN=0
Begin DoDot:2
+22 NEW NEXTDATE
+23 SET INSTALLDATE=$$FINDDATE()
+24 SET MAGIEN=$ORDER(^MAG(2005,"AD",INSTALLDATE,""))
+25 IF MAGIEN=""
Begin DoDot:3
+26 SET NEXTDATE=$ORDER(^MAG(2005,"AD",INSTALLDATE))
+27 SET MAGIEN=$ORDER(^MAG(2005,"AD",NEXTDATE,""))
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 ;
+32 FOR
SET MAGIEN=$ORDER(^MAG(2005,MAGIEN))
if 'MAGIEN
QUIT
Begin DoDot:1
+33 SET COUNT=COUNT+1
+34 SET PREVIOUSMAGIEN=MAGIEN
+35 SET RETURN=$$CHECK(MAGIEN,.IMAGESAVEDT,.SITELIST)
+36 IF RETURN=""
Begin DoDot:2
+37 NEW FIXDT,STATUS
+38 SET STATUS="UNKNOWN"
+39 SET FIXDT=""
+40 DO SAVE(MAGIEN,IMAGESAVEDT,STATUS,FIXDT)
+41 QUIT
End DoDot:2
+42 QUIT
End DoDot:1
if COUNT>=MAXCOUNT
QUIT
+43 SET OUT(1)=4
+44 SET OUT(2)=COUNT
+45 SET OUT(3)=$PIECE($GET(^MAG(2006.59935,0)),"^",4)
+46 SET OUT(4)=MAGIEN
+47 SET OUT(5)=$GET(PREVIOUSMAGIEN)
+48 SET OUT(6)=$GET(IMAGESAVEDT)
+49 QUIT
+50 ;
CHECK(MAGIEN,IMAGESAVEDT,SITELIST) ; check ^MAG(2005) for a *.DCM extension but wrong file type
+1 NEW ACQSITE,CAPTUREAPP,EXTENSION,FILENAME,NODE0,NODE2,NODE40,SERIESUID,SOPUID,TYPEINDEX
+2 SET ACQSITE=$$GET1^DIQ(2005,MAGIEN,.05,"I")
+3 IF ACQSITE
IF '$DATA(SITELIST(ACQSITE))
QUIT "-8,Acquistion Site is different"
+4 SET NODE0=$GET(^MAG(2005,MAGIEN,0))
IF NODE0=""
QUIT "-1,NODE0 is null"
+5 SET NODE2=$GET(^MAG(2005,MAGIEN,2))
IF NODE2=""
QUIT "-2,NODE2 is null"
+6 SET NODE40=$GET(^MAG(2005,MAGIEN,40))
IF NODE40=""
QUIT "-3,NODE40 is null"
+7 ; PACS UID (SOP Instance UID)
SET SOPUID=$GET(^MAG(2005,MAGIEN,"PACS"))
+8 ; can't do DICOM
IF SOPUID=""
QUIT "-4,No SOP Instance UID (""PACS"")"
+9 ; SERIES UID
SET SERIESUID=$GET(^MAG(2005,MAGIEN,"SERIESUID"))
+10 ; can't do DICOM
IF SERIESUID=""
QUIT "-5,No Series Instance UID"
+11 ; ; DATE/TIME IMAGE SAVED
SET IMAGESAVEDT=$PIECE(NODE2,"^",1)
+12 ; CAPTURE APPLICATION
SET CAPTUREAPP=$PIECE(NODE2,"^",12)
+13 ; S TYPEINDEX=$P(NODE40,"^",3) ; TYPE INDEX -- removed P350 PMK 09/25/2024
+14 ; I TYPEINDEX'=TYPECONSULT Q "1,Type Index is not Consult" -- removed P350 PMK 09/25/2024
+15 ; FILEREF
SET FILENAME=$PIECE(NODE0,"^",2)
+16 ; EXTENSION
SET EXTENSION=$PIECE(FILENAME,".",2)
+17 IF EXTENSION'="DCM"
QUIT "-6,Not *.DCM file"
+18 IF CAPTUREAPP'="C"
QUIT "-7,Not acquired by Capture Client"
+19 QUIT ""
+20 ;
FINDDATE() ; find the install date for MAG*3.0*226
+1 ; Start date based on P226 install - P226 introduced the DICOM conversion issue
+2 NEW A,INSTALLDATE
+3 ; shouldn't use FIND1^DIC because it fails if the patch was installed multiple times
+4 ; ICR #4389
DO FIND^DIC(9.7,"","17I;@","B","MAG*3.0*226","","","","","A")
+5 SET INSTALLDATE=$GET(A("DILIST","ID",1,17))
+6 ; remove the time
SET INSTALLDATE=INSTALLDATE\1
+7 QUIT INSTALLDATE
+8 ;
SAVE(MAGIEN,IMAGESAVEDT,STATUS,FIXDT) ; SAVE/UPDATE
+1 NEW AUDITIEN,D0,X
+2 ; IMAGE AUDIT file IEN is same as IMAGE file IEN
SET AUDITIEN=MAGIEN
+3 ;
+4 SET D0=$ORDER(^MAG(2006.59935,"B",MAGIEN,""))
+5 ; only new entries - no duplicate entries
IF D0
QUIT
+6 ;
+7 SET X=$GET(^MAG(2006.59935,0))
+8 SET $PIECE(X,"^",1,2)="CLEANUP OF JPEG IMAGES STORED AS DICOM IMAGES^2006.59935"
+9 ; Next number
SET D0=$ORDER(^MAG(2006.59935," "),-1)+1
+10 SET $PIECE(X,"^",3)=D0
+11 ; Total count
SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
+12 SET ^MAG(2006.59935,0)=X
+13 SET ^MAG(2006.59935,D0,0)=MAGIEN_"^"_IMAGESAVEDT_"^"_STATUS_"^"_FIXDT_"^^"_AUDITIEN_"^^^"
+14 SET ^MAG(2006.599350,"B",MAGIEN,D0)=""
+15 SET ^MAG(2006.599350,"C",STATUS,D0)=""
+16 SET ^MAG(2006.59935,0,"LAST MAGIEN")=MAGIEN
+17 QUIT
+18 ;
KILL ; remove the global
+1 KILL ^MAG(2006.59935)
+2 QUIT
+3 ;
GETNEXT(OUT) ; RPC = MAG DICOM P350 GET NEXT TO FIX
+1 NEW IEN
+2 KILL OUT
+3 SET IEN=$ORDER(^MAG(2006.59935,"C","UNKNOWN",""))
+4 IF IEN
Begin DoDot:1
+5 SET OUT=$GET(^MAG(2006.59935,IEN,0))
+6 QUIT
End DoDot:1
+7 IF '$TEST
SET OUT=""
+8 QUIT
+9 ;
FIXONE(OUT,MAGIEN,NEWSTATUS,ERRORMSG,SOPUID) ; RPC = MAG DICOM P350 FIX ONE IMAGE
+1 NEW D0,FIXDT,OLDSTATUS,REASONIEN,X
+2 SET REASONIEN=$ORDER(^MAG(2005.88,"B","Corrected DICOM image generate",""))
+3 SET SOPUID=$GET(SOPUID)
+4 KILL OUT
+5 SET ERRORMSG=$GET(ERRORMSG)
+6 SET D0=$ORDER(^MAG(2006.59935,"B",MAGIEN,""))
+7 IF D0'=""
Begin DoDot:1
+8 SET X=$GET(^MAG(2006.59935,D0,0))
if X=""
QUIT
+9 SET OLDSTATUS=$PIECE(X,"^",3)
+10 KILL ^MAG(2006.59935,"C",OLDSTATUS,D0)
+11 SET ^MAG(2006.59935,"C",NEWSTATUS,D0)=""
+12 SET FIXDT=$$NOW^XLFDT()
+13 SET $PIECE(^MAG(2006.59935,D0,0),"^",3,5)=NEWSTATUS_"^"_FIXDT_"^"_ERRORMSG
+14 IF SOPUID'=""
SET $PIECE(^MAG(2006.59935,D0,0),"^",7)=SOPUID
+15 SET OUT=0
+16 ; set STATUS REASON field 113.3 in IMAGE file (#2005)
+17 IF NEWSTATUS="SUCCESS"
IF REASONIEN
Begin DoDot:2
+18 NEW MAGERR,MAGIENS
+19 ; STATUS REASON (-> 2005.8)
SET MAGFDA(2005,MAGIEN_",",113.3)=REASONIEN
+20 DO UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
+21 IF $DATA(MAGERR)
SET OUT="1,Could not update IMAGE file (#2005) with STATUS REASON (#113.3)"
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 IF '$TEST
SET OUT="-1,Entry #"_MAGIEN_" not found in file 2006.59935"
+25 QUIT
+26 ;
FIXFAIL(OUT) ; RPC = MAG DICOM P350 FIX FAIL IMAGES
+1 NEW COUNT,D0,LOWESTIEN,MAGIEN,RESULT,X
+2 SET COUNT=0
SET LOWESTIEN=999999999999999999
+3 SET D0=""
FOR
SET D0=$ORDER(^MAG(2006.59935,"C","FAIL",D0))
if D0=""
QUIT
Begin DoDot:1
+4 SET X=$GET(^MAG(2006.59935,D0,0))
if X=""
QUIT
+5 SET MAGIEN=$PIECE(X,"^",1)
+6 IF $ORDER(^MAG(2006.59935,"B",MAGIEN,""))=""
QUIT
+7 DO FIXONE(.RESULT,MAGIEN,"UNKNOWN","1,Fixed for Reprocessing")
+8 IF RESULT'=0
QUIT
+9 SET COUNT=COUNT+1
+10 IF MAGIEN<LOWESTIEN
Begin DoDot:2
+11 SET LOWESTIEN=MAGIEN
+12 SET ^MAG(2006.59935,0,"LAST MAGIEN")=LOWESTIEN-1
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 SET OUT=COUNT
+16 QUIT
+17 ;
UPDATE(OUT) ; RPC = MAG DICOM P350 UPDATE FIELDS
+1 NEW D0,MAGIEN,NEWIMAGEIEN,REASON,REASONIEN,SOPUID,X
+2 NEW DOCDATE,IPROCIDX,ISPECIDX,NEWGROUPIEN,SAVEDBY,SHORTDESC
+3 NEW COMPLETED,ERROR1,ERROR2,NOTPROCESSED,UPDATED
+4 SET (COMPLETED,UPDATED,NOTPROCESSED,ERROR1,ERROR2)=0
+5 SET REASON="Corrected DICOM image generated by Patch MAG*3.0*350"
+6 SET REASONIEN=$ORDER(^MAG(2005.88,"B",$EXTRACT(REASON,1,30),""))
+7 SET (D0,ERROR)=0
FOR
SET D0=$ORDER(^MAG(2006.59935,"C","SUCCESS",D0))
if D0=""
QUIT
Begin DoDot:1
+8 SET X=$GET(^MAG(2006.59935,D0,0))
IF X=""
SET ERROR1=ERROR1+1
QUIT
+9 ; already updated
IF $PIECE(X,"^",9)'=""
SET COMPLETED=COMPLETED+1
QUIT
+10 SET MAGIEN=$PIECE(X,"^",6)
SET SOPUID=$PIECE(X,"^",7)
+11 IF SOPUID=""
SET ERROR2=ERROR2+1
QUIT
+12 SET NEWIMAGEIEN=$ORDER(^MAG(2005,"P",SOPUID,""))
+13 IF NEWIMAGEIEN=""
SET NOTPROCESSED=NOTPROCESSED+1
QUIT
+14 SET $PIECE(^MAG(2006.59935,D0,0),"^",8)=NEWIMAGEIEN
+15 SET UPDATED=UPDATED+1
+16 SET NEWGROUPIEN=$$GET1^DIQ(2005,NEWIMAGEIEN,14,"I")
+17 ; get old values from original image in AUDIT file
+18 NEW ORIGIN,PACKAGEINDEX,PROCEDURE,TYPEINDEX
+19 SET ORIGIN=$$GET1^DIQ(2005.1,MAGIEN,45,"I")
+20 SET PACKAGEINDEX=$$GET1^DIQ(2005.1,MAGIEN,40,"I")
+21 SET PROCEDURE=$$GET1^DIQ(2005.1,MAGIEN,6,"I")
+22 SET SHORTDESC=$$GET1^DIQ(2005.1,MAGIEN,10,"I")
+23 SET TYPEINDEX=$$GET1^DIQ(2005.1,MAGIEN,42,"I")
+24 SET DOCDATE=$$GET1^DIQ(2005.1,MAGIEN,110,"I")
+25 SET SAVEDBY=$$GET1^DIQ(2005.1,MAGIEN,8,"I")
+26 SET ISPECIDX=$$GET1^DIQ(2005.1,MAGIEN,44,"I")
+27 SET IPROCIDX=$$GET1^DIQ(2005.1,MAGIEN,43,"I")
+28 ;
+29 ; update the new image
SET ERROR=$$DBUPDATE(NEWIMAGEIEN)
if ERROR
QUIT
+30 ; update the new group
SET ERROR=$$DBUPDATE(NEWGROUPIEN)
if ERROR
QUIT
+31 ;
+32 ; record update time
SET $PIECE(^MAG(2006.59935,D0,0),"^",9)=$$NOW^XLFDT
+33 QUIT
End DoDot:1
+34 IF ERROR
QUIT
+35 SET OUT=COMPLETED_"^"_UPDATED_"^"_NOTPROCESSED_"^"_ERROR1_"^"_ERROR2
+36 QUIT
+37 ;
DBUPDATE(IEN) ; update IMAGE file, either group or image entry
+1 NEW IENS,MAGERR,MAGFDA
+2 SET IENS=IEN_","
+3 ; store old values into new entry in IMAGE file
+4 ; ORIGIN
SET MAGFDA(2005,IENS,45)=ORIGIN
+5 ; PACKAGE INDEX
SET MAGFDA(2005,IENS,40)=PACKAGEINDEX
+6 ; PROCEDURE
SET MAGFDA(2005,IENS,6)=PROCEDURE
+7 ; SHORT DESCRIPTION
SET MAGFDA(2005,IENS,10)=SHORTDESC
+8 ; TYPE INDEX (->2005.83)
SET MAGFDA(2005,IENS,42)=TYPEINDEX
+9 ; STATUS REASON (-> 2005.8)
SET MAGFDA(2005,IENS,113.3)=REASONIEN
+10 ; DOCUMENT DATE
SET MAGFDA(2005,IENS,110)=DOCDATE
+11 ; IMAGE SAVE BY (->200)
SET MAGFDA(2005,IENS,8)=SAVEDBY
+12 ; SPEC/SUBSPEC INDEX (-> 2005.84)
SET MAGFDA(2005,IENS,44)=ISPECIDX
+13 ; PROC/EVENT INDEX (-> 2005.85)
SET MAGFDA(2005,IENS,43)=IPROCIDX
+14 ;
+15 DO UPDATE^DIE("","MAGFDA","NEWIENS","MAGERR")
+16 IF $DATA(MAGERR)
Begin DoDot:1
+17 DO DBERROR("-1,Could not update IMAGE file (#2005) for new MAGIEN = "_IEN,.MAGERR)
+18 QUIT
End DoDot:1
QUIT -1
+19 ; remove AUDIT nodes
KILL ^MAG(2005,IEN,99)
+20 QUIT 0
+21 ;
DBERROR(CODE,MAGERR) ; generate error message
+1 NEW I,J,X
+2 KILL OUT
+3 SET X=" DB Error:"
+4 SET I=""
FOR
SET I=$ORDER(MAGERR("DIERR",I))
if 'I
QUIT
Begin DoDot:1
+5 SET J=""
FOR J=$ORDER(MAGERR("DIERR",I,"TEXT",J))
Begin DoDot:2
+6 SET X=X_" "_MAGERR("DIERR",I,"TEXT",J)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 SET OUT=CODE_","_X
