MAGDSTA4 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Mar 03, 2022@08:41:56
;;3.0;IMAGING;**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. |
;; +---------------------------------------------------------------+
;;
;
; Supported IA #10103 reference $$FMTE^XLFDT function call
; Controlled Subscription IA #1171 to read RAD/NUC MED REPORTS file (#74)
;
Q
;
RADLKUP(DFN,COUNT,FIRSTDAY,LASTDAY,FIRSTIEN,LASTIEN) ;
N RARPT0,RARPT1,STATUS
S (COUNT,FIRSTDAY,FIRSTIEN,LASTDAY,LASTIEN)=0
S RARPT1=$O(^RARPT("C",DFN,""))
I RARPT1="" D Q
. W !!,"*** Patient does not have any radiology reports on file. ***"
. D CONTINUE^MAGDSTQ(0)
. Q
;
; find completed reports
S FIRSTDAY=999999999999,LASTDAY=0
S RARPT1=""
F S RARPT1=$O(^RARPT("C",DFN,RARPT1)) Q:RARPT1="" D
. S RARPT0=$G(^RARPT(RARPT1,0))
. S STATUS=$P(RARPT0,"^",5)
. I STATUS'="V",STATUS'="EF" Q ; only look at verified and electrically filed
. S DATETIME=$P(RARPT0,"^",3)
. I DATETIME<FIRSTDAY S FIRSTDAY=DATETIME,FIRSTIEN=RARPT1 ; get earliest date
. I DATETIME>LASTDAY S LASTDAY=DATETIME,LASTIEN=RARPT1 ; get latest date
. S COUNT=COUNT+1
. Q
S FIRSTDAY=FIRSTDAY\1,LASTDAY=LASTDAY\1 ; want dates only, not times
I COUNT>1 D
. W !!,"Patient has ",COUNT," radiology reports on file, from "
. W $$FMTE^XLFDT(FIRSTDAY,1)," to ",$$FMTE^XLFDT(LASTDAY,1)
. Q
E I COUNT=1 D
. W !!,"Patient has just one radiology report in file for "
. W $$FMTE^XLFDT(FIRSTDAY,1)
. Q
E D
. W !!,"*** Patient does not have any radiology reports on file. ***"
. D CONTINUE^MAGDSTQ(0)
. Q
Q
;
RARPT1 ; get the radiology report ien - called by MAGDSTA1
N RARPT1,X
S RARPT1=$G(^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN"))
I RARPT1 D
. W !!,"Scanning will start with radiology report # """,RARPT1,"""."
. I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 S QUIT=1 Q
. I X="YES" S RARPT1=+RARPT1 D RARPT1A
. Q
E D RARPT1A
Q
;
RARPT1A ; get new value
N BEGPTR ; first possible ^RARPT pointer value
N NEWPTR ; selected next possible ^RARPT pointer value
N ENDPTR ; last possible ^RARPT pointer value
N ACNUMB ; accession number (long case number)
N DATE ; radiology report date
N DEFAULT,OK,X,Z
;
S BEGPTR=$O(^RARPT(0))
D RARPT1B(BEGPTR,.ACNUMB,.DATE)
W !!,"The first radiology report is #",BEGPTR," (",ACNUMB,") entered on ",DATE,"."
;
S ENDPTR=$O(^RARPT(" "),-1)
D RARPT1B(ENDPTR,.ACNUMB,.DATE)
W !,"The last radiology report is #",ENDPTR," (",ACNUMB,") entered on ",DATE,"."
;
S OK=0 F D Q:OK
. S DEFAULT=$S(RARPT1:RARPT1,SORTORDER="ASCENDING":BEGPTR,SORTORDER="DESCENDING":ENDPTR)
. W !!,"Enter the new value of the radiology report #: ",DEFAULT,"// "
. R X:DTIME E S OK=-1 Q
. I X["^" S OK=-1 Q
. I X="" S X=DEFAULT W X
. I (X>ENDPTR)!(X<BEGPTR) D Q
. . W !!,"Please enter a number between ",BEGPTR," and ",ENDPTR,"."
. . Q
. S NEWPTR=X
. D RARPT1B(NEWPTR,.ACNUMB,.DATE)
. W !!,"Radiology report #",NEWPTR," (",ACNUMB,") entered on ",DATE,"."
. I $$YESNO^MAGDSTQ("Is this where to begin scanning?","n",.X)<0 S OK=-1 Q
. S:X="YES" OK=$S(NEWPTR=DEFAULT:2,1:1)
. Q
I OK<0 S QUIT=1 Q
I NEWPTR'=RARPT1 D
. S ^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN")=NEWPTR_" ("_DATE_")"
. W:OK=1 " -- changed"
. Q
Q
;
RARPT1B(RARPTIEN,ACNUMB,DATE) ; get accession number and date from ^RARPT(RARPTIEN,0)
N RARPT0,Y,Z
S RARPT0=$G(^RARPT(RARPTIEN,0))
S ACNUMB=$P(RARPT0,"^",1)
S DATE=$P($$FMTE^XLFDT($P(RARPT0,"^",3),1),"@",1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTA4 4466 printed Nov 22, 2024@17:11:49 Page 2
MAGDSTA4 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Mar 03, 2022@08:41:56
+1 ;;3.0;IMAGING;**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 ;
+18 ; Supported IA #10103 reference $$FMTE^XLFDT function call
+19 ; Controlled Subscription IA #1171 to read RAD/NUC MED REPORTS file (#74)
+20 ;
+21 QUIT
+22 ;
RADLKUP(DFN,COUNT,FIRSTDAY,LASTDAY,FIRSTIEN,LASTIEN) ;
+1 NEW RARPT0,RARPT1,STATUS
+2 SET (COUNT,FIRSTDAY,FIRSTIEN,LASTDAY,LASTIEN)=0
+3 SET RARPT1=$ORDER(^RARPT("C",DFN,""))
+4 IF RARPT1=""
Begin DoDot:1
+5 WRITE !!,"*** Patient does not have any radiology reports on file. ***"
+6 DO CONTINUE^MAGDSTQ(0)
+7 QUIT
End DoDot:1
QUIT
+8 ;
+9 ; find completed reports
+10 SET FIRSTDAY=999999999999
SET LASTDAY=0
+11 SET RARPT1=""
+12 FOR
SET RARPT1=$ORDER(^RARPT("C",DFN,RARPT1))
if RARPT1=""
QUIT
Begin DoDot:1
+13 SET RARPT0=$GET(^RARPT(RARPT1,0))
+14 SET STATUS=$PIECE(RARPT0,"^",5)
+15 ; only look at verified and electrically filed
IF STATUS'="V"
IF STATUS'="EF"
QUIT
+16 SET DATETIME=$PIECE(RARPT0,"^",3)
+17 ; get earliest date
IF DATETIME<FIRSTDAY
SET FIRSTDAY=DATETIME
SET FIRSTIEN=RARPT1
+18 ; get latest date
IF DATETIME>LASTDAY
SET LASTDAY=DATETIME
SET LASTIEN=RARPT1
+19 SET COUNT=COUNT+1
+20 QUIT
End DoDot:1
+21 ; want dates only, not times
SET FIRSTDAY=FIRSTDAY\1
SET LASTDAY=LASTDAY\1
+22 IF COUNT>1
Begin DoDot:1
+23 WRITE !!,"Patient has ",COUNT," radiology reports on file, from "
+24 WRITE $$FMTE^XLFDT(FIRSTDAY,1)," to ",$$FMTE^XLFDT(LASTDAY,1)
+25 QUIT
End DoDot:1
+26 IF '$TEST
IF COUNT=1
Begin DoDot:1
+27 WRITE !!,"Patient has just one radiology report in file for "
+28 WRITE $$FMTE^XLFDT(FIRSTDAY,1)
+29 QUIT
End DoDot:1
+30 IF '$TEST
Begin DoDot:1
+31 WRITE !!,"*** Patient does not have any radiology reports on file. ***"
+32 DO CONTINUE^MAGDSTQ(0)
+33 QUIT
End DoDot:1
+34 QUIT
+35 ;
RARPT1 ; get the radiology report ien - called by MAGDSTA1
+1 NEW RARPT1,X
+2 SET RARPT1=$GET(^TMP("MAG",$JOB,"BATCH Q/R","REPORT/STUDY IEN"))
+3 IF RARPT1
Begin DoDot:1
+4 WRITE !!,"Scanning will start with radiology report # """,RARPT1,"""."
+5 IF $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0
SET QUIT=1
QUIT
+6 IF X="YES"
SET RARPT1=+RARPT1
DO RARPT1A
+7 QUIT
End DoDot:1
+8 IF '$TEST
DO RARPT1A
+9 QUIT
+10 ;
RARPT1A ; get new value
+1 ; first possible ^RARPT pointer value
NEW BEGPTR
+2 ; selected next possible ^RARPT pointer value
NEW NEWPTR
+3 ; last possible ^RARPT pointer value
NEW ENDPTR
+4 ; accession number (long case number)
NEW ACNUMB
+5 ; radiology report date
NEW DATE
+6 NEW DEFAULT,OK,X,Z
+7 ;
+8 SET BEGPTR=$ORDER(^RARPT(0))
+9 DO RARPT1B(BEGPTR,.ACNUMB,.DATE)
+10 WRITE !!,"The first radiology report is #",BEGPTR," (",ACNUMB,") entered on ",DATE,"."
+11 ;
+12 SET ENDPTR=$ORDER(^RARPT(" "),-1)
+13 DO RARPT1B(ENDPTR,.ACNUMB,.DATE)
+14 WRITE !,"The last radiology report is #",ENDPTR," (",ACNUMB,") entered on ",DATE,"."
+15 ;
+16 SET OK=0
FOR
Begin DoDot:1
+17 SET DEFAULT=$SELECT(RARPT1:RARPT1,SORTORDER="ASCENDING":BEGPTR,SORTORDER="DESCENDING":ENDPTR)
+18 WRITE !!,"Enter the new value of the radiology report #: ",DEFAULT,"// "
+19 READ X:DTIME
IF '$TEST
SET OK=-1
QUIT
+20 IF X["^"
SET OK=-1
QUIT
+21 IF X=""
SET X=DEFAULT
WRITE X
+22 IF (X>ENDPTR)!(X<BEGPTR)
Begin DoDot:2
+23 WRITE !!,"Please enter a number between ",BEGPTR," and ",ENDPTR,"."
+24 QUIT
End DoDot:2
QUIT
+25 SET NEWPTR=X
+26 DO RARPT1B(NEWPTR,.ACNUMB,.DATE)
+27 WRITE !!,"Radiology report #",NEWPTR," (",ACNUMB,") entered on ",DATE,"."
+28 IF $$YESNO^MAGDSTQ("Is this where to begin scanning?","n",.X)<0
SET OK=-1
QUIT
+29 if X="YES"
SET OK=$SELECT(NEWPTR=DEFAULT:2,1:1)
+30 QUIT
End DoDot:1
if OK
QUIT
+31 IF OK<0
SET QUIT=1
QUIT
+32 IF NEWPTR'=RARPT1
Begin DoDot:1
+33 SET ^TMP("MAG",$JOB,"BATCH Q/R","REPORT/STUDY IEN")=NEWPTR_" ("_DATE_")"
+34 if OK=1
WRITE " -- changed"
+35 QUIT
End DoDot:1
+36 QUIT
+37 ;
RARPT1B(RARPTIEN,ACNUMB,DATE) ; get accession number and date from ^RARPT(RARPTIEN,0)
+1 NEW RARPT0,Y,Z
+2 SET RARPT0=$GET(^RARPT(RARPTIEN,0))
+3 SET ACNUMB=$PIECE(RARPT0,"^",1)
+4 SET DATE=$PIECE($$FMTE^XLFDT($PIECE(RARPT0,"^",3),1),"@",1)
+5 QUIT
