- 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 Feb 18, 2025@23:34:20 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