MAGDSTD1 ;OI&T-CLIN-THREE/DWM,WOIFO/PMK - accession lookup, including new sops; Feb 15, 2022@10:52:41
;;3.0;Support;**231,305**;Mar 19, 2002;Build 3
;; 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. |
;; +---------------------------------------------------------------+
;
; Controlled IA #2242 reference SETLOG^DGSEC subroutine call
; Supported IA #10026 reference ^DIR subroutine call
; Supported IA #10061 reference DEM^VADPT subroutine call
;
; Original: MAGACCLK by Dave Massey
;
N ACNUMB,SENSEMP,MAGDFN
N OUT,MAGARR,SSEP,Y,DG1,DGOPT,DIC
S SSEP=$$STATSEP^MAGVRS41
;
F S ACNUMB=$$GETACC^MAGVD001() Q:ACNUMB="" D
. ; -- get image data --
. S ACNUMB=$$UP^MAGDFCNV(ACNUMB)
. D GIBYACC^MAGVD007(.OUT,ACNUMB,.MAGARR)
. I OUT<0 W !!,$P(OUT,SSEP,2) Q
. I '$D(MAGARR) D Q
. . W !!,"No images were found for this accession number"
. . Q
. ;
. ; -- get the patient --
. S MAGDFN=MAGARR(1,"MAGDFN")
. ;
. ; -- is sensitive patient? --
. S SENSEMP=$$ISPATSEN^MAGVD001(MAGDFN)
. I SENSEMP,'$$CONFSENS() Q
. ; -- IA #2242 - Log sensitive patient access --
. I SENSEMP D
. . S Y=MAGDFN,DGOPT=$T(+0)_" ACCESSION LOOKUP",(DG1,DIC(0))=""
. . D SETLOG^DGSEC
. . Q
. ;
. D SHOWINFO(ACNUMB,.MAGARR) W !!
. Q
Q
;
SHOWINFO(ACNUMB,MAGARR) ;
; show patient name, procedures, studies, series, #of images/series
N DATABASE,EXTENSION,FILENAME,GROUPIEN,I,IMAGEIEN,MAGARRIX,VA,VAERR,STYIX,RES,X
W !!,"Information on Study for Accession Number: ",ACNUMB S X=$X-1
W ! F W "-" Q:$X>X
S MAGARRIX=0
F S MAGARRIX=$O(MAGARR(MAGARRIX)) Q:'MAGARRIX D
. N DFN,FILETYPE,VADM,STYSERKT,X
. S DATABASE=""
. ; -- new or old sop images --
. I $D(MAGARR(MAGARRIX,"IMAGES")) D
. . S GROUPIEN=$O(MAGARR(MAGARRIX,"IMAGES",""))
. . Q:GROUPIEN="" S RES=MAGARR(MAGARRIX,"IMAGES",GROUPIEN)
. . S DATABASE=$S(RES="":"***#2005 IMAGES***",1:"***NEW SOP IMAGES***")
. . S DATABASE=$S(RES="":"Legacy",1:"** New SOP Class **")
. . Q
. ;
. W !,"Set #",MAGARRIX,": ",DATABASE
. I DATABASE="Legacy" D
. . S GROUPIEN="" W " (Group: "
. . F I=1:1 S GROUPIEN=$O(MAGARR(MAGARRIX,"IMAGES",GROUPIEN)) Q:'GROUPIEN D
. . . W:I>1 ", " W GROUPIEN
. . . Q
. . W ")"
. . Q
. E I DATABASE="** New SOP Class **" D
. . ; don't know what to do here
. . Q
. S DFN=$G(MAGARR(MAGARRIX,"MAGDFN")) D DEM^VADPT
. W !,"PATIENT: ",$G(VADM(1))
. W ?30," SSN: ",$P($G(VADM(2)),"^",2)
. W ?55," DOB: ",$P($G(VADM(3)),"^",2)
. W !,"PROCEDURE: ",$G(MAGARR(MAGARRIX,"PROC"))
. ; -- count studies & series --
. D STYSERKT^MAGVD010(.STYSERKT,$NA(MAGARR(MAGARRIX,"IMAGES")))
. ; get counts of image file extensions
. S IMAGEIEN=""
. F S IMAGEIEN=$O(STYSERKT("IMAGE",IMAGEIEN)) Q:'IMAGEIEN D
. . S X=$G(^MAG(2005,IMAGEIEN,0)),FILENAME=$P(X,"^",2)
. . S FILEEXT=$P(FILENAME,".",$L(FILENAME,".")) ; last "." piece
. . S FILEEXT=$S(FILEEXT="":"FILES WITHOUT EXTENSIONS",1:FILEEXT_" FILES")
. . S FILETYPE(FILEEXT)=$G(FILETYPE(FILEEXT),0)+1
. . Q
. I $G(STYSERKT("STUDY")) D
. . W !,"DICOM -- STUDIES: ",$G(STYSERKT("STUDY"))
. . W ?22," SERIES: ",$G(STYSERKT("SERIES"))
. . I STYSERKT("SERIES") D
. . . W ?37,"IMAGES: ",$G(STYSERKT("IMAGE"))
. . . Q
. . E D ; dicom but missing Series UID
. . . W " -- no series information"
. . . Q
. . Q
. ; output counts of image file extensions
. S EXTENSION=""
. F S EXTENSION=$O(FILETYPE(EXTENSION)) Q:EXTENSION="" D
. . W !,EXTENSION,": ",$G(FILETYPE(EXTENSION))
. . Q
. I $D(STYSERKT("DELETED")) W !,"*** Image Group Deleted ***" ; P305 PMK 12/09/2021
. W !
. Q
Q
;
CONFSENS() ; Continue processing confirmation for sensitive patient
N DIR,X,Y
S DIR("A")="Do you want to continue processing this patient record"
S DIR("A",1)=" *** Sensitive Patient Record *** "
S DIR("A",2)=""
S DIR("?")="Enter 'YES' to continue, 'NO' or '^' to exit"
W $C(7),!! S DIR(0)="Y",DIR("B")="NO" D ^DIR W:'Y *7
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTD1 4848 printed Dec 13, 2024@02:01:53 Page 2
MAGDSTD1 ;OI&T-CLIN-THREE/DWM,WOIFO/PMK - accession lookup, including new sops; Feb 15, 2022@10:52:41
+1 ;;3.0;Support;**231,305**;Mar 19, 2002;Build 3
+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 ; Controlled IA #2242 reference SETLOG^DGSEC subroutine call
+18 ; Supported IA #10026 reference ^DIR subroutine call
+19 ; Supported IA #10061 reference DEM^VADPT subroutine call
+20 ;
+21 ; Original: MAGACCLK by Dave Massey
+22 ;
+23 NEW ACNUMB,SENSEMP,MAGDFN
+24 NEW OUT,MAGARR,SSEP,Y,DG1,DGOPT,DIC
+25 SET SSEP=$$STATSEP^MAGVRS41
+26 ;
+27 FOR
SET ACNUMB=$$GETACC^MAGVD001()
if ACNUMB=""
QUIT
Begin DoDot:1
+28 ; -- get image data --
+29 SET ACNUMB=$$UP^MAGDFCNV(ACNUMB)
+30 DO GIBYACC^MAGVD007(.OUT,ACNUMB,.MAGARR)
+31 IF OUT<0
WRITE !!,$PIECE(OUT,SSEP,2)
QUIT
+32 IF '$DATA(MAGARR)
Begin DoDot:2
+33 WRITE !!,"No images were found for this accession number"
+34 QUIT
End DoDot:2
QUIT
+35 ;
+36 ; -- get the patient --
+37 SET MAGDFN=MAGARR(1,"MAGDFN")
+38 ;
+39 ; -- is sensitive patient? --
+40 SET SENSEMP=$$ISPATSEN^MAGVD001(MAGDFN)
+41 IF SENSEMP
IF '$$CONFSENS()
QUIT
+42 ; -- IA #2242 - Log sensitive patient access --
+43 IF SENSEMP
Begin DoDot:2
+44 SET Y=MAGDFN
SET DGOPT=$TEXT(+0)_" ACCESSION LOOKUP"
SET (DG1,DIC(0))=""
+45 DO SETLOG^DGSEC
+46 QUIT
End DoDot:2
+47 ;
+48 DO SHOWINFO(ACNUMB,.MAGARR)
WRITE !!
+49 QUIT
End DoDot:1
+50 QUIT
+51 ;
SHOWINFO(ACNUMB,MAGARR) ;
+1 ; show patient name, procedures, studies, series, #of images/series
+2 NEW DATABASE,EXTENSION,FILENAME,GROUPIEN,I,IMAGEIEN,MAGARRIX,VA,VAERR,STYIX,RES,X
+3 WRITE !!,"Information on Study for Accession Number: ",ACNUMB
SET X=$X-1
+4 WRITE !
FOR
WRITE "-"
if $X>X
QUIT
+5 SET MAGARRIX=0
+6 FOR
SET MAGARRIX=$ORDER(MAGARR(MAGARRIX))
if 'MAGARRIX
QUIT
Begin DoDot:1
+7 NEW DFN,FILETYPE,VADM,STYSERKT,X
+8 SET DATABASE=""
+9 ; -- new or old sop images --
+10 IF $DATA(MAGARR(MAGARRIX,"IMAGES"))
Begin DoDot:2
+11 SET GROUPIEN=$ORDER(MAGARR(MAGARRIX,"IMAGES",""))
+12 if GROUPIEN=""
QUIT
SET RES=MAGARR(MAGARRIX,"IMAGES",GROUPIEN)
+13 SET DATABASE=$SELECT(RES="":"***#2005 IMAGES***",1:"***NEW SOP IMAGES***")
+14 SET DATABASE=$SELECT(RES="":"Legacy",1:"** New SOP Class **")
+15 QUIT
End DoDot:2
+16 ;
+17 WRITE !,"Set #",MAGARRIX,": ",DATABASE
+18 IF DATABASE="Legacy"
Begin DoDot:2
+19 SET GROUPIEN=""
WRITE " (Group: "
+20 FOR I=1:1
SET GROUPIEN=$ORDER(MAGARR(MAGARRIX,"IMAGES",GROUPIEN))
if 'GROUPIEN
QUIT
Begin DoDot:3
+21 if I>1
WRITE ", "
WRITE GROUPIEN
+22 QUIT
End DoDot:3
+23 WRITE ")"
+24 QUIT
End DoDot:2
+25 IF '$TEST
IF DATABASE="** New SOP Class **"
Begin DoDot:2
+26 ; don't know what to do here
+27 QUIT
End DoDot:2
+28 SET DFN=$GET(MAGARR(MAGARRIX,"MAGDFN"))
DO DEM^VADPT
+29 WRITE !,"PATIENT: ",$GET(VADM(1))
+30 WRITE ?30," SSN: ",$PIECE($GET(VADM(2)),"^",2)
+31 WRITE ?55," DOB: ",$PIECE($GET(VADM(3)),"^",2)
+32 WRITE !,"PROCEDURE: ",$GET(MAGARR(MAGARRIX,"PROC"))
+33 ; -- count studies & series --
+34 DO STYSERKT^MAGVD010(.STYSERKT,$NAME(MAGARR(MAGARRIX,"IMAGES")))
+35 ; get counts of image file extensions
+36 SET IMAGEIEN=""
+37 FOR
SET IMAGEIEN=$ORDER(STYSERKT("IMAGE",IMAGEIEN))
if 'IMAGEIEN
QUIT
Begin DoDot:2
+38 SET X=$GET(^MAG(2005,IMAGEIEN,0))
SET FILENAME=$PIECE(X,"^",2)
+39 ; last "." piece
SET FILEEXT=$PIECE(FILENAME,".",$LENGTH(FILENAME,"."))
+40 SET FILEEXT=$SELECT(FILEEXT="":"FILES WITHOUT EXTENSIONS",1:FILEEXT_" FILES")
+41 SET FILETYPE(FILEEXT)=$GET(FILETYPE(FILEEXT),0)+1
+42 QUIT
End DoDot:2
+43 IF $GET(STYSERKT("STUDY"))
Begin DoDot:2
+44 WRITE !,"DICOM -- STUDIES: ",$GET(STYSERKT("STUDY"))
+45 WRITE ?22," SERIES: ",$GET(STYSERKT("SERIES"))
+46 IF STYSERKT("SERIES")
Begin DoDot:3
+47 WRITE ?37,"IMAGES: ",$GET(STYSERKT("IMAGE"))
+48 QUIT
End DoDot:3
+49 ; dicom but missing Series UID
IF '$TEST
Begin DoDot:3
+50 WRITE " -- no series information"
+51 QUIT
End DoDot:3
+52 QUIT
End DoDot:2
+53 ; output counts of image file extensions
+54 SET EXTENSION=""
+55 FOR
SET EXTENSION=$ORDER(FILETYPE(EXTENSION))
if EXTENSION=""
QUIT
Begin DoDot:2
+56 WRITE !,EXTENSION,": ",$GET(FILETYPE(EXTENSION))
+57 QUIT
End DoDot:2
+58 ; P305 PMK 12/09/2021
IF $DATA(STYSERKT("DELETED"))
WRITE !,"*** Image Group Deleted ***"
+59 WRITE !
+60 QUIT
End DoDot:1
+61 QUIT
+62 ;
CONFSENS() ; Continue processing confirmation for sensitive patient
+1 NEW DIR,X,Y
+2 SET DIR("A")="Do you want to continue processing this patient record"
+3 SET DIR("A",1)=" *** Sensitive Patient Record *** "
+4 SET DIR("A",2)=""
+5 SET DIR("?")="Enter 'YES' to continue, 'NO' or '^' to exit"
+6 WRITE $CHAR(7),!!
SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
if 'Y
WRITE *7
+7 QUIT Y
