MAGJUTL6.m

MAGJUTL6 ;WOIFO/JHC,NST - Imaging Utility for getting Radiology Printset; 10/17/2022

 ;;3.0;IMAGING;**118,341**;Dec 21, 2022;Build 28

 ;; 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.                     |

 ;; +---------------------------------------------------------------+

 ;;

 ; Reference to ACCFIND^RAAPI in ICR #5020

 ; Reference to EN2^RAUTL20 in ICR #3270

 ;; ISI IMAGING;**99,102**

 Q

DAYCASE(RADFN,RADTI,RACNI) ; return Acn # (or  "^" delimited list of for PRINTSET) for exam

 ; RADFN,RADTI,RACNI -- Pointers to Rad Exam

 N ACNLIST,DAYCASE,I,LONGACN,PSET,RACN,RACNE,RADTE,RAPRTSET,X

 S DAYCASE=""

 I $G(RADFN),$G(RADTI),$G(RACNI) D

 . S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ; ICR 65

 . Q:X=""

 . S RACN=$P(X,U)  ; Case Number

 . S LONGACN=$P(X,U,31)  ; Site Accesion Number

 . S RADTE=9999999.9999-RADTI

 . ; use site accesion number if it is defined or create the short one

 . S DAYCASE=$S(LONGACN]"":LONGACN,1:$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN)

 S ACNLIST=DAYCASE

 I DAYCASE]"" D

 . D EN2^RAUTL20(.PSET) ; get info re rad PrintSet

 . Q:'RAPRTSET

 . S RACNE=$S(LONGACN]"":DAYCASE,1:$P(DAYCASE,"-",2)) ; SSAN/OLDACN

 . S X="",ACNLIST=""

 . F  S X=$O(PSET(X)) Q:'X  S:RACNE'=$P(PSET(X),U) ACNLIST=ACNLIST_U_$P(PSET(X),U)

 . I LONGACN="" F I=2:1:$L(ACNLIST,U) S X=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_$P(ACNLIST,U,I),$P(ACNLIST,U,I)=X

 . S ACNLIST=DAYCASE_ACNLIST

 Q ACNLIST

 ;

DAYCASE2(ACCN) ; return Acn # (or "^" delimited list of for PRINTSET) for exam

 ; ACCN -- Radiology Accession Number

 N ACNLIST,RAA,X,Y

 N RADFN,RADTI,RACNI

 ;

 S ACNLIST=""

 S X=$$ACCFIND^RAAPI(ACCN,.RAA)

 I X>0 D  ; accession number found

 . ; For a given accession number, there will never be more than one set of values

 . ; for RADFN/RADTI/RACNI in RAA array

 . S Y=RAA(1)

 . S RADFN=$P(Y,"^",1),RADTI=$P(Y,"^",2),RACNI=$P(Y,"^",3)

 . S ACNLIST=$$DAYCASE^MAGJUTL6(RADFN,RADTI,RACNI)  ; get all accession numbers

 . Q

 Q ACNLIST

 ;

DAYCASE3(ACCN) ; return RADFN_U_RADTI_U_RACNI for input accession #

 ; ACCN -- Radiology Accession Number

 N RAA,X,Y

 S X=$$ACCFIND^RAAPI(ACCN,.RAA)

 S Y=""

 I X>0 S Y=RAA(1)  ; accession number found

 Q Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MAGJUTL6   3036     printed  Mar 13, 2025@21:12:01                                                                                                                                                                                                    Page 2

MAGJUTL6  ;WOIFO/JHC,NST - Imaging Utility for getting Radiology Printset; 10/17/2022

 +1       ;;3.0;IMAGING;**118,341**;Dec 21, 2022;Build 28

 +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      ; Reference to ACCFIND^RAAPI in ICR #5020

 +18      ; Reference to EN2^RAUTL20 in ICR #3270

 +19      ;; ISI IMAGING;**99,102**

 +20       QUIT 

