MAGQBJHR ;WOIFO/RP; Report of Currently Queued items [ 03/28/2001 18:40 ]
;;3.0;IMAGING;**20**;Apr 12, 2006
;; +---------------------------------------------------------------+
;; | 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 Class II 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. |
;; +---------------------------------------------------------------+
;;
;Report of currently queued JBTOHD
JHRPT(RESULT) ;[MAGQ JH RPT]
N INDEX,CNT,TYPE,SUBTYPE,PDUZ,PAT,IEN,QUEUER,SESS,PLACE
S TYPE="JBTOHD",CNT=-1,PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
;S INDEX=550
S INDEX=$P($G(^MAGQUEUE(2006.031,$O(^MAGQUEUE(2006.031,"C",PLACE,TYPE,0)),0)),"^",2)
D SL("Current JBTOHD queue: "_INDEX_" "_$P($G(^MAGQUEUE(2006.03,INDEX,0)),"^",4),2)
F S INDEX=$O(^MAGQUEUE(2006.03,"C",PLACE,TYPE,INDEX)) Q:INDEX'?1N.N D
. S NODE=$G(^MAGQUEUE(2006.03,INDEX,0))
. Q:NODE=""
. S SUBTYPE=$P(NODE,"^",8),PDUZ=+$P(NODE,"^",2),IEN=$P(NODE,"^",7)
. S PAT=+$P($G(^MAG(2005,IEN,0)),"^",7)
. S:'$D(^TMP("MAGQJDE",$J,PDUZ,0,PAT,0)) ^TMP("MAGQJDE",$J,PDUZ,0,PAT,0)=INDEX
. S ^TMP("MAGQJDE",$J,PDUZ,0,PAT)=+$G(^TMP("MAGQJDE",$J,PDUZ,0,PAT))+1
. S ^TMP("MAGQJDE",$J,PDUZ,0)=+$G(^TMP("MAGQJDE",$J,PDUZ,0))+1
. S ^TMP("MAGQJDE",$J,PDUZ,SUBTYPE)=+$G(^TMP("MAGQJDE",$J,PDUZ,SUBTYPE))+1
;Reporting
S INDEX=""
N TITLE
F S INDEX=$O(^TMP("MAGQJDE",$J,INDEX)) Q:INDEX'?1N.N D
. S QUEUER=$$GET1^DIQ(200,INDEX,.01)
. Q:QUEUER=""
. D SL("Image Queuer: "_QUEUER,2)
. S TITLE=$$GET1^DIQ(200,INDEX,20.3)
. S:TITLE="" TITLE=$$GET1^DIQ(200,INDEX,8)
. D SL(" "_TITLE_"-"_$$GET1^DIQ(200,INDEX,29),1)
. D SL(" "_"Number of Queues: "_^TMP("MAGQJDE",$J,INDEX,0),1)
. D SESS(QUEUER,.SESS)
. N INDX S INDX=""
. F S INDX=$O(SESS(INDX)) Q:INDX'?1N.N D
. . D SL(" Today's WS logins: "_$P(SESS(INDX),"^")_" Display Version: "_$P(SESS(INDX),"^",2),1)
. S INDX=$O(^MAG(2006.19,"AC",INDEX,""))
. I INDX?1N.N D SL(" Queuer's View of Jukebox images: "_$S($P(^MAG(2006.19,INDX,0),"^",6)=1:"true",1:"false"),1)
. D SUBT(INDEX)
. D PATIN(INDEX)
. D SL(" ",1)
K ^TMP("MAGQJDE")
Q
SL(LINE,CR) ;
S CNT=CNT+1
S RESULT(CNT)=LINE
Q
SESS(ID,SESS) ;
N INDX,NODE,TODAY,DONE,WS,WSNODE
K SESS
S INDX=" ",DONE=0
D NOW^%DTC S TODAY=$P(%,".")
F S INDX=$O(^MAG(2006.82,"B",+ID,INDX),-1) Q:INDX'?1N.N D Q:DONE
. S NODE=$G(^MAG(2006.82,INDX,0))
. I $P($P(NODE,"^",3),".")<TODAY S DONE=1 Q
. S WS=$P(NODE,"^",5)
. S WSNODE=$G(^MAG(2006.81,WS,0))
. S SESS(WS)=$P(WSNODE,"^")_"^"_$P(WSNODE,"^",9)
Q
PATIN(MD) ;
N PID
S PID=0
F S PID=$O(^TMP("MAGQJDE",$J,MD,0,PID)) Q:PID'?1N.N D
. D SL(" Patient: "_$P($G(^DPT(PID,0)),"^")_" - "_$G(^TMP("MAGQJDE",$J,MD,0,PID,0)),1)
Q
SUBT(MD) ;
N SUBTYPE
S SUBTYPE=0
F S SUBTYPE=$O(^TMP("MAGQJDE",$J,MD,SUBTYPE)) Q:SUBTYPE="" D
. D SL(" Number of "_SUBTYPE_" : "_^TMP("MAGQJDE",$J,MD,SUBTYPE),1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBJHR 3627 printed Oct 16, 2024@18:08:29 Page 2
MAGQBJHR ;WOIFO/RP; Report of Currently Queued items [ 03/28/2001 18:40 ]
+1 ;;3.0;IMAGING;**20**;Apr 12, 2006
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a Class II medical device. As such, it may not be changed |
+12 ;; | in any way. Modifications to this software may result in an |
+13 ;; | adulterated medical device under 21CFR820, the use of which |
+14 ;; | is considered to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;Report of currently queued JBTOHD
JHRPT(RESULT) ;[MAGQ JH RPT]
+1 NEW INDEX,CNT,TYPE,SUBTYPE,PDUZ,PAT,IEN,QUEUER,SESS,PLACE
+2 SET TYPE="JBTOHD"
SET CNT=-1
SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+3 ;S INDEX=550
+4 SET INDEX=$PIECE($GET(^MAGQUEUE(2006.031,$ORDER(^MAGQUEUE(2006.031,"C",PLACE,TYPE,0)),0)),"^",2)
+5 DO SL("Current JBTOHD queue: "_INDEX_" "_$PIECE($GET(^MAGQUEUE(2006.03,INDEX,0)),"^",4),2)
+6 FOR
SET INDEX=$ORDER(^MAGQUEUE(2006.03,"C",PLACE,TYPE,INDEX))
if INDEX'?1N.N
QUIT
Begin DoDot:1
+7 SET NODE=$GET(^MAGQUEUE(2006.03,INDEX,0))
+8 if NODE=""
QUIT
+9 SET SUBTYPE=$PIECE(NODE,"^",8)
SET PDUZ=+$PIECE(NODE,"^",2)
SET IEN=$PIECE(NODE,"^",7)
+10 SET PAT=+$PIECE($GET(^MAG(2005,IEN,0)),"^",7)
+11 if '$DATA(^TMP("MAGQJDE",$JOB,PDUZ,0,PAT,0))
SET ^TMP("MAGQJDE",$JOB,PDUZ,0,PAT,0)=INDEX
+12 SET ^TMP("MAGQJDE",$JOB,PDUZ,0,PAT)=+$GET(^TMP("MAGQJDE",$JOB,PDUZ,0,PAT))+1
+13 SET ^TMP("MAGQJDE",$JOB,PDUZ,0)=+$GET(^TMP("MAGQJDE",$JOB,PDUZ,0))+1
+14 SET ^TMP("MAGQJDE",$JOB,PDUZ,SUBTYPE)=+$GET(^TMP("MAGQJDE",$JOB,PDUZ,SUBTYPE))+1
End DoDot:1
+15 ;Reporting
+16 SET INDEX=""
+17 NEW TITLE
+18 FOR
SET INDEX=$ORDER(^TMP("MAGQJDE",$JOB,INDEX))
if INDEX'?1N.N
QUIT
Begin DoDot:1
+19 SET QUEUER=$$GET1^DIQ(200,INDEX,.01)
+20 if QUEUER=""
QUIT
+21 DO SL("Image Queuer: "_QUEUER,2)
+22 SET TITLE=$$GET1^DIQ(200,INDEX,20.3)
+23 if TITLE=""
SET TITLE=$$GET1^DIQ(200,INDEX,8)
+24 DO SL(" "_TITLE_"-"_$$GET1^DIQ(200,INDEX,29),1)
+25 DO SL(" "_"Number of Queues: "_^TMP("MAGQJDE",$JOB,INDEX,0),1)
+26 DO SESS(QUEUER,.SESS)
+27 NEW INDX
SET INDX=""
+28 FOR
SET INDX=$ORDER(SESS(INDX))
if INDX'?1N.N
QUIT
Begin DoDot:2
+29 DO SL(" Today's WS logins: "_$PIECE(SESS(INDX),"^")_" Display Version: "_$PIECE(SESS(INDX),"^",2),1)
End DoDot:2
+30 SET INDX=$ORDER(^MAG(2006.19,"AC",INDEX,""))
+31 IF INDX?1N.N
DO SL(" Queuer's View of Jukebox images: "_$SELECT($PIECE(^MAG(2006.19,INDX,0),"^",6)=1:"true",1:"false"),1)
+32 DO SUBT(INDEX)
+33 DO PATIN(INDEX)
+34 DO SL(" ",1)
End DoDot:1
+35 KILL ^TMP("MAGQJDE")
+36 QUIT
SL(LINE,CR) ;
+1 SET CNT=CNT+1
+2 SET RESULT(CNT)=LINE
+3 QUIT
SESS(ID,SESS) ;
+1 NEW INDX,NODE,TODAY,DONE,WS,WSNODE
+2 KILL SESS
+3 SET INDX=" "
SET DONE=0
+4 DO NOW^%DTC
SET TODAY=$PIECE(%,".")
+5 FOR
SET INDX=$ORDER(^MAG(2006.82,"B",+ID,INDX),-1)
if INDX'?1N.N
QUIT
Begin DoDot:1
+6 SET NODE=$GET(^MAG(2006.82,INDX,0))
+7 IF $PIECE($PIECE(NODE,"^",3),".")<TODAY
SET DONE=1
QUIT
+8 SET WS=$PIECE(NODE,"^",5)
+9 SET WSNODE=$GET(^MAG(2006.81,WS,0))
+10 SET SESS(WS)=$PIECE(WSNODE,"^")_"^"_$PIECE(WSNODE,"^",9)
End DoDot:1
if DONE
QUIT
+11 QUIT
PATIN(MD) ;
+1 NEW PID
+2 SET PID=0
+3 FOR
SET PID=$ORDER(^TMP("MAGQJDE",$JOB,MD,0,PID))
if PID'?1N.N
QUIT
Begin DoDot:1
+4 DO SL(" Patient: "_$PIECE($GET(^DPT(PID,0)),"^")_" - "_$GET(^TMP("MAGQJDE",$JOB,MD,0,PID,0)),1)
End DoDot:1
+5 QUIT
SUBT(MD) ;
+1 NEW SUBTYPE
+2 SET SUBTYPE=0
+3 FOR
SET SUBTYPE=$ORDER(^TMP("MAGQJDE",$JOB,MD,SUBTYPE))
if SUBTYPE=""
QUIT
Begin DoDot:1
+4 DO SL(" Number of "_SUBTYPE_" : "_^TMP("MAGQJDE",$JOB,MD,SUBTYPE),1)
End DoDot:1
+5 QUIT
