MAGDSTA5.m

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 ---MAGDSTA5   5489     printed  Feb 18, 2025@23:28:09                                                                                                                                                                                                    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