MAGDSTQ9 ;WOIFO/PMK - Study Tracker - Query/Retrieve user ; Feb 15, 2022@10:23:02
;;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 #2056 reference $$GET1^DIQ function call
; Supported IA #10090 to read LOCATION file (#4)
;
;
; Select the DICOM Service Class Provider
;
; Modeled after PICKSCP^MAGDACU on the DICOM Gateway
;
PICKSCP(DEFAULT,SCPTYPE) ; Pick the SCP for the site
N FOUND,HIT,I,LOCATION,MAGIEN,MAGSCPTYPE,N,NEXT,NEXTDATETIME
N USERAPP,STATNUMB,TARGET,TIMESTAMP,X
S STATNUMB=$$STATNUMB^MAGDFCNV
S DEFAULT=$G(DEFAULT),SCPTYPE=$G(SCPTYPE)
S USERAPP="",(HIT,I)=0
F S USERAPP=$O(^MAG(2006.587,"B",USERAPP)) Q:USERAPP="" D
. S (FOUND,MAGIEN,TIMESTAMP)=""
. F S MAGIEN=$O(^MAG(2006.587,"B",USERAPP,MAGIEN)) Q:MAGIEN="" D
. . S NEXT=^MAG(2006.587,MAGIEN,0)
. . S LOCATION=$P(NEXT,"^",7)
. . S LOCATION=$$GET1^DIQ(4,LOCATION,99,"E") ; compare station numbers
. . I LOCATION'=STATNUMB Q ; ignore entries for other locations
. . S MAGSCPTYPE=$P(NEXT,"^",9)
. . I SCPTYPE'="",SCPTYPE'=MAGSCPTYPE Q ; skip entries for other types
. . S NEXTDATETIME=$P(NEXT,"^",8)
. . I NEXTDATETIME>TIMESTAMP D ; get latest version
. . . S FOUND=NEXT,TIMESTAMP=NEXTDATETIME
. . . Q
. . Q
. I FOUND'="" D
. . S I=I+1,TARGET(I)=FOUND
. . I USERAPP=DEFAULT S HIT=I
. . Q
. Q
S N=I
I N<1 W !!,"No Service Class Providers defined in SCU_LIST.DIC." Q ""
F D Q:X'=""
. W !,"DICOM ",$S(SCPTYPE'="":SCPTYPE_" ",1:""),"Service Class Providers"
. S X=$X W ! F I=1:1:X W "-"
. F I=1:1:N W !,$J(I,3)," -- ",$P(TARGET(I),"^")
. I N=1 W " (selected)" S X=1 Q
. W !!,"Select the provider application (1-",N,"): "
. W:HIT HIT,"// " R X:DTIME E S X="^"
. I X["^" Q ; a caret will terminate the program
. I X="" S X=HIT W X I X="" S X="^" Q
. I (X<1)!(X>N)!'$D(TARGET(X)) W " ??? -- try again",!! S X="" Q
. Q
I X["^" S X=""
I X S X=$P(TARGET(X),"^",1)
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTQ9 2949 printed Dec 13, 2024@02:02:03 Page 2
MAGDSTQ9 ;WOIFO/PMK - Study Tracker - Query/Retrieve user ; Feb 15, 2022@10:23:02
+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 #2056 reference $$GET1^DIQ function call
+19 ; Supported IA #10090 to read LOCATION file (#4)
+20 ;
+21 ;
+22 ; Select the DICOM Service Class Provider
+23 ;
+24 ; Modeled after PICKSCP^MAGDACU on the DICOM Gateway
+25 ;
PICKSCP(DEFAULT,SCPTYPE) ; Pick the SCP for the site
+1 NEW FOUND,HIT,I,LOCATION,MAGIEN,MAGSCPTYPE,N,NEXT,NEXTDATETIME
+2 NEW USERAPP,STATNUMB,TARGET,TIMESTAMP,X
+3 SET STATNUMB=$$STATNUMB^MAGDFCNV
+4 SET DEFAULT=$GET(DEFAULT)
SET SCPTYPE=$GET(SCPTYPE)
+5 SET USERAPP=""
SET (HIT,I)=0
+6 FOR
SET USERAPP=$ORDER(^MAG(2006.587,"B",USERAPP))
if USERAPP=""
QUIT
Begin DoDot:1
+7 SET (FOUND,MAGIEN,TIMESTAMP)=""
+8 FOR
SET MAGIEN=$ORDER(^MAG(2006.587,"B",USERAPP,MAGIEN))
if MAGIEN=""
QUIT
Begin DoDot:2
+9 SET NEXT=^MAG(2006.587,MAGIEN,0)
+10 SET LOCATION=$PIECE(NEXT,"^",7)
+11 ; compare station numbers
SET LOCATION=$$GET1^DIQ(4,LOCATION,99,"E")
+12 ; ignore entries for other locations
IF LOCATION'=STATNUMB
QUIT
+13 SET MAGSCPTYPE=$PIECE(NEXT,"^",9)
+14 ; skip entries for other types
IF SCPTYPE'=""
IF SCPTYPE'=MAGSCPTYPE
QUIT
+15 SET NEXTDATETIME=$PIECE(NEXT,"^",8)
+16 ; get latest version
IF NEXTDATETIME>TIMESTAMP
Begin DoDot:3
+17 SET FOUND=NEXT
SET TIMESTAMP=NEXTDATETIME
+18 QUIT
End DoDot:3
+19 QUIT
End DoDot:2
+20 IF FOUND'=""
Begin DoDot:2
+21 SET I=I+1
SET TARGET(I)=FOUND
+22 IF USERAPP=DEFAULT
SET HIT=I
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 SET N=I
+26 IF N<1
WRITE !!,"No Service Class Providers defined in SCU_LIST.DIC."
QUIT ""
+27 FOR
Begin DoDot:1
+28 WRITE !,"DICOM ",$SELECT(SCPTYPE'="":SCPTYPE_" ",1:""),"Service Class Providers"
+29 SET X=$X
WRITE !
FOR I=1:1:X
WRITE "-"
+30 FOR I=1:1:N
WRITE !,$JUSTIFY(I,3)," -- ",$PIECE(TARGET(I),"^")
+31 IF N=1
WRITE " (selected)"
SET X=1
QUIT
+32 WRITE !!,"Select the provider application (1-",N,"): "
+33 if HIT
WRITE HIT,"// "
READ X:DTIME
IF '$TEST
SET X="^"
+34 ; a caret will terminate the program
IF X["^"
QUIT
+35 IF X=""
SET X=HIT
WRITE X
IF X=""
SET X="^"
QUIT
+36 IF (X<1)!(X>N)!'$DATA(TARGET(X))
WRITE " ??? -- try again",!!
SET X=""
QUIT
+37 QUIT
End DoDot:1
if X'=""
QUIT
+38 IF X["^"
SET X=""
+39 IF X
SET X=$PIECE(TARGET(X),"^",1)
+40 QUIT X
