- 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 Feb 18, 2025@23:28:30 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
