MAGBAPI ;WOIFO/PMK,RMP,SEB,MLH - Background Processor API to build queues ; 27 Aug 2014 5:12 PM
;;3.0;IMAGING;**1,7,8,20,39,154**;Mar 19, 2002;Build 9;Mar 08, 2011
;; 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
; The API returns the entry's queue pointer
;
ABSTRACT(INPUT,PLACE) ; Entry point to create an image abstract
; input = image pointer
Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,INPUT,0)),U,2)) 0
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
Q $$QUEUE("ABSTRACT",INPUT,PLACE)
;
GCC(INPUT,PLACE) ; Entry point to create an Document Imaging Export Copy
; input = image pointer(^Second Piece Optional Location specified^3rd optional extension(s) specifier
; plus "~" separated alternate source file types
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
Q $$QUEUE("GCC",$P(INPUT,"^")_"^^"_$P(INPUT,"^",4)_"^"_$P(INPUT,"^",2,3),PLACE)
JUKEBOX(INPUT,PLACE) ; Entry point to copy an image file and abstract to the Jukebox / input = image pointer
N NEXT,CONS,GB
S GB=$G(^MAG(2005,+$P(INPUT,U),0))
S:GB="" GB=$G(^MAG(2005.1,+$P(INPUT,U),0))
Q:GB="" 0
Q:$$IMOFFLN^MAGFILEB($P(GB,U,2)) 0
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
S CONS=$$CONSOLID()
S NEXT=$O(^MAGQUEUE(2006.03,"E",PLACE,$P(INPUT,"^"),$$NEXTQ("JUKEBOX",PLACE)))
Q:NEXT?1N.N NEXT
S NEXT=$$QUEUE("JUKEBOX",INPUT,PLACE)
Q:'NEXT NEXT
S ^MAGQUEUE(2006.03,"E",PLACE,$P(INPUT,"^"),NEXT)=""
Q NEXT
DELETE(INPUT,PLACE) ; Entry point to delete a file (literally from anywhere) / input = full path of file to delete
N IMOD
S IMOD=$S(INPUT[U:"^^"_INPUT,1:"^^^"_INPUT)
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
Q $$QUEUE("DELETE",IMOD,PLACE) ;SETS 9TH & 10TH PIECE
IMPORT(INPUT,CALLBACK,TRACKID,PLACE) ; Entry point to import a file
; input = Image Parameter Array
N QUEIEN,INDX,FDA,DINUM,MS1,CT,REQUE,TMP
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE "0^Missing PLACE parameter" ; DBI - SEB Patch 4
S REQUE=$S($P($G(INPUT),"^",3)'?1N.N:0,1:1)
I REQUE=0 Q:($O(^MAG(2006.041,"C",TRACKID,""))?1N.N) "0^Duplicate Tracking ID"
S QUEIEN=$$QUEUE("IMPORT","^^"_$P($G(INPUT),"^",3)_U_$TR(CALLBACK,"^","|")_U_$P($G(INPUT),"^",4),PLACE)
I REQUE=0 D
. S $P(^MAGQUEUE(2006.03,QUEIEN,0),"^",11)=QUEIEN
. S (DINUM,X)=QUEIEN,DIC="^MAG(2006.034,",DLAYGO="2006.034",DIC(0)="L"
. K D0
. D FILE^DICN
. K DIC,D0,DLAYGO
. S CT=0
. D CONV^MAGQBUT4(.INPUT,.CT)
. D MRGMULT^MAGQBUT4(.INPUT,"^MAG(2006.034,"_QUEIEN_",1,","2006.341A",CT)
. Q
K DIE,FDA
S FDA(2006.041,"+1,",.01)=$S(REQUE=0:QUEIEN,1:$P($G(INPUT),"^",4))
S FDA(2006.041,"+1,",.02)=TRACKID
S FDA(2006.041,"+1,",1)=$S(REQUE=0:"QUEUING",1:"REQUEUING")
S FDA(2006.041,"+1,",2)=$$NOW^XLFDT
D UPDATE^DIE("U","FDA","","MAGIMP")
I $D(DIERR) S TMP=MAGIMP("DIERR",1,"TEXT",1) K DIERR,MAGIMP
Q $S($D(TMP):"0^"_TMP,1:QUEIEN)
;
JBTOHD(INPUT,PLACE) ; Entry point to copy an image from the Jukebox to the Hard Disk
; input = image pointer ^ FULL or ABSTRACT or BIG
N NEXT,IEN,JDTYPE,CONS
S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,IEN,0)),U,2)) 0
I 'PLACE S PLACE=$$DA2PLC^MAGBAPIP(IEN,$S(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
E S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
S NEXT=$O(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("JBTOHD",PLACE)))
Q:NEXT?1N.N NEXT
S NEXT=$$QUEUE("JBTOHD",INPUT,PLACE)
Q:'NEXT NEXT
S ^MAGQUEUE(2006.03,"F",PLACE,$P(INPUT,"^"),$P(INPUT,"^",2),NEXT)=""
Q NEXT
;
PREFET(INPUT,PLACE) ;
; input = image pointer ^ FULL or ABSTRACT or BIG
N NEXT,IEN,JDTYPE,CONS
S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,IEN,0)),U,2)) 0
I 'PLACE S PLACE=$$DA2PLC^MAGBAPIP(IEN,$S(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
E S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
S NEXT=$O(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("PREFET",PLACE)))
Q:NEXT?1N.N NEXT
S NEXT=$$QUEUE("PREFET",INPUT,PLACE)
Q:'NEXT NEXT
S ^MAGQUEUE(2006.03,"F",PLACE,$P(INPUT,"^"),$P(INPUT,"^",2),NEXT)=""
Q NEXT
;
EVAL(IMAGE,PLACE) ; Entry point for before rules are evaluated
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
Q $$QUEUE("EVAL",IMAGE,PLACE)
;
NEXTQ(TYPE,PLACE) ;
N X
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
S X=$O(^MAGQUEUE(2006.031,"C",PLACE,TYPE,""))
Q $S('X:X,1:$P(^MAGQUEUE(2006.031,X,0),"^",2))
;
QUEUE(Q,INPUT,PLACE) ; Stuff the entry (header + INPUT) into the appropriate queue (Q)
N MAGTIME,QPTR,QTR,X,Y,STATUS,AQSQ
S U="^",STATUS="NOT_PROCESSED"
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
Q:(((Q'["DELETE")&(Q'["IMPORT"))&($P(INPUT,U,1)'?1N.N)) 0
; increment the QPTR
L +^MAGQUEUE(2006.03,0):1E9
S X=^MAGQUEUE(2006.03,0)
S QPTR=$O(^MAGQUEUE(2006.03," "),-1)+1
S QPTR=$S(QPTR'>+$P(X,U,3):$P(X,U,3)+1,1:QPTR) ;p154
S AQSQ=$O(^MAG(2006.041,"B"," "),-1)+1 ;p154
I AQSQ>QPTR S QPTR=AQSQ ;p154
S $P(X,"^",3)=QPTR,$P(X,"^",4)=$P(X,"^",4)+1
S ^MAGQUEUE(2006.03,0)=X
S MAGTIME=$$NOW^XLFDT
S ^MAGQUEUE(2006.03,QPTR,0)=Q_"^"_$G(DUZ)_"^"_^%ZOSF("VOL")_"^"_MAGTIME_"^"_STATUS_"^"_MAGTIME_"^"_INPUT
S ^MAGQUEUE(2006.03,"C",PLACE,Q,QPTR)="",$P(^MAGQUEUE(2006.03,QPTR,0),"^",12)=PLACE
S ^MAGQUEUE(2006.03,"D",PLACE,Q,STATUS,QPTR)=""
L -^MAGQUEUE(2006.03,0)
D ADD(1,Q,PLACE)
Q QPTR
ADD(N,QUEUE,PLACE) ;
;
N CNT,D0,I,X,CONS,PREV,QTOT
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0
S D0=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
D:'D0
. L +^MAGQUEUE(2006.031):1E9
. S D0=$O(^MAGQUEUE(2006.031," "),-1)+1
. S ^MAGQUEUE(2006.031,D0,0)=QUEUE_"^0^0^"_PLACE_U
. S ^MAGQUEUE(2006.031,"C",PLACE,QUEUE,D0)=""
. S X="IMAGE BACKGROUND QUEUE POINTER^2006.031^"_D0_"^"_D0
. S ^MAGQUEUE(2006.031,0)=X
. L -^MAGQUEUE(2006.031)
. Q
L +^MAGQUEUE(2006.031,D0):1E9
S X=^MAGQUEUE(2006.031,D0,0),CNT=$P(X,U,3),PREV=$P(X,U,2),QTOT=$P(X,U,5)
I CNT?1.N S CNT=CNT+N
E D
. S I=$P(X,"^",2),CNT=0
. F S I=$O(^MAGQUEUE(2006.03,"C",PLACE,QUEUE,I)) Q:I'?1N.N S CNT=CNT+1
. Q
S $P(X,U,4)=PLACE
S:N>0 QTOT=QTOT+N
; In order to avoid the new queue from being skipped...
I QUEUE'["IMPORT",$D(QPTR),QPTR<(PREV+1) S $P(X,"^",2)=QPTR-1,$P(X,"^",6)=$$NOW^XLFDT
S $P(X,U,3)=CNT,$P(X,U,5)=QTOT,^MAGQUEUE(2006.031,D0,0)=X
L -^MAGQUEUE(2006.031,D0)
Q
CWL(PLACE) ;Current Write Location
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
Q $P($G(^MAG(2006.1,PLACE,0)),"^",3)
PLACE(IEN) ;
Q $$GETPLACE(+$O(^MAG(2006.1,"B",IEN,"")))
JBPTR(PLACE) ;Current JukeBox Pointer
S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
Q $P($G(^MAG(2006.1,PLACE,1)),"^",6)
GETPLACE(PLACE) ; Validate place
N SP
S SP=$G(PLACE)
S PLACE=+$S($$CONSOLID():+$G(PLACE),1:$O(^MAG(2006.1," "),-1))
I PLACE,$P($G(^MAG(2006.1,PLACE,0)),"^",1)="" S PLACE=0
I 'PLACE,$$MAXREP(10) D
. N I,MSG,S,T,J,PS
. S PS=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),"")) ; PLACE of the VistA host system
. S MSG="Application process failure"
. S I=1,MSG(I)="Cannot determine 'place' (location, division, institution) for image."
. S I=1,MSG(I)=" Production Account: "_$$PROD^XUPROD("1")
. S T=$J("At",11) F S=$ST-1:-1:0 D
. . S I=I+1,MSG(I)=T_": "_$ST(S,"PLACE")_" = "_$ST(S,"MCODE"),T="Called From"
. . Q
. I $D(MAGARRAY) D
. . S J="",I=I+1,MSG(I)="MAGARRAY"
. . F S J=$O(MAGARRAY(J)) Q:J="" D
. . . S I=I+1,MSG(I)="MAGARRAY("_J_")"_MAGARRAY(J)
. . Q
. I $D(XWBTBUF) S I=I+1,MSG(I)="XWBTBUF: "_XWBTBUF
. I $D(MAGDA) S I=I+1,MSG(I)="MAGDA: "_MAGDA
. I $D(MAGGDA) S I=I+1,MSG(I)="MAGGDA: "_MAGGDA
. I $D(MAGGIEN("1")) S I=I+1,MSG(I)="MAGGIEN(""1""): "_MAGGIEN("1")
. S:$G(DUZ) I=I+1,MSG(I)="The USER was: "_$$GET1^DIQ(200,DUZ,".01","E")_" DUZ: "_DUZ
. S:$G(DUZ(2)) I=I+1,MSG(I)="The USER had a DUZ(2) setting of: "_DUZ(2)
. S I=I+1,MSG(I)="The original value of the INPUT Parameter 'PLACE' was: "_SP
. S I=I+1,MSG(I)="This fault may result in the failure to archive or process images."
. S I=I+1,MSG(I)="The users site of origin needs to have an Associated Institution value"
. S I=I+1,MSG(I)="setup on the Site Parameters window."
. S I=I+1,MSG(I)="refer to the BP User manual for instructions."
. S I="" F S I=$O(MSG(I)) Q:I="" D DFNIQ^MAGQBPG1("",MSG(I),0,PS,"$$GETPLACE_MAGBAPI")
. D DFNIQ^MAGQBPG1("",MSG,1,PS,"$$GETPLACE_MAGBAPI")
. Q
Q PLACE
MAXREP(MAX) ;
N REP,CNT
I $P($G(^MAG(2006.1,"WARNING","MAGBAPI")),U,1)=$$DT^XLFDT D
. S CNT=+$P($G(^MAG(2006.1,"WARNING","MAGBAPI")),U,2)+1
. S REP=$S(CNT<MAX:1,1:0)
. S $P(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)=CNT
. Q
E D
. I $D(^MAG(2006.1,"WARNING","MAGBAPI")) D
. . N I,MSG,PS
. . S PS=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),""))
. . S MSG="Application process failure Count"
. . S I=1,MSG(I)="On the following date: "_$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,1)
. . S I=I+1,MSG(I)=$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)_" were logged on the host system"
. . S I=I+1,MSG(I)="The Vista Imaging Development and support team is being notified."
. . S I="" F S I=$O(MSG(I)) Q:I="" D DFNIQ^MAGQBPG1("",MSG(I),0,PS,"$$GETPLACE_MAGBAPI")
. . D DFNIQ^MAGQBPG1("",MSG,1,PS,"$$GETPLACE_MAGBAPI")
. . Q
. S REP=1,$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,1,2)=$$DT^XLFDT_U_1
. Q
Q REP
CWG(PL) ;Returns the Current RAID Group
Q $P($G(^MAG(2006.1,PL,0)),U,10)
CONSOLID() ;
Q $GET(^MAG(2006.1,"CONSOLIDATED"))="YES"
CONRPC(RESULT) ;[MAGG CONS]
S RESULT=$$CONSOLID^MAGBAPI()
Q
PLACER(RESULT) ;[MAGG PLACE]
S RESULT=$$PLACE^MAGBAPI(+$G(DUZ(2)))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGBAPI 10665 printed Apr 09, 2024@21:08:51 Page 2
MAGBAPI ;WOIFO/PMK,RMP,SEB,MLH - Background Processor API to build queues ; 27 Aug 2014 5:12 PM
+1 ;;3.0;IMAGING;**1,7,8,20,39,154**;Mar 19, 2002;Build 9;Mar 08, 2011
+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
+18 ; The API returns the entry's queue pointer
+19 ;
ABSTRACT(INPUT,PLACE) ; Entry point to create an image abstract
+1 ; input = image pointer
+2 if $$IMOFFLN^MAGFILEB($PIECE($GET(^MAG(2005,INPUT,0)),U,2))
QUIT 0
+3 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+4 QUIT $$QUEUE("ABSTRACT",INPUT,PLACE)
+5 ;
GCC(INPUT,PLACE) ; Entry point to create an Document Imaging Export Copy
+1 ; input = image pointer(^Second Piece Optional Location specified^3rd optional extension(s) specifier
+2 ; plus "~" separated alternate source file types
+3 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+4 QUIT $$QUEUE("GCC",$PIECE(INPUT,"^")_"^^"_$PIECE(INPUT,"^",4)_"^"_$PIECE(INPUT,"^",2,3),PLACE)
JUKEBOX(INPUT,PLACE) ; Entry point to copy an image file and abstract to the Jukebox / input = image pointer
+1 NEW NEXT,CONS,GB
+2 SET GB=$GET(^MAG(2005,+$PIECE(INPUT,U),0))
+3 if GB=""
SET GB=$GET(^MAG(2005.1,+$PIECE(INPUT,U),0))
+4 if GB=""
QUIT 0
+5 if $$IMOFFLN^MAGFILEB($PIECE(GB,U,2))
QUIT 0
+6 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+7 SET CONS=$$CONSOLID()
+8 SET NEXT=$ORDER(^MAGQUEUE(2006.03,"E",PLACE,$PIECE(INPUT,"^"),$$NEXTQ("JUKEBOX",PLACE)))
+9 if NEXT?1N.N
QUIT NEXT
+10 SET NEXT=$$QUEUE("JUKEBOX",INPUT,PLACE)
+11 if 'NEXT
QUIT NEXT
+12 SET ^MAGQUEUE(2006.03,"E",PLACE,$PIECE(INPUT,"^"),NEXT)=""
+13 QUIT NEXT
DELETE(INPUT,PLACE) ; Entry point to delete a file (literally from anywhere) / input = full path of file to delete
+1 NEW IMOD
+2 SET IMOD=$SELECT(INPUT[U:"^^"_INPUT,1:"^^^"_INPUT)
+3 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+4 ;SETS 9TH & 10TH PIECE
QUIT $$QUEUE("DELETE",IMOD,PLACE)
IMPORT(INPUT,CALLBACK,TRACKID,PLACE) ; Entry point to import a file
+1 ; input = Image Parameter Array
+2 NEW QUEIEN,INDX,FDA,DINUM,MS1,CT,REQUE,TMP
+3 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT "0^Missing PLACE parameter"
+4 SET REQUE=$SELECT($PIECE($GET(INPUT),"^",3)'?1N.N:0,1:1)
+5 IF REQUE=0
if ($ORDER(^MAG(2006.041,"C",TRACKID,""))?1N.N)
QUIT "0^Duplicate Tracking ID"
+6 SET QUEIEN=$$QUEUE("IMPORT","^^"_$PIECE($GET(INPUT),"^",3)_U_$TRANSLATE(CALLBACK,"^","|")_U_$PIECE($GET(INPUT),"^",4),PLACE)
+7 IF REQUE=0
Begin DoDot:1
+8 SET $PIECE(^MAGQUEUE(2006.03,QUEIEN,0),"^",11)=QUEIEN
+9 SET (DINUM,X)=QUEIEN
SET DIC="^MAG(2006.034,"
SET DLAYGO="2006.034"
SET DIC(0)="L"
+10 KILL D0
+11 DO FILE^DICN
+12 KILL DIC,D0,DLAYGO
+13 SET CT=0
+14 DO CONV^MAGQBUT4(.INPUT,.CT)
+15 DO MRGMULT^MAGQBUT4(.INPUT,"^MAG(2006.034,"_QUEIEN_",1,","2006.341A",CT)
+16 QUIT
End DoDot:1
+17 KILL DIE,FDA
+18 SET FDA(2006.041,"+1,",.01)=$SELECT(REQUE=0:QUEIEN,1:$PIECE($GET(INPUT),"^",4))
+19 SET FDA(2006.041,"+1,",.02)=TRACKID
+20 SET FDA(2006.041,"+1,",1)=$SELECT(REQUE=0:"QUEUING",1:"REQUEUING")
+21 SET FDA(2006.041,"+1,",2)=$$NOW^XLFDT
+22 DO UPDATE^DIE("U","FDA","","MAGIMP")
+23 IF $DATA(DIERR)
SET TMP=MAGIMP("DIERR",1,"TEXT",1)
KILL DIERR,MAGIMP
+24 QUIT $SELECT($DATA(TMP):"0^"_TMP,1:QUEIEN)
+25 ;
JBTOHD(INPUT,PLACE) ; Entry point to copy an image from the Jukebox to the Hard Disk
+1 ; input = image pointer ^ FULL or ABSTRACT or BIG
+2 NEW NEXT,IEN,JDTYPE,CONS
+3 SET IEN=$PIECE(INPUT,"^")
SET JDTYPE=$PIECE(INPUT,"^",2)
+4 if $$IMOFFLN^MAGFILEB($PIECE($GET(^MAG(2005,IEN,0)),U,2))
QUIT 0
+5 IF 'PLACE
SET PLACE=$$DA2PLC^MAGBAPIP(IEN,$SELECT(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
+6 ; DBI - SEB Patch 4
IF '$TEST
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+7 SET NEXT=$ORDER(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("JBTOHD",PLACE)))
+8 if NEXT?1N.N
QUIT NEXT
+9 SET NEXT=$$QUEUE("JBTOHD",INPUT,PLACE)
+10 if 'NEXT
QUIT NEXT
+11 SET ^MAGQUEUE(2006.03,"F",PLACE,$PIECE(INPUT,"^"),$PIECE(INPUT,"^",2),NEXT)=""
+12 QUIT NEXT
+13 ;
PREFET(INPUT,PLACE) ;
+1 ; input = image pointer ^ FULL or ABSTRACT or BIG
+2 NEW NEXT,IEN,JDTYPE,CONS
+3 SET IEN=$PIECE(INPUT,"^")
SET JDTYPE=$PIECE(INPUT,"^",2)
+4 if $$IMOFFLN^MAGFILEB($PIECE($GET(^MAG(2005,IEN,0)),U,2))
QUIT 0
+5 IF 'PLACE
SET PLACE=$$DA2PLC^MAGBAPIP(IEN,$SELECT(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
+6 ; DBI - SEB Patch 4
IF '$TEST
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+7 SET IEN=$PIECE(INPUT,"^")
SET JDTYPE=$PIECE(INPUT,"^",2)
+8 SET NEXT=$ORDER(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("PREFET",PLACE)))
+9 if NEXT?1N.N
QUIT NEXT
+10 SET NEXT=$$QUEUE("PREFET",INPUT,PLACE)
+11 if 'NEXT
QUIT NEXT
+12 SET ^MAGQUEUE(2006.03,"F",PLACE,$PIECE(INPUT,"^"),$PIECE(INPUT,"^",2),NEXT)=""
+13 QUIT NEXT
+14 ;
EVAL(IMAGE,PLACE) ; Entry point for before rules are evaluated
+1 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+2 QUIT $$QUEUE("EVAL",IMAGE,PLACE)
+3 ;
NEXTQ(TYPE,PLACE) ;
+1 NEW X
+2 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+3 SET X=$ORDER(^MAGQUEUE(2006.031,"C",PLACE,TYPE,""))
+4 QUIT $SELECT('X:X,1:$PIECE(^MAGQUEUE(2006.031,X,0),"^",2))
+5 ;
QUEUE(Q,INPUT,PLACE) ; Stuff the entry (header + INPUT) into the appropriate queue (Q)
+1 NEW MAGTIME,QPTR,QTR,X,Y,STATUS,AQSQ
+2 SET U="^"
SET STATUS="NOT_PROCESSED"
+3 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+4 if (((Q'["DELETE")&(Q'["IMPORT"))&($PIECE(INPUT,U,1)'?1N.N))
QUIT 0
+5 ; increment the QPTR
+6 LOCK +^MAGQUEUE(2006.03,0):1E9
+7 SET X=^MAGQUEUE(2006.03,0)
+8 SET QPTR=$ORDER(^MAGQUEUE(2006.03," "),-1)+1
+9 ;p154
SET QPTR=$SELECT(QPTR'>+$PIECE(X,U,3):$PIECE(X,U,3)+1,1:QPTR)
+10 ;p154
SET AQSQ=$ORDER(^MAG(2006.041,"B"," "),-1)+1
+11 ;p154
IF AQSQ>QPTR
SET QPTR=AQSQ
+12 SET $PIECE(X,"^",3)=QPTR
SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
+13 SET ^MAGQUEUE(2006.03,0)=X
+14 SET MAGTIME=$$NOW^XLFDT
+15 SET ^MAGQUEUE(2006.03,QPTR,0)=Q_"^"_$GET(DUZ)_"^"_^%ZOSF("VOL")_"^"_MAGTIME_"^"_STATUS_"^"_MAGTIME_"^"_INPUT
+16 SET ^MAGQUEUE(2006.03,"C",PLACE,Q,QPTR)=""
SET $PIECE(^MAGQUEUE(2006.03,QPTR,0),"^",12)=PLACE
+17 SET ^MAGQUEUE(2006.03,"D",PLACE,Q,STATUS,QPTR)=""
+18 LOCK -^MAGQUEUE(2006.03,0)
+19 DO ADD(1,Q,PLACE)
+20 QUIT QPTR
ADD(N,QUEUE,PLACE) ;
+1 ;
+2 NEW CNT,D0,I,X,CONS,PREV,QTOT
+3 SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+4 SET D0=$ORDER(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
+5 if 'D0
Begin DoDot:1
+6 LOCK +^MAGQUEUE(2006.031):1E9
+7 SET D0=$ORDER(^MAGQUEUE(2006.031," "),-1)+1
+8 SET ^MAGQUEUE(2006.031,D0,0)=QUEUE_"^0^0^"_PLACE_U
+9 SET ^MAGQUEUE(2006.031,"C",PLACE,QUEUE,D0)=""
+10 SET X="IMAGE BACKGROUND QUEUE POINTER^2006.031^"_D0_"^"_D0
+11 SET ^MAGQUEUE(2006.031,0)=X
+12 LOCK -^MAGQUEUE(2006.031)
+13 QUIT
End DoDot:1
+14 LOCK +^MAGQUEUE(2006.031,D0):1E9
+15 SET X=^MAGQUEUE(2006.031,D0,0)
SET CNT=$PIECE(X,U,3)
SET PREV=$PIECE(X,U,2)
SET QTOT=$PIECE(X,U,5)
+16 IF CNT?1.N
SET CNT=CNT+N
+17 IF '$TEST
Begin DoDot:1
+18 SET I=$PIECE(X,"^",2)
SET CNT=0
+19 FOR
SET I=$ORDER(^MAGQUEUE(2006.03,"C",PLACE,QUEUE,I))
if I'?1N.N
QUIT
SET CNT=CNT+1
+20 QUIT
End DoDot:1
+21 SET $PIECE(X,U,4)=PLACE
+22 if N>0
SET QTOT=QTOT+N
+23 ; In order to avoid the new queue from being skipped...
+24 IF QUEUE'["IMPORT"
IF $DATA(QPTR)
IF QPTR<(PREV+1)
SET $PIECE(X,"^",2)=QPTR-1
SET $PIECE(X,"^",6)=$$NOW^XLFDT
+25 SET $PIECE(X,U,3)=CNT
SET $PIECE(X,U,5)=QTOT
SET ^MAGQUEUE(2006.031,D0,0)=X
+26 LOCK -^MAGQUEUE(2006.031,D0)
+27 QUIT
CWL(PLACE) ;Current Write Location
+1 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+2 QUIT $PIECE($GET(^MAG(2006.1,PLACE,0)),"^",3)
PLACE(IEN) ;
+1 QUIT $$GETPLACE(+$ORDER(^MAG(2006.1,"B",IEN,"")))
JBPTR(PLACE) ;Current JukeBox Pointer
+1 ; DBI - SEB Patch 4
SET PLACE=$$GETPLACE($GET(PLACE))
if 'PLACE
QUIT 0
+2 QUIT $PIECE($GET(^MAG(2006.1,PLACE,1)),"^",6)
GETPLACE(PLACE) ; Validate place
+1 NEW SP
+2 SET SP=$GET(PLACE)
+3 SET PLACE=+$SELECT($$CONSOLID():+$GET(PLACE),1:$ORDER(^MAG(2006.1," "),-1))
+4 IF PLACE
IF $PIECE($GET(^MAG(2006.1,PLACE,0)),"^",1)=""
SET PLACE=0
+5 IF 'PLACE
IF $$MAXREP(10)
Begin DoDot:1
+6 NEW I,MSG,S,T,J,PS
+7 ; PLACE of the VistA host system
SET PS=$ORDER(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),""))
+8 SET MSG="Application process failure"
+9 SET I=1
SET MSG(I)="Cannot determine 'place' (location, division, institution) for image."
+10 SET I=1
SET MSG(I)=" Production Account: "_$$PROD^XUPROD("1")
+11 SET T=$JUSTIFY("At",11)
FOR S=$STACK-1:-1:0
Begin DoDot:2
+12 SET I=I+1
SET MSG(I)=T_": "_$STACK(S,"PLACE")_" = "_$STACK(S,"MCODE")
SET T="Called From"
+13 QUIT
End DoDot:2
+14 IF $DATA(MAGARRAY)
Begin DoDot:2
+15 SET J=""
SET I=I+1
SET MSG(I)="MAGARRAY"
+16 FOR
SET J=$ORDER(MAGARRAY(J))
if J=""
QUIT
Begin DoDot:3
+17 SET I=I+1
SET MSG(I)="MAGARRAY("_J_")"_MAGARRAY(J)
End DoDot:3
+18 QUIT
End DoDot:2
+19 IF $DATA(XWBTBUF)
SET I=I+1
SET MSG(I)="XWBTBUF: "_XWBTBUF
+20 IF $DATA(MAGDA)
SET I=I+1
SET MSG(I)="MAGDA: "_MAGDA
+21 IF $DATA(MAGGDA)
SET I=I+1
SET MSG(I)="MAGGDA: "_MAGGDA
+22 IF $DATA(MAGGIEN("1"))
SET I=I+1
SET MSG(I)="MAGGIEN(""1""): "_MAGGIEN("1")
+23 if $GET(DUZ)
SET I=I+1
SET MSG(I)="The USER was: "_$$GET1^DIQ(200,DUZ,".01","E")_" DUZ: "_DUZ
+24 if $GET(DUZ(2))
SET I=I+1
SET MSG(I)="The USER had a DUZ(2) setting of: "_DUZ(2)
+25 SET I=I+1
SET MSG(I)="The original value of the INPUT Parameter 'PLACE' was: "_SP
+26 SET I=I+1
SET MSG(I)="This fault may result in the failure to archive or process images."
+27 SET I=I+1
SET MSG(I)="The users site of origin needs to have an Associated Institution value"
+28 SET I=I+1
SET MSG(I)="setup on the Site Parameters window."
+29 SET I=I+1
SET MSG(I)="refer to the BP User manual for instructions."
+30 SET I=""
FOR
SET I=$ORDER(MSG(I))
if I=""
QUIT
DO DFNIQ^MAGQBPG1("",MSG(I),0,PS,"$$GETPLACE_MAGBAPI")
+31 DO DFNIQ^MAGQBPG1("",MSG,1,PS,"$$GETPLACE_MAGBAPI")
+32 QUIT
End DoDot:1
+33 QUIT PLACE
MAXREP(MAX) ;
+1 NEW REP,CNT
+2 IF $PIECE($GET(^MAG(2006.1,"WARNING","MAGBAPI")),U,1)=$$DT^XLFDT
Begin DoDot:1
+3 SET CNT=+$PIECE($GET(^MAG(2006.1,"WARNING","MAGBAPI")),U,2)+1
+4 SET REP=$SELECT(CNT<MAX:1,1:0)
+5 SET $PIECE(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)=CNT
+6 QUIT
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 IF $DATA(^MAG(2006.1,"WARNING","MAGBAPI"))
Begin DoDot:2
+9 NEW I,MSG,PS
+10 SET PS=$ORDER(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),""))
+11 SET MSG="Application process failure Count"
+12 SET I=1
SET MSG(I)="On the following date: "_$PIECE(^MAG(2006.1,"WARNING","MAGBAPI"),U,1)
+13 SET I=I+1
SET MSG(I)=$PIECE(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)_" were logged on the host system"
+14 SET I=I+1
SET MSG(I)="The Vista Imaging Development and support team is being notified."
+15 SET I=""
FOR
SET I=$ORDER(MSG(I))
if I=""
QUIT
DO DFNIQ^MAGQBPG1("",MSG(I),0,PS,"$$GETPLACE_MAGBAPI")
+16 DO DFNIQ^MAGQBPG1("",MSG,1,PS,"$$GETPLACE_MAGBAPI")
+17 QUIT
End DoDot:2
+18 SET REP=1
SET $PIECE(^MAG(2006.1,"WARNING","MAGBAPI"),U,1,2)=$$DT^XLFDT_U_1
+19 QUIT
End DoDot:1
+20 QUIT REP
CWG(PL) ;Returns the Current RAID Group
+1 QUIT $PIECE($GET(^MAG(2006.1,PL,0)),U,10)
CONSOLID() ;
+1 QUIT $GET(^MAG(2006.1,"CONSOLIDATED"))="YES"
CONRPC(RESULT) ;[MAGG CONS]
+1 SET RESULT=$$CONSOLID^MAGBAPI()
+2 QUIT
PLACER(RESULT) ;[MAGG PLACE]
+1 SET RESULT=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+2 QUIT
+3 ;
