MAGQBTM ;WOIFO/RMP/JL - REMOTE Task SERVER Program ; 20 April 2017 10:41 AM
;;3.0;IMAGING;**1,7,8,20,81,39,135,186**;Mar 19, 2002;Build 23;April 20, 2017
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
ENTRY(RESULT,WSTAT,PROCESS) ; RPC[MAGQ ABP]
N X,SYSIEN,SYSNAME,NODE,INDX,CNT,PROC,%,QPTR,QCNT,VERS,EXEDATE,WSOS,PLACE,VOK,EXDATE
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S (SYSIEN,CNT)=0,SYSNAME="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),VOK=""
S $P(RESULT(0),U,6)=$D(^XUSEC("MAG SYSTEM",DUZ))
Q:'$P(RESULT(0),U,6)
S VERS=$P(WSTAT,U,2)
S WSTAT=$P(WSTAT,U)
S SYSIEN=$O(^MAG(2006.8,"C",PLACE,WSTAT,""))
I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4(WSTAT),""))
I 'SYSIEN D
. N TRY
. F TRY=1:1:$L(WSTAT,".") D Q:SYSIEN?1.N
. . S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$P(WSTAT,".",TRY),""))
. . I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4($P(WSTAT,".",TRY)),""))
Q:SYSIEN=""
S VERS=$P(VERS,".",1,2)_"P"_$P(VERS,".",3)
D VOKR^MAGQBUT4(.VOK,VERS)
Q:'$P(VOK,U)
S NODE=^MAG(2006.8,SYSIEN,0)
S SYSNAME=$P(NODE,U)
I SYSNAME="" D Q
. S $P(RESULT(0),U,1,2)="-1^No Background Processor parameters on system"
I $P(NODE,U,12)'=1 D Q
. S $P(RESULT(0),U,1,2)="-1^Not assigned as a Background Processor"
F PROC="ABSTRACT;13","JUKEBOX;14","JBTOHD;15","DELETE;23","PREFET;16","GCC;18","IMPORT;17" D Q:$P(RESULT(0),U,1)="-1"
. N PIECE,NAME
. I $$UBPW^MAGQBUT1(SYSNAME,PROC) D Q
. . S $P(RESULT(0),U,1,2)="-1^This BP: "_SYSNAME_" has a co-assigned queue: "_$P(PROC,";")
. S NAME=$P(PROC,";")
. S PIECE=$P(PROC,";",2)
. I $P(NODE,U,PIECE)="1" D
. . N QCNT,QPTR
. . D ADD^MAGBAPI(0,NAME,PLACE)
. . S QPTR=$O(^MAGQUEUE(2006.031,"C",PLACE,NAME,""))
. . S QCNT=$P($G(^MAGQUEUE(2006.031,+QPTR,0)),U,3)
. . S CNT=CNT+1
. . S RESULT(CNT)=NAME_U_QCNT_U_(+$P($G(^MAGQUEUE(2006.031,+QPTR,0)),U,5)-QCNT)
. . I +$P(RESULT(CNT),U,3)<0 D ; Refresh the queue count if negative
. . . D QCNT^MAGQBUT4("",PLACE,NAME)
. . . S RESULT(CNT)=NAME_U_QCNT_U_(+$P($G(^MAGQUEUE(2006.031,+QPTR,0)),U,5)-QCNT)
. . . Q
. . Q
. Q
Q:$P(RESULT(0),U,1)="-1"
S $P(RESULT(0),U,1,5)="0^BP List^PID: "_$$BASE^XLFUTL($J,10,16)_"^"_SYSNAME_U_WSTAT
Q
GETQUE(RESULT,ACTION) ; RPC[MAGQ GET]
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
N PLACE
D @(ACTION_"(.RESULT)")
I +RESULT<0 D ; Update queue status and increment the Queue pointer if the queue cannot be processed
. N PLACE S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
. D QSTAT($P(RESULT,U,2),$P(RESULT,U,3),ACTION,.PLACE)
. D QPTER(ACTION,$P(RESULT,U,2),.PLACE)
. Q
Q
ABSTRACT(RESULT) ;
D DEQUEUE("ABSTRACT",.RESULT) Q
JUKEBOX(RESULT) ;
D DEQUEUE("JUKEBOX",.RESULT) Q
JBTOHD(RESULT) ;
D DEQUEUE("JBTOHD",.RESULT) Q
GCC(RESULT) ;
D DEQUEUE("GCC",.RESULT) Q
DELETE(RESULT) ;
D DEQUEUE("DELETE",.RESULT) Q
PREFET(RESULT) ;
D DEQUEUE("PREFET",.RESULT) Q
IMPORT(RESULT) ;
D DEQUEUE("IMPORT",.RESULT) Q
DEQUEUE(QUE,RESULT) ;
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
N QPTR,QPTR2,ROU,MAGIEN,ZNODE,MSG,IMQUE,PLACE
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S QPTR2=$O(^MAGQUEUE(2006.031,"C",PLACE,QUE,""))
S QPTR=$S(QPTR2:$P(^MAGQUEUE(2006.031,QPTR2,0),U,2),1:"")
S QPTR=$O(^MAGQUEUE(2006.03,"C",PLACE,QUE,QPTR))
I QPTR="" D Q
. S RESULT="0"_U_QPTR2_U_"No "_QUE_" "_QPTR2_" to process."
D QSTAT(QPTR,QUE_" in progress.",QUE,.PLACE)
S ZNODE=$G(^MAGQUEUE(2006.03,QPTR,0))
I ZNODE="" S RESULT=-101_U_QPTR_U_"Queue Record does not exist" Q
I QUE="IMPORT" D ENTRY^MAGQBIM(QPTR,QUE,QPTR2,ZNODE,.RESULT) Q
S MAGIEN=$P(ZNODE,"^",7)
I ("^DELETE^JUKEBOX^")'[(U_QUE_U),(('(+MAGIEN))!('$D(^MAG(2005,+MAGIEN,0)))!($P(ZNODE,U)'=QUE)) D Q
. I $D(^MAG(2005.1,+MAGIEN,0)) D
. . S MSG="Image Record Deleted and in archive file."
. E S MSG="No valid image file number to process."
. S RESULT=-101_U_QPTR_U_MSG
S ROU=$$RESET(QUE)
I ROU="" S RESULT="-1"_U_QPTR_U_QUE_" Is an inactive process" Q
D @("ENTRY^"_ROU_"(.RESULT,QPTR)")
Q
QSTAT(QPTR,MESSAGE,ACTION,PLACE) ;Update the Queue status
N ZNODE,MAGTIME
Q:QPTR=""
S MESSAGE=$TR(MESSAGE,":;<>.?/\'()*^%$#@!0123456789","")
Q:'$D(^MAGQUEUE(2006.03,QPTR,0))
S ZNODE=$G(^MAGQUEUE(2006.03,QPTR,0))
S MAGTIME=$$NOW^XLFDT
S:'$G(PLACE) PLACE=$$QPLACE(ZNODE,QPTR)
Q:'PLACE
I $P(ZNODE,U,5)]"" D
. K ^MAGQUEUE(2006.03,"D",PLACE,$P(ZNODE,U),$E($P(ZNODE,U,5),1,30),QPTR) Q
S ^MAGQUEUE(2006.03,"D",PLACE,$P(ZNODE,U),$E(MESSAGE,1,30),QPTR)=""
S $P(^MAGQUEUE(2006.03,QPTR,0),U,5,6)=$P(MESSAGE,U)_U_MAGTIME
I ACTION["IMPORT" D STAT^MAGQBIM($S($P(ZNODE,U,11)?1N.N:$P(ZNODE,U,11),1:QPTR),MAGTIME,MESSAGE)
Q
QPLACE(QNODE,PTR) ; Seek alternate PLACE values and update the Queue
N IEN,VALUE,ACQ
S VALUE=""
I +$P(QNODE,U,12) D Q VALUE
. S VALUE=+$P(QNODE,U,12) Q
S IEN=$P(QNODE,U,7) ; try the Image acquisition site
I IEN?1N.N D
. S ACQ=+$P($G(^MAG(2005,IEN,100)),U,3)
. S:'ACQ ACQ=+$P($G(^MAG(2005.1,IEN,100)),U,3)
. S:ACQ VALUE=$$PLACE^MAGBAPI(ACQ) Q
S:'VALUE VALUE=$$PLACE^MAGBAPI(+$G(DUZ(2))) ; else the BP User
S:VALUE $P(^MAGQUEUE(2006.03,PTR,0),U,12)=VALUE
Q VALUE
QPTER(QUEUE,QPTR,PLACE) ; Conditionally advance the queue pointer & decrement the active queue count
N QREC,PREV,PNODE
I 'PLACE D Q:'PLACE
. S PLACE=$P($G(^MAGQUEUE(2006.03,QPTR,0)),U,12)
. S PLACE=$S(PLACE:PLACE,1:$$PLACE^MAGBAPI(+$G(DUZ(2))))
. Q
S QREC=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
S PREV=$S(QREC:$P(^MAGQUEUE(2006.031,QREC,0),U,2),1:"")
I PREV'=QPTR D Q
. D ADD^MAGBAPI(-1,QUEUE,PLACE)
. L +^MAGQUEUE(2006.031,QREC,0):1E9
. S $P(^MAGQUEUE(2006.031,QREC,0),U,2)=QPTR,$P(^MAGQUEUE(2006.031,QREC,0),U,6)=$$NOW^XLFDT
. L -^MAGQUEUE(2006.031,QREC,0)
. Q
D ADD^MAGBAPI(0,QUEUE,PLACE) ; Else reset the active queue count
Q
RESET(QUEUE) ; Set Routine parameter
Q:QUEUE="ABSTRACT" "MAGQBAB"
Q:QUEUE="JUKEBOX" "MAGQBJB"
Q:QUEUE="JBTOHD" "MAGQBJH"
Q:QUEUE="DELETE" "MAGQBD"
Q:QUEUE="PREFET" "MAGQBJH"
Q:QUEUE="IMPORT" "MAGQBIM"
Q:QUEUE="GCC" "MAGQBGCC"
Q ""
QUPDTE(RESULT,QPTR,UPDATE) ;RPC[MAGQ QUD]
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
N NODE,STAT,TYPE,VPTR,MPTR,IEN,IDFN,MSG,PLACE,DA
S RESULT="0^No Queue entry #"_$G(QPTR) Q:'$G(QPTR) S NODE=$G(^MAGQUEUE(2006.03,QPTR,0)) I NODE="" Q ;P186 race issue, queue entry not exist
S PLACE=$P(NODE,U,12)
S RESULT="1^QUEUE UPDATE COMPLETE"
S STAT=$P(UPDATE,U)
S TYPE=$P(NODE,U)
S MSG=$S($P(UPDATE,U,2)="":TYPE_" Process Error",1:$P(UPDATE,U,2))
D QSTAT(QPTR,MSG,TYPE,.PLACE)
D QPTER(TYPE,QPTR,PLACE)
I STAT<0 Q
I "^DELETE^"[("^"_TYPE_"^") D DQUE^MAGQBUT2(QPTR) Q
I "^IMPORT^"[("^"_TYPE_"^") D DQUE^MAGQBUT2(QPTR) Q
S VPTR=$P(UPDATE,U,3)
I VPTR?1.N D
. S MPTR=$P(NODE,U,7)
. I "^ABSTRACT^"[("^"_TYPE_"^") D Q
. . S $P(^MAG(2005,MPTR,0),U,4)=VPTR
. . S X=$$JUKEBOX^MAGBAPI(MPTR,PLACE)
. . D DQUE^MAGQBUT2(QPTR) Q
. I ("^JBTOHD^"[("^"_TYPE_"^"))!("^PREFET^"[("^"_TYPE_"^")) D Q
. . I "^FULL^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,0),U,3)=VPTR
. . I "^ABSTRACT^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,0),U,4)=VPTR
. . I "^BIG^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,"FBIG"),U)=VPTR
. . D DQUE^MAGQBUT2(QPTR) Q
. I "^JUKEBOX^"[("^"_TYPE_"^") D Q
. . I $P(UPDATE,U,2)["BIG" D Q
. . . S:$D(^MAG(2005,MPTR)) $P(^MAG(2005,MPTR,"FBIG"),U,2)=VPTR
. . . S:$D(^MAG(2005.1,MPTR)) $P(^MAG(2005.1,MPTR,"FBIG"),U,2)=VPTR
. . . D DQUE^MAGQBUT2(QPTR) Q
. . E D
. . . S:$D(^MAG(2005,MPTR)) $P(^MAG(2005,MPTR,0),U,5)=VPTR
. . . S:$D(^MAG(2005.1,MPTR)) $P(^MAG(2005.1,MPTR,0),U,5)=VPTR
. . . D DQUE^MAGQBUT2(QPTR) Q
. . Q
. I "^GCC^"[("^"_TYPE_"^") D Q
. . S FDA(2005.01,"+1,"_MPTR_",",.01)=VPTR
. . S FDA(2005.01,"+1,"_MPTR_",",1)=$$NOW^XLFDT
. . S FDA(2005.01,"+1,"_MPTR_",",2)=$P($$TRIM^MAGQBUT4($P(UPDATE,U,2))," ")
. . D UPDATE^DIE("U","FDA","","MAGIMP")
. . K FDA
. . S IDFN=$P(^MAG(2005,MPTR,0),U,7)
. . D ENTRY^MAGLOG("EXPORT->"_$P($G(^MAG(2005.2,VPTR,0)),U,2),$P(NODE,U,2),MPTR,"Document Imaging",IDFN,0)
. . D DQUE^MAGQBUT2(QPTR) Q
. Q
Q
REQUE(RESULT,QPTR) ;
; RPC[MAGQ REQ]
N PROC,NODE,INDX,PARAM,OPDUZ,STATUS,TRACKID,PLACE,X
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S INDX=$$TRIM^MAGQBUT4(QPTR),TRACKID=0
S NODE=$G(^MAGQUEUE(2006.03,INDX,0))
Q:NODE']""
S PLACE=$P(NODE,U,12)
Q:'PLACE
S PROC=$P(NODE,U),STATUS=$P(NODE,U,5)
I PROC'="IMPORT" D
. D RQP(PROC,NODE,.PARAM)
. D DQUE^MAGQBUT2(INDX)
. S @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,PLACE)")
. Q
E D Q ;IMPORT - Doesn't De-queue Import and Session file
. S $P(PARAM,U,3)=+$P(NODE,U,9)+1
. S $P(PARAM,U,4)=$S($P(NODE,U,11)?1N.N:$P(NODE,U,11),1:QPTR)
. D TIDL^MAGQBIM($S($P(NODE,U,11)?1N.N:$P(NODE,U,11),1:QPTR),PROC,.TRACKID)
. Q:TRACKID=0
. S @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,$P(NODE,U,10),TRACKID,PLACE)")
. D DQUE^MAGQBUT2(INDX,"1")
. Q
Q
RQP(P,N,PAR) ;
N P1,P2,P3,P4
I ("^JBTOHD^PREFET^")[P S P1=$P(N,U,7),P2=$P(N,U,8),P3=+$P(N,U,9)+1,PAR=P1_U_P2_U_P3 Q
I P["DELETE" S P1=$P(N,U,10),P2=+$P(N,U,9)+1,PAR=P2_U_P1 Q
I P["GCC" D Q
. S P1=$P(N,U,7),P2=$P(N,U,10),P3=$P(N,U,11),P4=$P(N,U,9)+1,PAR=P1_U_P2_U_P3_U_P4 Q
S P1=$P(N,U,7)_"^^",P2=+$P(N,U,9)+1,PAR=P1_P2 ;JUKEBOX + ABSTRACT
Q
ERR ;
N ERRXX
S ERRXX=$$EC^%ZOSV
D ^%ZTER
D ^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBTM 10176 printed Dec 13, 2024@02:07:52 Page 2
MAGQBTM ;WOIFO/RMP/JL - REMOTE Task SERVER Program ; 20 April 2017 10:41 AM
+1 ;;3.0;IMAGING;**1,7,8,20,81,39,135,186**;Mar 19, 2002;Build 23;April 20, 2017
+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 QUIT
ENTRY(RESULT,WSTAT,PROCESS) ; RPC[MAGQ ABP]
+1 NEW X,SYSIEN,SYSNAME,NODE,INDX,CNT,PROC,%,QPTR,QCNT,VERS,EXEDATE,WSOS,PLACE,VOK,EXDATE
+2 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+3 SET (SYSIEN,CNT)=0
SET SYSNAME=""
SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
SET VOK=""
+4 SET $PIECE(RESULT(0),U,6)=$DATA(^XUSEC("MAG SYSTEM",DUZ))
+5 if '$PIECE(RESULT(0),U,6)
QUIT
+6 SET VERS=$PIECE(WSTAT,U,2)
+7 SET WSTAT=$PIECE(WSTAT,U)
+8 SET SYSIEN=$ORDER(^MAG(2006.8,"C",PLACE,WSTAT,""))
+9 IF 'SYSIEN
SET SYSIEN=$ORDER(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4(WSTAT),""))
+10 IF 'SYSIEN
Begin DoDot:1
+11 NEW TRY
+12 FOR TRY=1:1:$LENGTH(WSTAT,".")
Begin DoDot:2
+13 SET SYSIEN=$ORDER(^MAG(2006.8,"C",PLACE,$PIECE(WSTAT,".",TRY),""))
+14 IF 'SYSIEN
SET SYSIEN=$ORDER(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4($PIECE(WSTAT,".",TRY)),""))
End DoDot:2
if SYSIEN?1.N
QUIT
End DoDot:1
+15 if SYSIEN=""
QUIT
+16 SET VERS=$PIECE(VERS,".",1,2)_"P"_$PIECE(VERS,".",3)
+17 DO VOKR^MAGQBUT4(.VOK,VERS)
+18 if '$PIECE(VOK,U)
QUIT
+19 SET NODE=^MAG(2006.8,SYSIEN,0)
+20 SET SYSNAME=$PIECE(NODE,U)
+21 IF SYSNAME=""
Begin DoDot:1
+22 SET $PIECE(RESULT(0),U,1,2)="-1^No Background Processor parameters on system"
End DoDot:1
QUIT
+23 IF $PIECE(NODE,U,12)'=1
Begin DoDot:1
+24 SET $PIECE(RESULT(0),U,1,2)="-1^Not assigned as a Background Processor"
End DoDot:1
QUIT
+25 FOR PROC="ABSTRACT;13","JUKEBOX;14","JBTOHD;15","DELETE;23","PREFET;16","GCC;18","IMPORT;17"
Begin DoDot:1
+26 NEW PIECE,NAME
+27 IF $$UBPW^MAGQBUT1(SYSNAME,PROC)
Begin DoDot:2
+28 SET $PIECE(RESULT(0),U,1,2)="-1^This BP: "_SYSNAME_" has a co-assigned queue: "_$PIECE(PROC,";")
End DoDot:2
QUIT
+29 SET NAME=$PIECE(PROC,";")
+30 SET PIECE=$PIECE(PROC,";",2)
+31 IF $PIECE(NODE,U,PIECE)="1"
Begin DoDot:2
+32 NEW QCNT,QPTR
+33 DO ADD^MAGBAPI(0,NAME,PLACE)
+34 SET QPTR=$ORDER(^MAGQUEUE(2006.031,"C",PLACE,NAME,""))
+35 SET QCNT=$PIECE($GET(^MAGQUEUE(2006.031,+QPTR,0)),U,3)
+36 SET CNT=CNT+1
+37 SET RESULT(CNT)=NAME_U_QCNT_U_(+$PIECE($GET(^MAGQUEUE(2006.031,+QPTR,0)),U,5)-QCNT)
+38 ; Refresh the queue count if negative
IF +$PIECE(RESULT(CNT),U,3)<0
Begin DoDot:3
+39 DO QCNT^MAGQBUT4("",PLACE,NAME)
+40 SET RESULT(CNT)=NAME_U_QCNT_U_(+$PIECE($GET(^MAGQUEUE(2006.031,+QPTR,0)),U,5)-QCNT)
+41 QUIT
End DoDot:3
+42 QUIT
End DoDot:2
+43 QUIT
End DoDot:1
if $PIECE(RESULT(0),U,1)="-1"
QUIT
+44 if $PIECE(RESULT(0),U,1)="-1"
QUIT
+45 SET $PIECE(RESULT(0),U,1,5)="0^BP List^PID: "_$$BASE^XLFUTL($JOB,10,16)_"^"_SYSNAME_U_WSTAT
+46 QUIT
GETQUE(RESULT,ACTION) ; RPC[MAGQ GET]
+1 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+2 NEW PLACE
+3 DO @(ACTION_"(.RESULT)")
+4 ; Update queue status and increment the Queue pointer if the queue cannot be processed
IF +RESULT<0
Begin DoDot:1
+5 NEW PLACE
SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+6 DO QSTAT($PIECE(RESULT,U,2),$PIECE(RESULT,U,3),ACTION,.PLACE)
+7 DO QPTER(ACTION,$PIECE(RESULT,U,2),.PLACE)
+8 QUIT
End DoDot:1
+9 QUIT
ABSTRACT(RESULT) ;
+1 DO DEQUEUE("ABSTRACT",.RESULT)
QUIT
JUKEBOX(RESULT) ;
+1 DO DEQUEUE("JUKEBOX",.RESULT)
QUIT
JBTOHD(RESULT) ;
+1 DO DEQUEUE("JBTOHD",.RESULT)
QUIT
GCC(RESULT) ;
+1 DO DEQUEUE("GCC",.RESULT)
QUIT
DELETE(RESULT) ;
+1 DO DEQUEUE("DELETE",.RESULT)
QUIT
PREFET(RESULT) ;
+1 DO DEQUEUE("PREFET",.RESULT)
QUIT
IMPORT(RESULT) ;
+1 DO DEQUEUE("IMPORT",.RESULT)
QUIT
DEQUEUE(QUE,RESULT) ;
+1 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+2 NEW QPTR,QPTR2,ROU,MAGIEN,ZNODE,MSG,IMQUE,PLACE
+3 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+4 SET QPTR2=$ORDER(^MAGQUEUE(2006.031,"C",PLACE,QUE,""))
+5 SET QPTR=$SELECT(QPTR2:$PIECE(^MAGQUEUE(2006.031,QPTR2,0),U,2),1:"")
+6 SET QPTR=$ORDER(^MAGQUEUE(2006.03,"C",PLACE,QUE,QPTR))
+7 IF QPTR=""
Begin DoDot:1
+8 SET RESULT="0"_U_QPTR2_U_"No "_QUE_" "_QPTR2_" to process."
End DoDot:1
QUIT
+9 DO QSTAT(QPTR,QUE_" in progress.",QUE,.PLACE)
+10 SET ZNODE=$GET(^MAGQUEUE(2006.03,QPTR,0))
+11 IF ZNODE=""
SET RESULT=-101_U_QPTR_U_"Queue Record does not exist"
QUIT
+12 IF QUE="IMPORT"
DO ENTRY^MAGQBIM(QPTR,QUE,QPTR2,ZNODE,.RESULT)
QUIT
+13 SET MAGIEN=$PIECE(ZNODE,"^",7)
+14 IF ("^DELETE^JUKEBOX^")'[(U_QUE_U)
IF (('(+MAGIEN))!('$DATA(^MAG(2005,+MAGIEN,0)))!($PIECE(ZNODE,U)'=QUE))
Begin DoDot:1
+15 IF $DATA(^MAG(2005.1,+MAGIEN,0))
Begin DoDot:2
+16 SET MSG="Image Record Deleted and in archive file."
End DoDot:2
+17 IF '$TEST
SET MSG="No valid image file number to process."
+18 SET RESULT=-101_U_QPTR_U_MSG
End DoDot:1
QUIT
+19 SET ROU=$$RESET(QUE)
+20 IF ROU=""
SET RESULT="-1"_U_QPTR_U_QUE_" Is an inactive process"
QUIT
+21 DO @("ENTRY^"_ROU_"(.RESULT,QPTR)")
+22 QUIT
QSTAT(QPTR,MESSAGE,ACTION,PLACE) ;Update the Queue status
+1 NEW ZNODE,MAGTIME
+2 if QPTR=""
QUIT
+3 SET MESSAGE=$TRANSLATE(MESSAGE,":;<>.?/\'()*^%$#@!0123456789","")
+4 if '$DATA(^MAGQUEUE(2006.03,QPTR,0))
QUIT
+5 SET ZNODE=$GET(^MAGQUEUE(2006.03,QPTR,0))
+6 SET MAGTIME=$$NOW^XLFDT
+7 if '$GET(PLACE)
SET PLACE=$$QPLACE(ZNODE,QPTR)
+8 if 'PLACE
QUIT
+9 IF $PIECE(ZNODE,U,5)]""
Begin DoDot:1
+10 KILL ^MAGQUEUE(2006.03,"D",PLACE,$PIECE(ZNODE,U),$EXTRACT($PIECE(ZNODE,U,5),1,30),QPTR)
QUIT
End DoDot:1
+11 SET ^MAGQUEUE(2006.03,"D",PLACE,$PIECE(ZNODE,U),$EXTRACT(MESSAGE,1,30),QPTR)=""
+12 SET $PIECE(^MAGQUEUE(2006.03,QPTR,0),U,5,6)=$PIECE(MESSAGE,U)_U_MAGTIME
+13 IF ACTION["IMPORT"
DO STAT^MAGQBIM($SELECT($PIECE(ZNODE,U,11)?1N.N:$PIECE(ZNODE,U,11),1:QPTR),MAGTIME,MESSAGE)
+14 QUIT
QPLACE(QNODE,PTR) ; Seek alternate PLACE values and update the Queue
+1 NEW IEN,VALUE,ACQ
+2 SET VALUE=""
+3 IF +$PIECE(QNODE,U,12)
Begin DoDot:1
+4 SET VALUE=+$PIECE(QNODE,U,12)
QUIT
End DoDot:1
QUIT VALUE
+5 ; try the Image acquisition site
SET IEN=$PIECE(QNODE,U,7)
+6 IF IEN?1N.N
Begin DoDot:1
+7 SET ACQ=+$PIECE($GET(^MAG(2005,IEN,100)),U,3)
+8 if 'ACQ
SET ACQ=+$PIECE($GET(^MAG(2005.1,IEN,100)),U,3)
+9 if ACQ
SET VALUE=$$PLACE^MAGBAPI(ACQ)
QUIT
End DoDot:1
+10 ; else the BP User
if 'VALUE
SET VALUE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+11 if VALUE
SET $PIECE(^MAGQUEUE(2006.03,PTR,0),U,12)=VALUE
+12 QUIT VALUE
QPTER(QUEUE,QPTR,PLACE) ; Conditionally advance the queue pointer & decrement the active queue count
+1 NEW QREC,PREV,PNODE
+2 IF 'PLACE
Begin DoDot:1
+3 SET PLACE=$PIECE($GET(^MAGQUEUE(2006.03,QPTR,0)),U,12)
+4 SET PLACE=$SELECT(PLACE:PLACE,1:$$PLACE^MAGBAPI(+$GET(DUZ(2))))
+5 QUIT
End DoDot:1
if 'PLACE
QUIT
+6 SET QREC=$ORDER(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
+7 SET PREV=$SELECT(QREC:$PIECE(^MAGQUEUE(2006.031,QREC,0),U,2),1:"")
+8 IF PREV'=QPTR
Begin DoDot:1
+9 DO ADD^MAGBAPI(-1,QUEUE,PLACE)
+10 LOCK +^MAGQUEUE(2006.031,QREC,0):1E9
+11 SET $PIECE(^MAGQUEUE(2006.031,QREC,0),U,2)=QPTR
SET $PIECE(^MAGQUEUE(2006.031,QREC,0),U,6)=$$NOW^XLFDT
+12 LOCK -^MAGQUEUE(2006.031,QREC,0)
+13 QUIT
End DoDot:1
QUIT
+14 ; Else reset the active queue count
DO ADD^MAGBAPI(0,QUEUE,PLACE)
+15 QUIT
RESET(QUEUE) ; Set Routine parameter
+1 if QUEUE="ABSTRACT"
QUIT "MAGQBAB"
+2 if QUEUE="JUKEBOX"
QUIT "MAGQBJB"
+3 if QUEUE="JBTOHD"
QUIT "MAGQBJH"
+4 if QUEUE="DELETE"
QUIT "MAGQBD"
+5 if QUEUE="PREFET"
QUIT "MAGQBJH"
+6 if QUEUE="IMPORT"
QUIT "MAGQBIM"
+7 if QUEUE="GCC"
QUIT "MAGQBGCC"
+8 QUIT ""
QUPDTE(RESULT,QPTR,UPDATE) ;RPC[MAGQ QUD]
+1 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+2 NEW NODE,STAT,TYPE,VPTR,MPTR,IEN,IDFN,MSG,PLACE,DA
+3 ;P186 race issue, queue entry not exist
SET RESULT="0^No Queue entry #"_$GET(QPTR)
if '$GET(QPTR)
QUIT
SET NODE=$GET(^MAGQUEUE(2006.03,QPTR,0))
IF NODE=""
QUIT
+4 SET PLACE=$PIECE(NODE,U,12)
+5 SET RESULT="1^QUEUE UPDATE COMPLETE"
+6 SET STAT=$PIECE(UPDATE,U)
+7 SET TYPE=$PIECE(NODE,U)
+8 SET MSG=$SELECT($PIECE(UPDATE,U,2)="":TYPE_" Process Error",1:$PIECE(UPDATE,U,2))
+9 DO QSTAT(QPTR,MSG,TYPE,.PLACE)
+10 DO QPTER(TYPE,QPTR,PLACE)
+11 IF STAT<0
QUIT
+12 IF "^DELETE^"[("^"_TYPE_"^")
DO DQUE^MAGQBUT2(QPTR)
QUIT
+13 IF "^IMPORT^"[("^"_TYPE_"^")
DO DQUE^MAGQBUT2(QPTR)
QUIT
+14 SET VPTR=$PIECE(UPDATE,U,3)
+15 IF VPTR?1.N
Begin DoDot:1
+16 SET MPTR=$PIECE(NODE,U,7)
+17 IF "^ABSTRACT^"[("^"_TYPE_"^")
Begin DoDot:2
+18 SET $PIECE(^MAG(2005,MPTR,0),U,4)=VPTR
+19 SET X=$$JUKEBOX^MAGBAPI(MPTR,PLACE)
+20 DO DQUE^MAGQBUT2(QPTR)
QUIT
End DoDot:2
QUIT
+21 IF ("^JBTOHD^"[("^"_TYPE_"^"))!("^PREFET^"[("^"_TYPE_"^"))
Begin DoDot:2
+22 IF "^FULL^"[$PIECE(NODE,U,8)
SET $PIECE(^MAG(2005,MPTR,0),U,3)=VPTR
+23 IF "^ABSTRACT^"[$PIECE(NODE,U,8)
SET $PIECE(^MAG(2005,MPTR,0),U,4)=VPTR
+24 IF "^BIG^"[$PIECE(NODE,U,8)
SET $PIECE(^MAG(2005,MPTR,"FBIG"),U)=VPTR
+25 DO DQUE^MAGQBUT2(QPTR)
QUIT
End DoDot:2
QUIT
+26 IF "^JUKEBOX^"[("^"_TYPE_"^")
Begin DoDot:2
+27 IF $PIECE(UPDATE,U,2)["BIG"
Begin DoDot:3
+28 if $DATA(^MAG(2005,MPTR))
SET $PIECE(^MAG(2005,MPTR,"FBIG"),U,2)=VPTR
+29 if $DATA(^MAG(2005.1,MPTR))
SET $PIECE(^MAG(2005.1,MPTR,"FBIG"),U,2)=VPTR
+30 DO DQUE^MAGQBUT2(QPTR)
QUIT
End DoDot:3
QUIT
+31 IF '$TEST
Begin DoDot:3
+32 if $DATA(^MAG(2005,MPTR))
SET $PIECE(^MAG(2005,MPTR,0),U,5)=VPTR
+33 if $DATA(^MAG(2005.1,MPTR))
SET $PIECE(^MAG(2005.1,MPTR,0),U,5)=VPTR
+34 DO DQUE^MAGQBUT2(QPTR)
QUIT
End DoDot:3
+35 QUIT
End DoDot:2
QUIT
+36 IF "^GCC^"[("^"_TYPE_"^")
Begin DoDot:2
+37 SET FDA(2005.01,"+1,"_MPTR_",",.01)=VPTR
+38 SET FDA(2005.01,"+1,"_MPTR_",",1)=$$NOW^XLFDT
+39 SET FDA(2005.01,"+1,"_MPTR_",",2)=$PIECE($$TRIM^MAGQBUT4($PIECE(UPDATE,U,2))," ")
+40 DO UPDATE^DIE("U","FDA","","MAGIMP")
+41 KILL FDA
+42 SET IDFN=$PIECE(^MAG(2005,MPTR,0),U,7)
+43 DO ENTRY^MAGLOG("EXPORT->"_$PIECE($GET(^MAG(2005.2,VPTR,0)),U,2),$PIECE(NODE,U,2),MPTR,"Document Imaging",IDFN,0)
+44 DO DQUE^MAGQBUT2(QPTR)
QUIT
End DoDot:2
QUIT
+45 QUIT
End DoDot:1
+46 QUIT
REQUE(RESULT,QPTR) ;
+1 ; RPC[MAGQ REQ]
+2 NEW PROC,NODE,INDX,PARAM,OPDUZ,STATUS,TRACKID,PLACE,X
+3 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+4 SET INDX=$$TRIM^MAGQBUT4(QPTR)
SET TRACKID=0
+5 SET NODE=$GET(^MAGQUEUE(2006.03,INDX,0))
+6 if NODE']""
QUIT
+7 SET PLACE=$PIECE(NODE,U,12)
+8 if 'PLACE
QUIT
+9 SET PROC=$PIECE(NODE,U)
SET STATUS=$PIECE(NODE,U,5)
+10 IF PROC'="IMPORT"
Begin DoDot:1
+11 DO RQP(PROC,NODE,.PARAM)
+12 DO DQUE^MAGQBUT2(INDX)
+13 SET @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,PLACE)")
+14 QUIT
End DoDot:1
+15 ;IMPORT - Doesn't De-queue Import and Session file
IF '$TEST
Begin DoDot:1
+16 SET $PIECE(PARAM,U,3)=+$PIECE(NODE,U,9)+1
+17 SET $PIECE(PARAM,U,4)=$SELECT($PIECE(NODE,U,11)?1N.N:$PIECE(NODE,U,11),1:QPTR)
+18 DO TIDL^MAGQBIM($SELECT($PIECE(NODE,U,11)?1N.N:$PIECE(NODE,U,11),1:QPTR),PROC,.TRACKID)
+19 if TRACKID=0
QUIT
+20 SET @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,$P(NODE,U,10),TRACKID,PLACE)")
+21 DO DQUE^MAGQBUT2(INDX,"1")
+22 QUIT
End DoDot:1
QUIT
+23 QUIT
RQP(P,N,PAR) ;
+1 NEW P1,P2,P3,P4
+2 IF ("^JBTOHD^PREFET^")[P
SET P1=$PIECE(N,U,7)
SET P2=$PIECE(N,U,8)
SET P3=+$PIECE(N,U,9)+1
SET PAR=P1_U_P2_U_P3
QUIT
+3 IF P["DELETE"
SET P1=$PIECE(N,U,10)
SET P2=+$PIECE(N,U,9)+1
SET PAR=P2_U_P1
QUIT
+4 IF P["GCC"
Begin DoDot:1
+5 SET P1=$PIECE(N,U,7)
SET P2=$PIECE(N,U,10)
SET P3=$PIECE(N,U,11)
SET P4=$PIECE(N,U,9)+1
SET PAR=P1_U_P2_U_P3_U_P4
QUIT
End DoDot:1
QUIT
+6 ;JUKEBOX + ABSTRACT
SET P1=$PIECE(N,U,7)_"^^"
SET P2=+$PIECE(N,U,9)+1
SET PAR=P1_P2
+7 QUIT
ERR ;
+1 NEW ERRXX
+2 SET ERRXX=$$EC^%ZOSV
+3 DO ^%ZTER
+4 DO ^XUSCLEAN
+5 QUIT
