- 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 Jan 18, 2025@03:00:40 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 ;