DAYCASE(RADFN,RADTI,RACNI) ; return Acn # (or  "^" delimited list of for PRINTSET) for exam

 +1       ; RADFN,RADTI,RACNI -- Pointers to Rad Exam

 +2        NEW ACNLIST,DAYCASE,I,LONGACN,PSET,RACN,RACNE,RADTE,RAPRTSET,X

 +3        SET DAYCASE=""

 +4        IF $GET(RADFN)

               IF $GET(RADTI)

                   IF $GET(RACNI)

                       Begin DoDot:1

 +5       ; ICR 65

                           SET X=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))

 +6                        if X=""

                               QUIT 

 +7       ; Case Number

                           SET RACN=$PIECE(X,U)

 +8       ; Site Accesion Number

                           SET LONGACN=$PIECE(X,U,31)

 +9                        SET RADTE=9999999.9999-RADTI

 +10      ; use site accesion number if it is defined or create the short one

 +11                       SET DAYCASE=$SELECT(LONGACN]"":LONGACN,1:$EXTRACT(RADTE,4,7)_$EXTRACT(RADTE,2,3)_"-"_RACN)

                       End DoDot:1

 +12       SET ACNLIST=DAYCASE

 +13       IF DAYCASE]""

               Begin DoDot:1

 +14      ; get info re rad PrintSet

                   DO EN2^RAUTL20(.PSET)

 +15               if 'RAPRTSET

                       QUIT 

 +16      ; SSAN/OLDACN

                   SET RACNE=$SELECT(LONGACN]"":DAYCASE,1:$PIECE(DAYCASE,"-",2))

 +17               SET X=""

                   SET ACNLIST=""

 +18               FOR 

                       SET X=$ORDER(PSET(X))

                       if 'X

                           QUIT 

                       if RACNE'=$PIECE(PSET(X),U)

                           SET ACNLIST=ACNLIST_U_$PIECE(PSET(X),U)

 +19               IF LONGACN=""

                       FOR I=2:1:$LENGTH(ACNLIST,U)

                           SET X=$EXTRACT(RADTE,4,7)_$EXTRACT(RADTE,2,3)_"-"_$PIECE(ACNLIST,U,I)

                           SET $PIECE(ACNLIST,U,I)=X

 +20               SET ACNLIST=DAYCASE_ACNLIST

               End DoDot:1

 +21       QUIT ACNLIST

 +22      ;

DAYCASE2(ACCN) ; return Acn # (or "^" delimited list of for PRINTSET) for exam

 +1       ; ACCN -- Radiology Accession Number

 +2        NEW ACNLIST,RAA,X,Y

 +3        NEW RADFN,RADTI,RACNI

 +4       ;

 +5        SET ACNLIST=""

 +6        SET X=$$ACCFIND^RAAPI(ACCN,.RAA)

 +7       ; accession number found

           IF X>0

               Begin DoDot:1

 +8       ; For a given accession number, there will never be more than one set of values

 +9       ; for RADFN/RADTI/RACNI in RAA array

 +10               SET Y=RAA(1)

 +11               SET RADFN=$PIECE(Y,"^",1)

                   SET RADTI=$PIECE(Y,"^",2)

                   SET RACNI=$PIECE(Y,"^",3)

 +12      ; get all accession numbers

                   SET ACNLIST=$$DAYCASE^MAGJUTL6(RADFN,RADTI,RACNI)

 +13               QUIT 

               End DoDot:1

 +14       QUIT ACNLIST

 +15      ;

DAYCASE3(ACCN) ; return RADFN_U_RADTI_U_RACNI for input accession #

 +1       ; ACCN -- Radiology Accession Number

 +2        NEW RAA,X,Y

 +3        SET X=$$ACCFIND^RAAPI(ACCN,.RAA)

 +4        SET Y=""

 +5       ; accession number found

           IF X>0

               SET Y=RAA(1)

 +6        QUIT Y