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 ---[H[J[2J[HMAGJUTL6 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
