MAGDSTA5 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Mar 08, 2022@08:59:51
;;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
;
; Look for images for completed studies. The status must be either
; V-VERIFIED or EF-ELECTRONICALY FILED.
;
MAIN() ; The main loop for the program for Radiology
; Input Variables
; SCANMODE ;-- "PATIENT", "DATE", or "NUMBER"
; DIRECTION ;- 1="ASCENDING" or 0="DESCENDING"
; BATCHSIZE ;- number of consult & procedure requests to process on this run
; BEGDATE ;--- begin date for search
; ENDDATE ;-- end date for search
; QRSCP ;----- default query/retrieve provider
; HOURS ;----- 24 character string of Y's and N's indicating active times
;
N RARPT1,RUNTIME,STOP,X
;
D HEADER^MAGDSTAA(0)
;
; STOP: -1=error, 0=run completed, 1=run stopped
S STOP=$$RADLKUP()
Q STOP
;
RADLKUP() ; Find the next study to retrieve
N STOP
I SCANMODE="PATIENT" D
. S STOP=$$PATIENT()
. Q
E I SCANMODE="DATE" D
. S STOP=$$DATE()
. Q
E I SCANMODE="NUMBER" D
. S STOP=$$NUMBER()
. Q
E D
. W !!,"*** Illegal SCAN MODE: """,SCANMODE,""""
. S STOP=-1
. Q
Q STOP
;
PATIENT() ; use ^RARPT "C" xref to find studies for a single patient
; ^RARPT("C",DFN,RARPT1)=""
N EXAMDATE,RARPT0,RARPT1,RETURN,STATUS,STOP
S STOP=0 ; set to stop the q/r process
S RARPT1=""
F S RARPT1=$O(^RARPT("C",DFN,RARPT1),DIRECTION) Q:'RARPT1 Q:STOP D
. S RARPT0=$G(^RARPT(RARPT1,0))
. S EXAMDATE=$P(RARPT0,"^",3),STATUS=$P(RARPT0,"^",5)
. Q:EXAMDATE<BEGDATE Q:EXAMDATE>ENDDATE
. I STATUS'="V",STATUS'="EF" Q
. S STOP=$$RADLKUP1(RARPT1)
. Q
Q STOP
;
DATE() ; use ^RARTPT "AA" xref to find studies by verified date
; ^RARPT("AA",RADTI,RARPT1)=""
N DATEBEG,DATESTOP,DONE,RADTI,RARPT0,RARPT1,RETURN,STATUS,STOP
S STOP=0 ; set to stop the q/r process
D SETDATES(.DATEBEG,.DATESTOP,BEGDATE,ENDDATE,DIRECTION)
S RADTI=DATEBEG,(DONE,RETURN)=0
; reverse date, opposite sort order
F S RADTI=$O(^RARPT("AA",RADTI),-DIRECTION) Q:'RADTI Q:DONE Q:STOP D
. I DIRECTION=1 S DONE=RADTI<DATESTOP Q:DONE
. E S DONE=RADTI>DATESTOP Q:DONE
. S RARPT1=""
. F S RARPT1=$O(^RARPT("AA",RADTI,RARPT1),DIRECTION) Q:'RARPT1 Q:STOP D
. . S RARPT0=$G(^RARPT(RARPT1,0))
. . S STATUS=$P(RARPT0,"^",5)
. . I STATUS'="V",STATUS'="EF" Q
. . S STOP=$$RADLKUP1(RARPT1)
. . Q
. Q
Q STOP
;
NUMBER() ; use ^RARPT ien
; ^RARPT(RARPT1,...
N BATCHSIZE,RARPT0,RARPT1,RETURN,STOP,STATUS,STUDYCNT
S STOP=0 ; set to stop the q/r process
S STUDYCNT=0 ; only count completed (V or EF) studies
S BATCHSIZE=$G(^TMP("MAG",$J,"BATCH Q/R","BATCH SIZE"))
S RARPT1=$G(^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN"))
S RARPT1=RARPT1-DIRECTION ; Massage value for $O
F S RARPT1=$O(^RARPT(RARPT1),DIRECTION) Q:'RARPT1 Q:STUDYCNT>=BATCHSIZE Q:STOP D
. S RARPT0=$G(^RARPT(RARPT1,0))
. S STATUS=$P(RARPT0,"^",5)
. ; should this study have image?
. I STATUS'="V",STATUS'="EF" Q ; nope
. S STUDYCNT=STUDYCNT+1
. S STOP=$$RADLKUP1(RARPT1)
. Q
Q STOP
;
RADLKUP1(RARPT1) ; lookup one radiology exam
N ACNUMB,DFN,EXAMDATE,HOSPDIV,MAGIEN,MAGIENLIST,RADPT0,RADTI,RARPT0,RARPT3
;
S RARPT0=$G(^RARPT(RARPT1,0))
S ACNUMB=$P(RARPT0,"^",1),DFN=$P(RARPT0,"^",2)
S EXAMDATE=$P(RARPT0,"^",3)
;
; check DIVISION
S RADTI=$$RADTI(EXAMDATE)
S RADPT0=$G(^RADPT(DFN,"DT",RADTI,0))
S HOSPDIV=$P(RADPT0,"^",3) ; HOSPITAL DIVISION
I $$CHECKDIV^MAGDSTAB()="Y",HOSPDIV'=DIVISION Q 0 ; not the user's division
;
; lookup legacy 2005 image group pointers
S RARPT3=0
F S RARPT3=$O(^RARPT(RARPT1,2005,RARPT3)) Q:'RARPT3 D
. S MAGIEN=$G(^RARPT(RARPT1,2005,RARPT3,0))
. S MAGIENLIST(MAGIEN)=""
. Q
Q $$LOOKUP^MAGDSTAA(DFN,EXAMDATE,RARPT1,ACNUMB,.MAGIENLIST)
;
SETDATES(DATEBEG,DATESTOP,BEGDATE,ENDDATE,DIRECTION) ; get date range
; get the beginning and ending dates for the FOR loop
; these are in RARPT reverse date format
; they are also DIRECTION specific
I DIRECTION=1 D ; ascending direction
. S DATEBEG=$$RADTI(BEGDATE)
. S DATESTOP=$$RADTI(ENDDATE)
. Q
E D ; descending direction
. S DATEBEG=$$RADTI(ENDDATE)
. S DATESTOP=$$RADTI(BEGDATE)
. Q
Q
;
RADTI(RADTI) ; convert a reverse date to a FM date and vice versa
Q 9999999.9999-RADTI ; 9's complement conversion
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTA5 5489 printed Dec 13, 2024@02:01:42 Page 2
MAGDSTA5 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Mar 08, 2022@08:59:51
+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 ;
+23 ; Look for images for completed studies. The status must be either
+24 ; V-VERIFIED or EF-ELECTRONICALY FILED.
+25 ;
MAIN() ; The main loop for the program for Radiology
+1 ; Input Variables
+2 ; SCANMODE ;-- "PATIENT", "DATE", or "NUMBER"
+3 ; DIRECTION ;- 1="ASCENDING" or 0="DESCENDING"
+4 ; BATCHSIZE ;- number of consult & procedure requests to process on this run
+5 ; BEGDATE ;--- begin date for search
+6 ; ENDDATE ;-- end date for search
+7 ; QRSCP ;----- default query/retrieve provider
+8 ; HOURS ;----- 24 character string of Y's and N's indicating active times
+9 ;
+10 NEW RARPT1,RUNTIME,STOP,X
+11 ;
+12 DO HEADER^MAGDSTAA(0)
+13 ;
+14 ; STOP: -1=error, 0=run completed, 1=run stopped
+15 SET STOP=$$RADLKUP()
+16 QUIT STOP
+17 ;
RADLKUP() ; Find the next study to retrieve
+1 NEW STOP
+2 IF SCANMODE="PATIENT"
Begin DoDot:1
+3 SET STOP=$$PATIENT()
+4 QUIT
End DoDot:1
+5 IF '$TEST
IF SCANMODE="DATE"
Begin DoDot:1
+6 SET STOP=$$DATE()
+7 QUIT
End DoDot:1
+8 IF '$TEST
IF SCANMODE="NUMBER"
Begin DoDot:1
+9 SET STOP=$$NUMBER()
+10 QUIT
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 WRITE !!,"*** Illegal SCAN MODE: """,SCANMODE,""""
+13 SET STOP=-1
+14 QUIT
End DoDot:1
+15 QUIT STOP
+16 ;
PATIENT() ; use ^RARPT "C" xref to find studies for a single patient
+1 ; ^RARPT("C",DFN,RARPT1)=""
+2 NEW EXAMDATE,RARPT0,RARPT1,RETURN,STATUS,STOP
+3 ; set to stop the q/r process
SET STOP=0
+4 SET RARPT1=""
+5 FOR
SET RARPT1=$ORDER(^RARPT("C",DFN,RARPT1),DIRECTION)
if 'RARPT1
QUIT
if STOP
QUIT
Begin DoDot:1
+6 SET RARPT0=$GET(^RARPT(RARPT1,0))
+7 SET EXAMDATE=$PIECE(RARPT0,"^",3)
SET STATUS=$PIECE(RARPT0,"^",5)
+8 if EXAMDATE<BEGDATE
QUIT
if EXAMDATE>ENDDATE
QUIT
+9 IF STATUS'="V"
IF STATUS'="EF"
QUIT
+10 SET STOP=$$RADLKUP1(RARPT1)
+11 QUIT
End DoDot:1
+12 QUIT STOP
+13 ;
DATE() ; use ^RARTPT "AA" xref to find studies by verified date
+1 ; ^RARPT("AA",RADTI,RARPT1)=""
+2 NEW DATEBEG,DATESTOP,DONE,RADTI,RARPT0,RARPT1,RETURN,STATUS,STOP
+3 ; set to stop the q/r process
SET STOP=0
+4 DO SETDATES(.DATEBEG,.DATESTOP,BEGDATE,ENDDATE,DIRECTION)
+5 SET RADTI=DATEBEG
SET (DONE,RETURN)=0
+6 ; reverse date, opposite sort order
+7 FOR
SET RADTI=$ORDER(^RARPT("AA",RADTI),-DIRECTION)
if 'RADTI
QUIT
if DONE
QUIT
if STOP
QUIT
Begin DoDot:1
+8 IF DIRECTION=1
SET DONE=RADTI<DATESTOP
if DONE
QUIT
+9 IF '$TEST
SET DONE=RADTI>DATESTOP
if DONE
QUIT
+10 SET RARPT1=""
+11 FOR
SET RARPT1=$ORDER(^RARPT("AA",RADTI,RARPT1),DIRECTION)
if 'RARPT1
QUIT
if STOP
QUIT
Begin DoDot:2
+12 SET RARPT0=$GET(^RARPT(RARPT1,0))
+13 SET STATUS=$PIECE(RARPT0,"^",5)
+14 IF STATUS'="V"
IF STATUS'="EF"
QUIT
+15 SET STOP=$$RADLKUP1(RARPT1)
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT STOP
+19 ;
NUMBER() ; use ^RARPT ien
+1 ; ^RARPT(RARPT1,...
+2 NEW BATCHSIZE,RARPT0,RARPT1,RETURN,STOP,STATUS,STUDYCNT
+3 ; set to stop the q/r process
SET STOP=0
+4 ; only count completed (V or EF) studies
SET STUDYCNT=0
+5 SET BATCHSIZE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","BATCH SIZE"))
+6 SET RARPT1=$GET(^TMP("MAG",$JOB,"BATCH Q/R","REPORT/STUDY IEN"))
+7 ; Massage value for $O
SET RARPT1=RARPT1-DIRECTION
+8 FOR
SET RARPT1=$ORDER(^RARPT(RARPT1),DIRECTION)
if 'RARPT1
QUIT
if STUDYCNT>=BATCHSIZE
QUIT
if STOP
QUIT
Begin DoDot:1
+9 SET RARPT0=$GET(^RARPT(RARPT1,0))
+10 SET STATUS=$PIECE(RARPT0,"^",5)
+11 ; should this study have image?
+12 ; nope
IF STATUS'="V"
IF STATUS'="EF"
QUIT
+13 SET STUDYCNT=STUDYCNT+1
+14 SET STOP=$$RADLKUP1(RARPT1)
+15 QUIT
End DoDot:1
+16 QUIT STOP
+17 ;
RADLKUP1(RARPT1) ; lookup one radiology exam
+1 NEW ACNUMB,DFN,EXAMDATE,HOSPDIV,MAGIEN,MAGIENLIST,RADPT0,RADTI,RARPT0,RARPT3
+2 ;
+3 SET RARPT0=$GET(^RARPT(RARPT1,0))
+4 SET ACNUMB=$PIECE(RARPT0,"^",1)
SET DFN=$PIECE(RARPT0,"^",2)
+5 SET EXAMDATE=$PIECE(RARPT0,"^",3)
+6 ;
+7 ; check DIVISION
+8 SET RADTI=$$RADTI(EXAMDATE)
+9 SET RADPT0=$GET(^RADPT(DFN,"DT",RADTI,0))
+10 ; HOSPITAL DIVISION
SET HOSPDIV=$PIECE(RADPT0,"^",3)
+11 ; not the user's division
IF $$CHECKDIV^MAGDSTAB()="Y"
IF HOSPDIV'=DIVISION
QUIT 0
+12 ;
+13 ; lookup legacy 2005 image group pointers
+14 SET RARPT3=0
+15 FOR
SET RARPT3=$ORDER(^RARPT(RARPT1,2005,RARPT3))
if 'RARPT3
QUIT
Begin DoDot:1
+16 SET MAGIEN=$GET(^RARPT(RARPT1,2005,RARPT3,0))
+17 SET MAGIENLIST(MAGIEN)=""
+18 QUIT
End DoDot:1
+19 QUIT $$LOOKUP^MAGDSTAA(DFN,EXAMDATE,RARPT1,ACNUMB,.MAGIENLIST)
+20 ;
SETDATES(DATEBEG,DATESTOP,BEGDATE,ENDDATE,DIRECTION) ; get date range
+1 ; get the beginning and ending dates for the FOR loop
+2 ; these are in RARPT reverse date format
+3 ; they are also DIRECTION specific
+4 ; ascending direction
IF DIRECTION=1
Begin DoDot:1
+5 SET DATEBEG=$$RADTI(BEGDATE)
+6 SET DATESTOP=$$RADTI(ENDDATE)
+7 QUIT
End DoDot:1
+8 ; descending direction
IF '$TEST
Begin DoDot:1
+9 SET DATEBEG=$$RADTI(ENDDATE)
+10 SET DATESTOP=$$RADTI(BEGDATE)
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
RADTI(RADTI) ; convert a reverse date to a FM date and vice versa
+1 ; 9's complement conversion
QUIT 9999999.9999-RADTI
