MAGDIWDV ;WOIFO/PMK - Formatted listing of On Demand Routing request file ; Mar 10, 2022@11:36:44
;;3.0;IMAGING;**138,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 #10086 reference ^%ZIS subroutine call
;
; This is the VistA version of the DICOM Gateway MAGDIWDG routine
; It also includes the RPC that is used by both routines
;
SENDLIST ; display the list of studies in the output file
N A,LOC,MSG,ODEVTYPE,X
N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY,POP
;
D LISTORIG^MAGDRPC1(.LOC)
I '$G(LOC(1)) W !!,"There are no entries in the transmission queue.",! Q
S LOC("DEFAULT")=$$KSP^XUPARAM("INST")
;
D LOOKUP(.A)
;
D ^%ZIS Q:POP ; Select device quit if none
S ODEVTYPE=$S(IO["|TRM|":"SCREEN",1:"FILE")
;
D REPORT^MAGDIWDX(.LOC,.A,IO,ODEVTYPE)
;
Q
;
LOOKUP(OUT) ; RPC = MAG DICOM GET EXPORT IMAGE STS
; get the summary information from ^MAGDOUTP
N ACNUMB,D0,D1,DATETIME,DATETIME1,GROUP,LIST,LOCATION
N PRIORITY,REQUESTDATETIME,STATE,STATENAME,USERAPP,X,Y,Z
K OUT
S (D0,OUT(1))=0 F S D0=$O(^MAGDOUTP(2006.574,D0)) Q:'D0 D
. N COUNT
. S X=$G(^MAGDOUTP(2006.574,D0,0))
. S USERAPP=$P(X,"^",1),GROUP=$P(X,"^",2),ACNUMB=$P(X,"^",3)
. S LOCATION=$P(X,"^",4),PRIORITY=$P(X,"^",5),REQUESTDATETIME=$P(X,"^",7)
. S D1=0 F S D1=$O(^MAGDOUTP(2006.574,D0,1,D1)) Q:'D1 D
. . S Y=$G(^MAGDOUTP(2006.574,D0,1,D1,0)) Q:Y=""
. . S STATE=$P(Y,"^",2) Q:STATE=""
. . S DATETIME=$P(Y,"^",3) Q:DATETIME=""
. . S COUNT(STATE,DATETIME)=$G(COUNT(STATE,DATETIME))+1
. . Q
. ;
. ; compress the times so that all events within 10 minutes are recorded as one
. S STATE="" F S STATE=$O(COUNT(STATE)) Q:STATE="" D
. . S (DATETIME,DATETIME1)="" F S DATETIME=$O(COUNT(STATE,DATETIME)) Q:DATETIME="" D
. . . I DATETIME1="" S DATETIME1=DATETIME
. . . E I $$HDIFF^XLFDT(DATETIME,DATETIME1,2)<600 D ; less than ten minutes
. . . . S COUNT(STATE,DATETIME1)=COUNT(STATE,DATETIME1)+COUNT(STATE,DATETIME)
. . . . K COUNT(STATE,DATETIME)
. . . . Q
. . . E S DATETIME1=DATETIME
. . . Q
. . Q
. ;
. ; store the counts into report order
. S STATE="" F S STATE=$O(COUNT(STATE)) Q:STATE="" D
. . S (DATETIME,Z)="" F S DATETIME=$O(COUNT(STATE,DATETIME)) Q:DATETIME="" D
. . . ; assume the tranmission is completed in five minutes, if not, then it probably wasn't sent
. . . I STATE="XMIT" S STATENAME=$S($$HDIFF^XLFDT($H,DATETIME,2)<300:"TRANSMIT",1:"NOT SENT")
. . . E S STATENAME=STATE
. . . S Z=Z_"^"_STATENAME_"|"_DATETIME_"|"_COUNT(STATE,DATETIME)
. . . Q
. . S LIST(LOCATION,USERAPP,STATE,PRIORITY,D0)=ACNUMB_"^"_REQUESTDATETIME_"^"_GROUP_Z
. . Q
. Q
; transfer the information to the OUT array
S LOCATION="" F S LOCATION=$O(LIST(LOCATION)) Q:LOCATION="" D
. S USERAPP="" F S USERAPP=$O(LIST(LOCATION,USERAPP)) Q:USERAPP="" D
. . ; new NOT ON FILE, HOLD, and IGNORE states P305 PMK 10/06/2021
. . F STATE="NOT ON FILE","FAIL","HOLD","IGNORE","XMIT","WAITING","SUCCESS" D
. . . S PRIORITY="" F S PRIORITY=$O(LIST(LOCATION,USERAPP,STATE,PRIORITY)) Q:PRIORITY="" D
. . . . S D0="" F S D0=$O(LIST(LOCATION,USERAPP,STATE,PRIORITY,D0)) Q:D0="" D
. . . . . S Z=LOCATION_"^"_USERAPP_"^"_PRIORITY_"^"_D0
. . . . . S OUT(1)=OUT(1)+1
. . . . . S OUT(OUT(1)+1)=Z_"^"_LIST(LOCATION,USERAPP,STATE,PRIORITY,D0)
. . . . . Q
. . . . Q
. . . Q
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIWDV 4393 printed Nov 22, 2024@17:10:41 Page 2
MAGDIWDV ;WOIFO/PMK - Formatted listing of On Demand Routing request file ; Mar 10, 2022@11:36:44
+1 ;;3.0;IMAGING;**138,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 #10086 reference ^%ZIS subroutine call
+19 ;
+20 ; This is the VistA version of the DICOM Gateway MAGDIWDG routine
+21 ; It also includes the RPC that is used by both routines
+22 ;
SENDLIST ; display the list of studies in the output file
+1 NEW A,LOC,MSG,ODEVTYPE,X
+2 NEW IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY,POP
+3 ;
+4 DO LISTORIG^MAGDRPC1(.LOC)
+5 IF '$GET(LOC(1))
WRITE !!,"There are no entries in the transmission queue.",!
QUIT
+6 SET LOC("DEFAULT")=$$KSP^XUPARAM("INST")
+7 ;
+8 DO LOOKUP(.A)
+9 ;
+10 ; Select device quit if none
DO ^%ZIS
if POP
QUIT
+11 SET ODEVTYPE=$SELECT(IO["|TRM|":"SCREEN",1:"FILE")
+12 ;
+13 DO REPORT^MAGDIWDX(.LOC,.A,IO,ODEVTYPE)
+14 ;
+15 QUIT
+16 ;
LOOKUP(OUT) ; RPC = MAG DICOM GET EXPORT IMAGE STS
+1 ; get the summary information from ^MAGDOUTP
+2 NEW ACNUMB,D0,D1,DATETIME,DATETIME1,GROUP,LIST,LOCATION
+3 NEW PRIORITY,REQUESTDATETIME,STATE,STATENAME,USERAPP,X,Y,Z
+4 KILL OUT
+5 SET (D0,OUT(1))=0
FOR
SET D0=$ORDER(^MAGDOUTP(2006.574,D0))
if 'D0
QUIT
Begin DoDot:1
+6 NEW COUNT
+7 SET X=$GET(^MAGDOUTP(2006.574,D0,0))
+8 SET USERAPP=$PIECE(X,"^",1)
SET GROUP=$PIECE(X,"^",2)
SET ACNUMB=$PIECE(X,"^",3)
+9 SET LOCATION=$PIECE(X,"^",4)
SET PRIORITY=$PIECE(X,"^",5)
SET REQUESTDATETIME=$PIECE(X,"^",7)
+10 SET D1=0
FOR
SET D1=$ORDER(^MAGDOUTP(2006.574,D0,1,D1))
if 'D1
QUIT
Begin DoDot:2
+11 SET Y=$GET(^MAGDOUTP(2006.574,D0,1,D1,0))
if Y=""
QUIT
+12 SET STATE=$PIECE(Y,"^",2)
if STATE=""
QUIT
+13 SET DATETIME=$PIECE(Y,"^",3)
if DATETIME=""
QUIT
+14 SET COUNT(STATE,DATETIME)=$GET(COUNT(STATE,DATETIME))+1
+15 QUIT
End DoDot:2
+16 ;
+17 ; compress the times so that all events within 10 minutes are recorded as one
+18 SET STATE=""
FOR
SET STATE=$ORDER(COUNT(STATE))
if STATE=""
QUIT
Begin DoDot:2
+19 SET (DATETIME,DATETIME1)=""
FOR
SET DATETIME=$ORDER(COUNT(STATE,DATETIME))
if DATETIME=""
QUIT
Begin DoDot:3
+20 IF DATETIME1=""
SET DATETIME1=DATETIME
+21 ; less than ten minutes
IF '$TEST
IF $$HDIFF^XLFDT(DATETIME,DATETIME1,2)<600
Begin DoDot:4
+22 SET COUNT(STATE,DATETIME1)=COUNT(STATE,DATETIME1)+COUNT(STATE,DATETIME)
+23 KILL COUNT(STATE,DATETIME)
+24 QUIT
End DoDot:4
+25 IF '$TEST
SET DATETIME1=DATETIME
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 ;
+29 ; store the counts into report order
+30 SET STATE=""
FOR
SET STATE=$ORDER(COUNT(STATE))
if STATE=""
QUIT
Begin DoDot:2
+31 SET (DATETIME,Z)=""
FOR
SET DATETIME=$ORDER(COUNT(STATE,DATETIME))
if DATETIME=""
QUIT
Begin DoDot:3
+32 ; assume the tranmission is completed in five minutes, if not, then it probably wasn't sent
+33 IF STATE="XMIT"
SET STATENAME=$SELECT($$HDIFF^XLFDT($HOROLOG,DATETIME,2)<300:"TRANSMIT",1:"NOT SENT")
+34 IF '$TEST
SET STATENAME=STATE
+35 SET Z=Z_"^"_STATENAME_"|"_DATETIME_"|"_COUNT(STATE,DATETIME)
+36 QUIT
End DoDot:3
+37 SET LIST(LOCATION,USERAPP,STATE,PRIORITY,D0)=ACNUMB_"^"_REQUESTDATETIME_"^"_GROUP_Z
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 ; transfer the information to the OUT array
+41 SET LOCATION=""
FOR
SET LOCATION=$ORDER(LIST(LOCATION))
if LOCATION=""
QUIT
Begin DoDot:1
+42 SET USERAPP=""
FOR
SET USERAPP=$ORDER(LIST(LOCATION,USERAPP))
if USERAPP=""
QUIT
Begin DoDot:2
+43 ; new NOT ON FILE, HOLD, and IGNORE states P305 PMK 10/06/2021
+44 FOR STATE="NOT ON FILE","FAIL","HOLD","IGNORE","XMIT","WAITING","SUCCESS"
Begin DoDot:3
+45 SET PRIORITY=""
FOR
SET PRIORITY=$ORDER(LIST(LOCATION,USERAPP,STATE,PRIORITY))
if PRIORITY=""
QUIT
Begin DoDot:4
+46 SET D0=""
FOR
SET D0=$ORDER(LIST(LOCATION,USERAPP,STATE,PRIORITY,D0))
if D0=""
QUIT
Begin DoDot:5
+47 SET Z=LOCATION_"^"_USERAPP_"^"_PRIORITY_"^"_D0
+48 SET OUT(1)=OUT(1)+1
+49 SET OUT(OUT(1)+1)=Z_"^"_LIST(LOCATION,USERAPP,STATE,PRIORITY,D0)
+50 QUIT
End DoDot:5
+51 QUIT
End DoDot:4
+52 QUIT
End DoDot:3
+53 QUIT
End DoDot:2
+54 QUIT
End DoDot:1
+55 QUIT
