ISIJLS1 ; ISI/JHC - ISIRAD exam list functions ; 10/17/2022
;;1.1;ESL ISI IMAGING;**99,103,110**;Dec 21, 2022;Build 41
;; This routine is the property of ViTel Net, and should not be modified.
;; This software is a medical device and is subject to FDA regulation.
;; Modifications to this software may only be made under the terms of
;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
;; with any applicable provision in this part renders a device
;; adulterated under section 501(h) of the act. Such a device,
;; as well as any person responsible for the failure to comply,
;; is subject to regulatory action."
; Reference to SVMAG2A^MAGJLS3 in ICR #7403
; Reference to GETEXAM2^MAGJUTL1 in ICR #7404
; Reference to File #2006.631 in ICR #7409
Q
;;
;
; entry point for List Type = "I" lists, called from magjls3
;
INDXBLD ; compile Indexed exam data (List Type = "I")
; look up compile routine entry-point & call the subroutine
; else, quit with problem error code
N NOGO,INDXTAG,INDXRTN,X
S NOGO=0,REPLY="" ; reply variable controlled by calling routine (magjls3)
S X=$G(^MAG(2006.631,LSTID,"ISI")),INDXTAG=$P(X,U),INDXRTN=$P(X,U,2)
D I NOGO Q
. I INDXTAG]"",(INDXRTN]"")
. I $T(@(INDXTAG_U_INDXRTN))]"" ; test for routine in env.
. E S NOGO=1,REPLY="0^1~Problem with compile specification for this Index list (LISTID="_LSTID_")."
D @(INDXTAG_U_INDXRTN_"(.REPLY)")
I REPLY="" S REPLY="0^1~No results found for Indexed exams list."
;
Q
;
FAVCOMP(REPLY) ; compile Favorites exam list
N DASH,EXAMIEN,FIL,MAGRET,USERIEN,USERFILE,RADFN,RADTI,RACNI
N KEYWD1,KEYWD2,FAVNOTE,FAVICT,FAVCT
S REPLY="",FAVCT=0
S USERFILE=23451,DASH="-"
S USERIEN=$$USERIEN^ISIJFAV(DUZ)
I 'USERIEN S REPLY="0^1~Current user has not stored any Favorites exams." Q
S FIL=$NA(^ISI(USERFILE,USERIEN)),EXAMIEN=0
F FAVICT=0:1 S EXAMIEN=$O(@FIL@(1,EXAMIEN)) Q:'EXAMIEN S X=^(EXAMIEN,0),Y=$P(X,U) D
. S RADFN=$P(Y,DASH),RADTI=$P(Y,DASH,2),RACNI=$P(Y,DASH,3)
. S KEYWD1=$P(X,U,2),KEYWD2=$P(X,U,3)
. S FAVNOTE=$$FAVNOTE()
. D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
. I MAGRET D
. . S X=$P(^TMP($J,"MAGRAEX",1,2),U,11)
. . I X]"",("EW")[X Q ; exclude if in Waiting or Examined status
. . S FAVCT=FAVCT+1
. . ; stuff Favorites data into list compile results
. . S $P(^TMP($J,"MAGRAEX",1,"ISI"),U,4)=KEYWD1,$P(^("ISI"),U,5)=KEYWD2,$P(^("ISI"),U,6)=FAVNOTE
. . D SVMAG2A^MAGJLS3()
I 'FAVCT D
. I 'FAVICT S REPLY="0^1~No Favorites exams found for current user."
. E S REPLY="0^1~Current user's Favorites exams are all in Waiting or Examined status; display not permitted."
Q
;
FAVNOTE() ; determine what to return for the notes
; because regular list columns cannot manage W-P data
N RET,I,X,Y
S RET=""
S X=$G(@FIL@(1,EXAMIEN,1,0))
I X]"" S Y=$P(X,U,4) D
. I Y=1 D Q:(RET]"") ; only one notes line; return only if short enough
. . S I=$O(@FIL@(1,EXAMIEN,1,0))
. . S:I RET=$G(^(I,0))
. . I $L(RET)>40 S RET=""
. . E I '$L(RET) S RET=" "
. I RET="" S RET="Use 'View/Edit' to display notes"
Q:$Q RET Q
;
STATUS(STS) ; return a status "value" for the input Status IEN
; Returns Status ORDER if = 0/1/9; else return Vrad Category "equivalent"
N X
I STS]"" D
. S X=^RA(72,STS,0)
. S STS=$P(X,U,3) ; status order
. I STS=0!(STS=1)!(STS=9) Q ; Cancelled/Waiting/Complete
. S STS=$P(X,U,9) ; vrad category
. I STS="D"!(STS="T") S STS="I" Q ; Dict or Transcribe == "I" (interpreted)
Q:$Q STS Q
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HISIJLS1 3555 printed Apr 09, 2024@21:46:37 Page 2
ISIJLS1 ; ISI/JHC - ISIRAD exam list functions ; 10/17/2022
+1 ;;1.1;ESL ISI IMAGING;**99,103,110**;Dec 21, 2022;Build 41
+2 ;; This routine is the property of ViTel Net, and should not be modified.
+3 ;; This software is a medical device and is subject to FDA regulation.
+4 ;; Modifications to this software may only be made under the terms of
+5 ;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
+6 ;; with any applicable provision in this part renders a device
+7 ;; adulterated under section 501(h) of the act. Such a device,
+8 ;; as well as any person responsible for the failure to comply,
+9 ;; is subject to regulatory action."
+10 ; Reference to SVMAG2A^MAGJLS3 in ICR #7403
+11 ; Reference to GETEXAM2^MAGJUTL1 in ICR #7404
+12 ; Reference to File #2006.631 in ICR #7409
+13 QUIT
+14 ;;
+15 ;
+16 ; entry point for List Type = "I" lists, called from magjls3
+17 ;
INDXBLD ; compile Indexed exam data (List Type = "I")
+1 ; look up compile routine entry-point & call the subroutine
+2 ; else, quit with problem error code
+3 NEW NOGO,INDXTAG,INDXRTN,X
+4 ; reply variable controlled by calling routine (magjls3)
SET NOGO=0
SET REPLY=""
+5 SET X=$GET(^MAG(2006.631,LSTID,"ISI"))
SET INDXTAG=$PIECE(X,U)
SET INDXRTN=$PIECE(X,U,2)
+6 Begin DoDot:1
+7 IF INDXTAG]""
IF (INDXRTN]"")
+8 ; test for routine in env.
IF $TEXT(@(INDXTAG_U_INDXRTN))]""
+9 IF '$TEST
SET NOGO=1
SET REPLY="0^1~Problem with compile specification for this Index list (LISTID="_LSTID_")."
End DoDot:1
IF NOGO
QUIT
+10 DO @(INDXTAG_U_INDXRTN_"(.REPLY)")
+11 IF REPLY=""
SET REPLY="0^1~No results found for Indexed exams list."
+12 ;
+13 QUIT
+14 ;
FAVCOMP(REPLY) ; compile Favorites exam list
+1 NEW DASH,EXAMIEN,FIL,MAGRET,USERIEN,USERFILE,RADFN,RADTI,RACNI
+2 NEW KEYWD1,KEYWD2,FAVNOTE,FAVICT,FAVCT
+3 SET REPLY=""
SET FAVCT=0
+4 SET USERFILE=23451
SET DASH="-"
+5 SET USERIEN=$$USERIEN^ISIJFAV(DUZ)
+6 IF 'USERIEN
SET REPLY="0^1~Current user has not stored any Favorites exams."
QUIT
+7 SET FIL=$NAME(^ISI(USERFILE,USERIEN))
SET EXAMIEN=0
+8 FOR FAVICT=0:1
SET EXAMIEN=$ORDER(@FIL@(1,EXAMIEN))
if 'EXAMIEN
QUIT
SET X=^(EXAMIEN,0)
SET Y=$PIECE(X,U)
Begin DoDot:1
+9 SET RADFN=$PIECE(Y,DASH)
SET RADTI=$PIECE(Y,DASH,2)
SET RACNI=$PIECE(Y,DASH,3)
+10 SET KEYWD1=$PIECE(X,U,2)
SET KEYWD2=$PIECE(X,U,3)
+11 SET FAVNOTE=$$FAVNOTE()
+12 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
+13 IF MAGRET
Begin DoDot:2
+14 SET X=$PIECE(^TMP($JOB,"MAGRAEX",1,2),U,11)
+15 ; exclude if in Waiting or Examined status
IF X]""
IF ("EW")[X
QUIT
+16 SET FAVCT=FAVCT+1
+17 ; stuff Favorites data into list compile results
+18 SET $PIECE(^TMP($JOB,"MAGRAEX",1,"ISI"),U,4)=KEYWD1
SET $PIECE(^("ISI"),U,5)=KEYWD2
SET $PIECE(^("ISI"),U,6)=FAVNOTE
+19 DO SVMAG2A^MAGJLS3()
End DoDot:2
End DoDot:1
+20 IF 'FAVCT
Begin DoDot:1
+21 IF 'FAVICT
SET REPLY="0^1~No Favorites exams found for current user."
+22 IF '$TEST
SET REPLY="0^1~Current user's Favorites exams are all in Waiting or Examined status; display not permitted."
End DoDot:1
+23 QUIT
+24 ;
FAVNOTE() ; determine what to return for the notes
+1 ; because regular list columns cannot manage W-P data
+2 NEW RET,I,X,Y
+3 SET RET=""
+4 SET X=$GET(@FIL@(1,EXAMIEN,1,0))
+5 IF X]""
SET Y=$PIECE(X,U,4)
Begin DoDot:1
+6 ; only one notes line; return only if short enough
IF Y=1
Begin DoDot:2
+7 SET I=$ORDER(@FIL@(1,EXAMIEN,1,0))
+8 if I
SET RET=$GET(^(I,0))
+9 IF $LENGTH(RET)>40
SET RET=""
+10 IF '$TEST
IF '$LENGTH(RET)
SET RET=" "
End DoDot:2
if (RET]"")
QUIT
+11 IF RET=""
SET RET="Use 'View/Edit' to display notes"
End DoDot:1
+12 if $QUIT
QUIT RET
QUIT
+13 ;
STATUS(STS) ; return a status "value" for the input Status IEN
+1 ; Returns Status ORDER if = 0/1/9; else return Vrad Category "equivalent"
+2 NEW X
+3 IF STS]""
Begin DoDot:1
+4 SET X=^RA(72,STS,0)
+5 ; status order
SET STS=$PIECE(X,U,3)
+6 ; Cancelled/Waiting/Complete
IF STS=0!(STS=1)!(STS=9)
QUIT
+7 ; vrad category
SET STS=$PIECE(X,U,9)
+8 ; Dict or Transcribe == "I" (interpreted)
IF STS="D"!(STS="T")
SET STS="I"
QUIT
End DoDot:1
+9 if $QUIT
QUIT STS
QUIT
+10 ;
END ;
