Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGQBTM

MAGQBTM.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ENTRY(RESULT,WSTAT,PROCESS) ; RPC[MAGQ ABP]
  1. N X,SYSIEN,SYSNAME,NODE,INDX,CNT,PROC,%,QPTR,QCNT,VERS,EXEDATE,WSOS,PLACE,VOK,EXDATE
  1. S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1. S (SYSIEN,CNT)=0,SYSNAME="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),VOK=""
  1. S $P(RESULT(0),U,6)=$D(^XUSEC("MAG SYSTEM",DUZ))
  1. Q:'$P(RESULT(0),U,6)
  1. S VERS=$P(WSTAT,U,2)
  1. S WSTAT=$P(WSTAT,U)
  1. S SYSIEN=$O(^MAG(2006.8,"C",PLACE,WSTAT,""))
  1. I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4(WSTAT),""))
  1. I 'SYSIEN D
  1. . N TRY
  1. . F TRY=1:1:$L(WSTAT,".") D Q:SYSIEN?1.N
  1. . . S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$P(WSTAT,".",TRY),""))
  1. . . I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4($P(WSTAT,".",TRY)),""))
  1. Q:SYSIEN=""
  1. S VERS=$P(VERS,".",1,2)_"P"_$P(VERS,".",3)
  1. D VOKR^MAGQBUT4(.VOK,VERS)
  1. Q:'$P(VOK,U)
  1. S NODE=^MAG(2006.8,SYSIEN,0)
  1. S SYSNAME=$P(NODE,U)
  1. I SYSNAME="" D Q
  1. . S $P(RESULT(0),U,1,2)="-1^No Background Processor parameters on system"
  1. I $P(NODE,U,12)'=1 D Q
  1. . S $P(RESULT(0),U,1,2)="-1^Not assigned as a Background Processor"
  1. F PROC="ABSTRACT;13","JUKEBOX;14","JBTOHD;15","DELETE;23","PREFET;16","GCC;18","IMPORT;17" D Q:$P(RESULT(0),U,1)="-1"
  1. . N PIECE,NAME
  1. . I $$UBPW^MAGQBUT1(SYSNAME,PROC) D Q
  1. . . S $P(RESULT(0),U,1,2)="-1^This BP: "_SYSNAME_" has a co-assigned queue: "_$P(PROC,";")
  1. . S NAME=$P(PROC,";")
  1. . S PIECE=$P(PROC,";",2)
  1. . I $P(NODE,U,PIECE)="1" D
  1. . . N QCNT,QPTR
  1. . . D ADD^MAGBAPI(0,NAME,PLACE)
  1. . . S QPTR=$O(^MAGQUEUE(2006.031,"C",PLACE,NAME,""))
  1. . . S QCNT=$P($G(^MAGQUEUE(2006.031,+QPTR,0)),U,3)
  1. . . S CNT=CNT+1
  1. . . S RESULT(CNT)=NAME_U_QCNT_U_(+$P($G(^MAGQUEUE(2006.031,+QPTR,0)),U,5)-QCNT)
  1. . . I +$P(RESULT(CNT),U,3)<0 D ; Refresh the queue count if negative
  1. . . . D QCNT^MAGQBUT4("",PLACE,NAME)
  1. . . . S RESULT(CNT)=NAME_U_QCNT_U_(+$P($G(^MAGQUEUE(2006.031,+QPTR,0)),U,5)-QCNT)
  1. . . . Q
  1. . . Q
  1. . Q
  1. Q:$P(RESULT(0),U,1)="-1"
  1. S $P(RESULT(0),U,1,5)="0^BP List^PID: "_$$BASE^XLFUTL($J,10,16)_"^"_SYSNAME_U_WSTAT
  1. Q
  1. GETQUE(RESULT,ACTION) ; RPC[MAGQ GET]
  1. S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1. N PLACE
  1. D @(ACTION_"(.RESULT)")
  1. I +RESULT<0 D ; Update queue status and increment the Queue pointer if the queue cannot be processed
  1. . N PLACE S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
  1. . D QSTAT($P(RESULT,U,2),$P(RESULT,U,3),ACTION,.PLACE)
  1. . D QPTER(ACTION,$P(RESULT,U,2),.PLACE)
  1. . Q
  1. Q
  1. ABSTRACT(RESULT) ;
  1. D DEQUEUE("ABSTRACT",.RESULT) Q
  1. JUKEBOX(RESULT) ;
  1. D DEQUEUE("JUKEBOX",.RESULT) Q
  1. JBTOHD(RESULT) ;
  1. D DEQUEUE("JBTOHD",.RESULT) Q
  1. GCC(RESULT) ;
  1. D DEQUEUE("GCC",.RESULT) Q
  1. DELETE(RESULT) ;
  1. D DEQUEUE("DELETE",.RESULT) Q
  1. PREFET(RESULT) ;
  1. D DEQUEUE("PREFET",.RESULT) Q
  1. IMPORT(RESULT) ;
  1. D DEQUEUE("IMPORT",.RESULT) Q
  1. DEQUEUE(QUE,RESULT) ;
  1. S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1. N QPTR,QPTR2,ROU,MAGIEN,ZNODE,MSG,IMQUE,PLACE
  1. S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
  1. S QPTR2=$O(^MAGQUEUE(2006.031,"C",PLACE,QUE,""))
  1. S QPTR=$S(QPTR2:$P(^MAGQUEUE(2006.031,QPTR2,0),U,2),1:"")
  1. S QPTR=$O(^MAGQUEUE(2006.03,"C",PLACE,QUE,QPTR))
  1. I QPTR="" D Q
  1. . S RESULT="0"_U_QPTR2_U_"No "_QUE_" "_QPTR2_" to process."
  1. D QSTAT(QPTR,QUE_" in progress.",QUE,.PLACE)
  1. S ZNODE=$G(^MAGQUEUE(2006.03,QPTR,0))
  1. I ZNODE="" S RESULT=-101_U_QPTR_U_"Queue Record does not exist" Q
  1. I QUE="IMPORT" D ENTRY^MAGQBIM(QPTR,QUE,QPTR2,ZNODE,.RESULT) Q
  1. S MAGIEN=$P(ZNODE,"^",7)
  1. I ("^DELETE^JUKEBOX^")'[(U_QUE_U),(('(+MAGIEN))!('$D(^MAG(2005,+MAGIEN,0)))!($P(ZNODE,U)'=QUE)) D Q
  1. . I $D(^MAG(2005.1,+MAGIEN,0)) D
  1. . . S MSG="Image Record Deleted and in archive file."
  1. . E S MSG="No valid image file number to process."
  1. . S RESULT=-101_U_QPTR_U_MSG
  1. S ROU=$$RESET(QUE)
  1. I ROU="" S RESULT="-1"_U_QPTR_U_QUE_" Is an inactive process" Q
  1. D @("ENTRY^"_ROU_"(.RESULT,QPTR)")
  1. Q
  1. QSTAT(QPTR,MESSAGE,ACTION,PLACE) ;Update the Queue status
  1. N ZNODE,MAGTIME
  1. Q:QPTR=""
  1. S MESSAGE=$TR(MESSAGE,":;<>.?/\'()*^%$#@!0123456789","")
  1. Q:'$D(^MAGQUEUE(2006.03,QPTR,0))
  1. S ZNODE=$G(^MAGQUEUE(2006.03,QPTR,0))
  1. S MAGTIME=$$NOW^XLFDT
  1. S:'$G(PLACE) PLACE=$$QPLACE(ZNODE,QPTR)
  1. Q:'PLACE
  1. I $P(ZNODE,U,5)]"" D
  1. . K ^MAGQUEUE(2006.03,"D",PLACE,$P(ZNODE,U),$E($P(ZNODE,U,5),1,30),QPTR) Q
  1. S ^MAGQUEUE(2006.03,"D",PLACE,$P(ZNODE,U),$E(MESSAGE,1,30),QPTR)=""
  1. S $P(^MAGQUEUE(2006.03,QPTR,0),U,5,6)=$P(MESSAGE,U)_U_MAGTIME
  1. I ACTION["IMPORT" D STAT^MAGQBIM($S($P(ZNODE,U,11)?1N.N:$P(ZNODE,U,11),1:QPTR),MAGTIME,MESSAGE)
  1. Q
  1. QPLACE(QNODE,PTR) ; Seek alternate PLACE values and update the Queue
  1. N IEN,VALUE,ACQ
  1. S VALUE=""
  1. I +$P(QNODE,U,12) D Q VALUE
  1. . S VALUE=+$P(QNODE,U,12) Q
  1. S IEN=$P(QNODE,U,7) ; try the Image acquisition site
  1. I IEN?1N.N D
  1. . S ACQ=+$P($G(^MAG(2005,IEN,100)),U,3)
  1. . S:'ACQ ACQ=+$P($G(^MAG(2005.1,IEN,100)),U,3)
  1. . S:ACQ VALUE=$$PLACE^MAGBAPI(ACQ) Q
  1. S:'VALUE VALUE=$$PLACE^MAGBAPI(+$G(DUZ(2))) ; else the BP User
  1. S:VALUE $P(^MAGQUEUE(2006.03,PTR,0),U,12)=VALUE
  1. Q VALUE
  1. QPTER(QUEUE,QPTR,PLACE) ; Conditionally advance the queue pointer & decrement the active queue count
  1. N QREC,PREV,PNODE
  1. I 'PLACE D Q:'PLACE
  1. . S PLACE=$P($G(^MAGQUEUE(2006.03,QPTR,0)),U,12)
  1. . S PLACE=$S(PLACE:PLACE,1:$$PLACE^MAGBAPI(+$G(DUZ(2))))
  1. . Q
  1. S QREC=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
  1. S PREV=$S(QREC:$P(^MAGQUEUE(2006.031,QREC,0),U,2),1:"")
  1. I PREV'=QPTR D Q
  1. . D ADD^MAGBAPI(-1,QUEUE,PLACE)
  1. . L +^MAGQUEUE(2006.031,QREC,0):1E9
  1. . S $P(^MAGQUEUE(2006.031,QREC,0),U,2)=QPTR,$P(^MAGQUEUE(2006.031,QREC,0),U,6)=$$NOW^XLFDT
  1. . L -^MAGQUEUE(2006.031,QREC,0)
  1. . Q
  1. D ADD^MAGBAPI(0,QUEUE,PLACE) ; Else reset the active queue count
  1. Q
  1. RESET(QUEUE) ; Set Routine parameter
  1. Q:QUEUE="ABSTRACT" "MAGQBAB"
  1. Q:QUEUE="JUKEBOX" "MAGQBJB"
  1. Q:QUEUE="JBTOHD" "MAGQBJH"
  1. Q:QUEUE="DELETE" "MAGQBD"
  1. Q:QUEUE="PREFET" "MAGQBJH"
  1. Q:QUEUE="IMPORT" "MAGQBIM"
  1. Q:QUEUE="GCC" "MAGQBGCC"
  1. Q ""
  1. QUPDTE(RESULT,QPTR,UPDATE) ;RPC[MAGQ QUD]
  1. S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1. N NODE,STAT,TYPE,VPTR,MPTR,IEN,IDFN,MSG,PLACE,DA
  1. 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
  1. S PLACE=$P(NODE,U,12)
  1. S RESULT="1^QUEUE UPDATE COMPLETE"
  1. S STAT=$P(UPDATE,U)
  1. S TYPE=$P(NODE,U)
  1. S MSG=$S($P(UPDATE,U,2)="":TYPE_" Process Error",1:$P(UPDATE,U,2))
  1. D QSTAT(QPTR,MSG,TYPE,.PLACE)
  1. D QPTER(TYPE,QPTR,PLACE)
  1. I STAT<0 Q
  1. I "^DELETE^"[("^"_TYPE_"^") D DQUE^MAGQBUT2(QPTR) Q
  1. I "^IMPORT^"[("^"_TYPE_"^") D DQUE^MAGQBUT2(QPTR) Q
  1. S VPTR=$P(UPDATE,U,3)
  1. I VPTR?1.N D
  1. . S MPTR=$P(NODE,U,7)
  1. . I "^ABSTRACT^"[("^"_TYPE_"^") D Q
  1. . . S $P(^MAG(2005,MPTR,0),U,4)=VPTR
  1. . . S X=$$JUKEBOX^MAGBAPI(MPTR,PLACE)
  1. . . D DQUE^MAGQBUT2(QPTR) Q
  1. . I ("^JBTOHD^"[("^"_TYPE_"^"))!("^PREFET^"[("^"_TYPE_"^")) D Q
  1. . . I "^FULL^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,0),U,3)=VPTR
  1. . . I "^ABSTRACT^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,0),U,4)=VPTR
  1. . . I "^BIG^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,"FBIG"),U)=VPTR
  1. . . D DQUE^MAGQBUT2(QPTR) Q
  1. . I "^JUKEBOX^"[("^"_TYPE_"^") D Q
  1. . . I $P(UPDATE,U,2)["BIG" D Q
  1. . . . S:$D(^MAG(2005,MPTR)) $P(^MAG(2005,MPTR,"FBIG"),U,2)=VPTR
  1. . . . S:$D(^MAG(2005.1,MPTR)) $P(^MAG(2005.1,MPTR,"FBIG"),U,2)=VPTR
  1. . . . D DQUE^MAGQBUT2(QPTR) Q
  1. . . E D
  1. . . . S:$D(^MAG(2005,MPTR)) $P(^MAG(2005,MPTR,0),U,5)=VPTR
  1. . . . S:$D(^MAG(2005.1,MPTR)) $P(^MAG(2005.1,MPTR,0),U,5)=VPTR
  1. . . . D DQUE^MAGQBUT2(QPTR) Q
  1. . . Q
  1. . I "^GCC^"[("^"_TYPE_"^") D Q
  1. . . S FDA(2005.01,"+1,"_MPTR_",",.01)=VPTR
  1. . . S FDA(2005.01,"+1,"_MPTR_",",1)=$$NOW^XLFDT
  1. . . S FDA(2005.01,"+1,"_MPTR_",",2)=$P($$TRIM^MAGQBUT4($P(UPDATE,U,2))," ")
  1. . . D UPDATE^DIE("U","FDA","","MAGIMP")
  1. . . K FDA
  1. . . S IDFN=$P(^MAG(2005,MPTR,0),U,7)
  1. . . D ENTRY^MAGLOG("EXPORT->"_$P($G(^MAG(2005.2,VPTR,0)),U,2),$P(NODE,U,2),MPTR,"Document Imaging",IDFN,0)
  1. . . D DQUE^MAGQBUT2(QPTR) Q
  1. . Q
  1. Q
  1. REQUE(RESULT,QPTR) ;
  1. ; RPC[MAGQ REQ]
  1. N PROC,NODE,INDX,PARAM,OPDUZ,STATUS,TRACKID,PLACE,X
  1. S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1. S INDX=$$TRIM^MAGQBUT4(QPTR),TRACKID=0
  1. S NODE=$G(^MAGQUEUE(2006.03,INDX,0))
  1. Q:NODE']""
  1. S PLACE=$P(NODE,U,12)
  1. Q:'PLACE
  1. S PROC=$P(NODE,U),STATUS=$P(NODE,U,5)
  1. I PROC'="IMPORT" D
  1. . D RQP(PROC,NODE,.PARAM)
  1. . D DQUE^MAGQBUT2(INDX)
  1. . S @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,PLACE)")
  1. . Q
  1. E D Q ;IMPORT - Doesn't De-queue Import and Session file
  1. . S $P(PARAM,U,3)=+$P(NODE,U,9)+1
  1. . S $P(PARAM,U,4)=$S($P(NODE,U,11)?1N.N:$P(NODE,U,11),1:QPTR)
  1. . D TIDL^MAGQBIM($S($P(NODE,U,11)?1N.N:$P(NODE,U,11),1:QPTR),PROC,.TRACKID)
  1. . Q:TRACKID=0
  1. . S @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,$P(NODE,U,10),TRACKID,PLACE)")
  1. . D DQUE^MAGQBUT2(INDX,"1")
  1. . Q
  1. Q
  1. RQP(P,N,PAR) ;
  1. N P1,P2,P3,P4
  1. 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
  1. I P["DELETE" S P1=$P(N,U,10),P2=+$P(N,U,9)+1,PAR=P2_U_P1 Q
  1. I P["GCC" D Q
  1. . 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
  1. S P1=$P(N,U,7)_"^^",P2=+$P(N,U,9)+1,PAR=P1_P2 ;JUKEBOX + ABSTRACT
  1. Q
  1. ERR ;
  1. N ERRXX
  1. S ERRXX=$$EC^%ZOSV
  1. D ^%ZTER
  1. D ^XUSCLEAN
  1. Q