MAGQBPG1 ;WOIFO/RMP,JSL,DAC - REMOTE Task SERVER Program ; 27 Jul 2017 11:12 AM
;;3.0;IMAGING;**7,8,20,81,39,135,154,186**;;Build 23
;; 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 JBS]
N X,SYSIEN,SYSNAME,ZNODE,NODE,INDX,CNT,PROC,%,QPTR,QCNT,SHARE,PLACE,SCANDATE
S SCANDATE=$$FMTE^XLFDT($$NOW^XLFDT)
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S (SYSIEN,CNT)=0,SYSNAME="",U="^",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S SYSIEN=$O(^MAG(2006.8,"C",PLACE,WSTAT,"")) ;TRUE WORKSTATION NAME
I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4(WSTAT),""))
I 'SYSIEN D ;ATTEMPT TO FIND A MATCH FROM LOCAL NAME
. N TRY
. F TRY=1:1:$L(WSTAT,".") D Q:SYSIEN?1N.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)),""))
I SYSIEN="" D Q
. S RESULT(0)="-1^This workstation is not currently setup as a Background Processor."
. Q
S NODE=^MAG(2006.8,SYSIEN,0)
S SYSNAME=$P(NODE,U)
I SYSNAME="" D Q
. S RESULT(0)="-1^This workstation is not currently setup as a Background Processor."
. Q
S RESULT(0)="0^BP List^PID: "_$$BASE^XLFUTL($J,10,16)_U_SYSNAME_U_WSTAT_U_$P(^MAG(2006.1,PLACE,0),U,2)
S (X,CNT)=0
F S X=$O(^MAG(2005.2,X)) Q:X'?1N.N S ZNODE=$G(^(X,0)) D
. Q:'$P(ZNODE,U,6) ;1=online
. Q:$E($P(ZNODE,U,2),1,2)'="\\"
. Q:$P(ZNODE,U,10)'=PLACE
. Q:(($P(ZNODE,U,7)'["WORM")&($P(ZNODE,U,7)'="RW"))
. S CNT=CNT+1,SHARE=$P(ZNODE,U,2)
. I $E(SHARE,$L(SHARE))="\" S SHARE=$E(SHARE,1,$L(SHARE)-1)
. S RESULT(CNT)=X_U_SHARE_U_$P(ZNODE,U,8)
Q
SHR(RESULT) ; RPC[MAGQ SHARES]
N TMP,INDX,DATA,CNT,SHARE,CWL,VALUE,PLACE
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S (CNT,INDX)=0,U="^",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S CWL=$$CWL^MAGBAPI(PLACE)
F S INDX=$O(^MAG(2005.2,INDX)) Q:INDX'?1N.N D
. S DATA=$G(^MAG(2005.2,INDX,0))
. Q:$P(DATA,U,6,7)'["1^MAG"
. Q:$P(DATA,U,9)="1" ;ROUTING SHARE
. Q:$P(DATA,U,2)[":"
. Q:$P(DATA,U,10)'=PLACE
. S SHARE=$P(DATA,U,2)
. Q:$E(SHARE,1,2)'="\\"
. I $E(SHARE,$L(SHARE))="\" S SHARE=$E(SHARE,1,$L(SHARE)-1)
. S SHARE=SHARE_U_$P(DATA,U,8)
. Q:$D(TMP(SHARE))
. S TMP(SHARE)=INDX
S INDX=""
F S INDX=$O(TMP(INDX)) Q:INDX="" D
. S RESULT(CNT)=TMP(INDX)_U_INDX,CNT=CNT+1
. S ^TMP("MAGQBP",$J,"SHRLST",CNT-1)=TMP(INDX)_U_INDX
K TMP
Q
CNP2(RESULT,IEN,START,STOP,AUTO) ;[MAGQ JBSCN]
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
N FNAME,PIECE,ZNODE,NODE2,BNODE,BNAME,PTR,HASH,TEMP,ORDER,RDATE,PLACE,OFFLINE,PLACEOK,GL,END,ACQSITE,MAGDA,SCANCNT,OFFCNT,ALTPLACE,CORREC
S (RESULT,GL)="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),(OFFLINE,PLACEOK,SCANCNT,ALTPLACE,OFFCNT)=0,CORREC=""
I AUTO D
. S (IEN,MAGDA)=+IEN
. S ORDER="R"
. I START="" S START=$S(IEN>0:IEN,1:$O(^MAG(2005,"A"),-1))
. S STOP=$O(^MAG(2005,0))
. Q
S:START="" START=$O(^MAG(2005,0)) S:STOP="" STOP=$O(^MAG(2005,"A"),-1)
S ORDER=$S(START>STOP:"R",1:"F")
I (IEN'?1N.N)!IEN=0 D I IEN="" S RESULT=0 Q
. I START=0 S IEN=START Q
. I ORDER="R" D
. . S I1=+$O(^MAG(2005," "),-1),I2=+$O(^MAG(2005.1," "),-1),END=$S(I1>I2:I1,1:I2)
. . S IEN=$S(START>END:START,1:START+1) Q
. E S (IEN,MAGDA)=START-1
. Q
S (IEN,MAGDA)=+IEN
F D SCAN^MAGQBPG1(.IEN,ORDER,.GL) D Q:(((ORDER="R")&(IEN<STOP))!((ORDER="F")&(IEN>STOP))!(('OFFLINE)&PLACEOK)!(CORREC]"")!('IEN)!(SCANCNT>249)!($P(RESULT,U,21)="DUPE")!'$G(ACQSITE))
. Q:'IEN
. S SCANCNT=SCANCNT+1,OFFLINE=0
. S ZNODE=$G(@(GL_IEN_",0)")),ACQSITE=$P($G(@(GL_IEN_",100)")),U,3)
. S NODE2=$G(@(GL_IEN_",2)"))
. I ((ZNODE']"")!($P(ZNODE,U,1,2)="^^"))!(NODE2']"")!(($P(NODE2,U,1,8)="^^^^^^^")&(($G(@(GL_IEN_",1)"))']""))) D KLOG(GL,IEN,.CORREC) Q
. S PLACEOK=$S($$PLACE^MAGBAPI(+ACQSITE)=$$PLACE^MAGBAPI($G(DUZ(2))):1,1:"")
. I $P(ZNODE,U,2)'="" S OFFLINE=$$IMOFFLN^MAGFILEB($P(ZNODE,U,2)) ; Only check the offline status of image files
. I OFFLINE S OFFCNT=OFFCNT+1 Q
. I 'PLACEOK S ALTPLACE=ALTPLACE+1 Q
. I AUTO,$P(ZNODE,U,11)'="" D Q ; P186 DAC - If PLACE is OK and auto verifier is running and IQ is set end processing
. . S $P(RESULT,U,1)=0
. . S IEN=0
. . Q
. I ($D(^MAG(2005.1,IEN,0))&$D(^MAG(2005,IEN,0))) D Q ; Image is duplicated in the Archive file
. . I $P(^MAG(2005,IEN,0),U,1,8)="^^^^^^^",+$P(^MAG(2005,IEN,0),U,9) D KLOG(GL,IEN,.CORREC) Q
. . S FDA(2005,IEN_",",13.5)="1" ; Set Dupe field in the Image File
. . S FDA(2005,IEN_",",13)="1" ; Set IQ field in the Image File
. . D FILE^DIE("I","FDA","MSG") K FDA,MSG
. . S FDA(2005.1,IEN_",",13.5)="1" ; Set the Dupe field in the archive file
. . S FDA(2005.1,IEN_",",13)="1" ; and set the IQ field in the archive file
. . D FILE^DIE("I","FDA","MSG") K FDA,MSG
. . S $P(RESULT,U,21)="DUPE"
. . S $P(RESULT,U)=IEN
. . I $P(ZNODE,U,2)=$P($G(^MAG(2005.1,IEN,0)),U,2) S $P(RESULT,U,2)=$P(ZNODE,U,2) D
. . . I $P(RESULT,U,2)="" S $P(RESULT,U,2)="No File Name" Q
. . E S $P(RESULT,U,2)=$P(ZNODE,U,2)_"/"_$P($G(^MAG(2005.1,IEN,0)),U,2) D
. . . I $P($P(RESULT,U,2),"/")="" S $P(RESULT,U,2)="No File Name"_$P(RESULT,U,2)
. . . I $P($P(RESULT,U,2),"/",2)="" S $P(RESULT,U,2)=$P(RESULT,U,2)_"No File Name"
. . . Q
. . Q
. E I $P(ZNODE,U,2)'="" S $P(@(GL_IEN_",0)"),U,12)="0"
. Q
S $P(RESULT,U,25)=OFFCNT
S $P(RESULT,U,26)=ALTPLACE
I CORREC]"" D Q
. S $P(RESULT,U,27)=CORREC
. D SCAN^MAGQBPG1(.IEN,ORDER,.GL)
. S $P(RESULT,U,24)=IEN
. Q
I $S('IEN:1,((ORDER="F")&(IEN>STOP)):1,(SCANCNT>249):1,((ORDER="R")&(IEN<STOP)):1,1:0) D Q
. S:SCANCNT>249 $P(RESULT,U,24)=IEN
. S $P(RESULT,U,1)=0
. Q
S FNAME=$P(ZNODE,U,2)
S $P(RESULT,U)=IEN
Q:($P(RESULT,U,21)="DUPE")
S $P(RESULT,U,19)=$P($P($G(@(GL_IEN_",2)")),U),".")
I $P(ZNODE,U,2)'="" D ;NON-GROUP PARENT
. S BNODE=$G(@(GL_IEN_",""FBIG"")"))
. I $P(ZNODE,U,5)?1N.N S $P(RESULT,U,3)=$P(ZNODE,U,5)
. S:$P(BNODE,U,2)?1N.N $P(RESULT,U,4)=$S($P(BNODE,U,3)'="":"["_$P(BNODE,U,3)_"]",1:"")_$P(BNODE,U,2)
. S:$P(ZNODE,U,3)?1N.N $P(RESULT,U,5)=$P(ZNODE,U,3)
. S:$P(ZNODE,U,4)?1N.N $P(RESULT,U,6)=$P(ZNODE,U,4)
. S:$P(BNODE,U)?1N.N $P(RESULT,U,7)=$S($P(BNODE,U,3)'="":"["_$P(BNODE,U,3)_"]",1:"")_$P(BNODE,U)
. S $P(RESULT,U,8)=$$CWL^MAGBAPI(PLACE)
. S $P(RESULT,U,2)=FNAME
. I $D(@(GL_IEN_",""FBIG"")")),'$P(BNODE,U),'$P(BNODE,U,2) S $P(RESULT,U,22)="EMPTY_FBIG"
. Q
I '$P($G(@(GL_IEN_",100)")),U,3) S $P(RESULT,U,23)=-1 ;"NO ACQ SITE VALUE"
I GL[("^MAG(2005.1,") S $P(RESULT,U,21)=$S($P($G(^MAG(2005.1,IEN,100)),U,8)=13:"NE",1:"ARCH")
E S $P(RESULT,U,12,17)=$$CHKIMG^MAGQBUT2(IEN)
Q
JPUD(RESULT,JPTR,EXT,IEN) ; RPC[MAGQ JPUD]
N TYPE,PIECE,NODE,GL
S X="ERR^MAGQBTM",@^%ZOSF("TRAP"),RESULT="0"
S TYPE=$$FTYPE^MAGQBPRG(EXT,IEN)
S PIECE=$S(TYPE="BIG":2,1:5)
S NODE=$S(TYPE="BIG":"FBIG",1:0)
I JPTR="0" D Q:(RESULT<0)
. S JPTR=""
. S GL=$S($D(^MAG(2005,IEN)):"^MAG(2005,",$D(^MAG(2005.1,IEN)):"^MAG(2005.1,",1:0)
. I GL=0 S RESULT="-1" Q
. S GL=$G(@(GL_IEN_",0)")) I $P(GL,U,2)="" S RESULT=-1 Q ;*154 No file ref.
. I $D(^MAGQUEUE(2006.033,"B",$P(GL,U,2))) D Q ;*154 +fix
. . S RESULT=-2 Q ;Don't clear the JB pointer if image is on an Offline Platter
. . Q
. Q
S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=JPTR
S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=JPTR
S RESULT="1"
Q
VCUD(RESULT,VCPTR,EXT,IEN) ; RPC[MAGQ VCUD]
N TYPE,PIECE,NODE
S X="ERR^MAGQBTM",@^%ZOSF("TRAP"),RESULT="0"
S TYPE=$$FTYPE^MAGQBPRG(EXT,IEN)
S PIECE=$S(TYPE="BIG":1,TYPE="ABS":4,1:3)
S NODE=$S(TYPE="BIG":"FBIG",1:0)
S:VCPTR="0" VCPTR=""
S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=VCPTR
S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=VCPTR
S RESULT="1"
Q
DFNIQ(RESULT,INPUT,SEND,PLACE,APP) ;
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
N LOC,CNT,Y,XMSUB
S U="^",RESULT="1"
S CNT=+$O(^TMP($J,"MAGQDFN",PLACE,APP,""),-1)
I CNT<2 D
. S LOC=$$KSP^XUPARAM("WHERE")
. S ^TMP($J,"MAGQDFN",PLACE,APP,1)=" SITE: "_LOC
. S ^TMP($J,"MAGQDFN",PLACE,APP,2)=" DATE: "_$$FMTE^XLFDT($$NOW^XLFDT)_" "_$G(^XMB("TIMEZONE"))
. S CNT=2 Q
I SEND="1" D
. S RESULT=$$SUBCHK^XMGAPI0(INPUT,0)
. Q:$P(RESULT,U)
. S XMSUB=INPUT
. N XMTEXT,INTERVAL,XMDUZ,XMZ
. S INTERVAL=$$GETMI^MAGQBUT5(XMSUB,PLACE)
. I $$FMADD^XLFDT(+$P(INTERVAL,"^",2),"",+$P(INTERVAL,U,1),"","")>$$NOW^XLFDT D Q
. . K ^TMP($J,"MAGQDFN",PLACE,APP) Q
. S XMTEXT="^TMP($J,""MAGQDFN"",PLACE,APP)"
. D:$$PROD^XUPROD("1") ADDMG^MAGQBUT5(INPUT,.XMY,PLACE)
. S XMY(DUZ)="",XMDUZ=DUZ,XMY(XMDUZ)=""
. S XMID=$G(DUZ) S:'XMID XMID=.5
. S XMINSTR("FLAGS")="I",XMINSTR("FROM")="VistA Imaging "_APP
. D SENDMSG^XMXAPI(XMID,XMSUB,XMTEXT,.XMY,.XMINSTR,.XMZ,)
. K ^TMP($J,"MAGQDFN",PLACE,APP)
. I $G(XMERR) M XMERR=^TMP("XMERR",$J) K XMERR
. K ^TMP($J,"MAGQDFN",PLACE,APP)
. D UDMI^MAGQBUT5(INPUT,PLACE) Q
E S CNT=CNT+1,^TMP($J,"MAGQDFN",PLACE,APP,CNT)=INPUT
S $P(RESULT,U)=$S($P(RESULT,U):"1",1:0)
K XMY,XMINSTR,XMID
Q
SCAN(IEN,ORDER,GB) ; Find the next image spanning the Image and the Image Archive file
I IEN,GB="^MAG(2005,",$D(^MAG(2005.1,IEN)) D Q
. S IEN=IEN,GB="^MAG(2005.1," Q
N I1,I2
I $G(ORDER)="F" D
. S I1=$O(^MAG(2005,IEN)),I1=$S(I1:I1,1:"")
. S I2=$O(^MAG(2005.1,IEN)),I2=$S(I2:I2,1:"")
. I I1,'I2 S IEN=I1,GB="^MAG(2005," Q
. I I2,'I1 S IEN=I2,GB="^MAG(2005.1," Q
. S GB=$S(I1>I2:"^MAG(2005.1,",1:"^MAG(2005,")
. S IEN=$S(I1>I2:I2,1:I1)
. Q
E D ;Reverse
. S I1=$O(^MAG(2005,IEN),-1),I1=$S(I1:I1,1:"")
. S I2=$O(^MAG(2005.1,IEN),-1),I2=$S(I2:I2,1:"")
. I I1,'I2 S IEN=I1,GB="^MAG(2005," Q
. I I2,'I1 S IEN=I2,GB="^MAG(2005.1," Q
. S GB=$S(I1<I2:"^MAG(2005.1,",1:"^MAG(2005,")
. S IEN=$S(I1<I2:I2,1:I1)
. Q
S (IEN,MAGDA)=$S('IEN:"",1:IEN)
Q
KLOG(GL,IEN,CORREC) ;
S CORREC=$P($P(GL,","),"^MAG(",2)_"~"_IEN
D LOGKILL(GL_IEN_")") ;Journal the nodes and content being killed
K @(GL_IEN_")")
Q
LOGKILL(REC) ; Log the content into the ^TMP global error log rpc
N NODE,NODE1,NODE2,NODE3,TMP,TMP1
S NODE=""
F S NODE=$O(@REC@(NODE)) Q:NODE="" D
. S TMP=$G(@REC@(NODE)) I TMP]"" S TMP1=$P(REC,")")_","_NODE_")="_TMP D ELOGV(TMP1)
. S NODE1="" F S NODE1=$O(@REC@(NODE,NODE1)) Q:NODE1="" D
. . S TMP=$G(@REC@(NODE,NODE1)) I TMP]"" S TMP1=$P(REC,")")_","_NODE_","_NODE1_")="_TMP D ELOGV(TMP1)
. . S NODE2="" F S NODE2=$O(@REC@(NODE,NODE1,NODE2)) Q:NODE2="" D
. . . S TMP=$G(@REC@(NODE,NODE1,NODE2)) I TMP]"" S TMP1=$P(REC,")")_","_NODE_","_NODE1_","_NODE2_")"_"="_TMP D ELOGV(TMP1)
. . . S NODE3="" F S NODE3=$O(@REC@(NODE,NODE1,NODE2,NODE3)) Q:NODE3="" D
. . . . S TMP=$G(@REC@(NODE,NODE1,NODE2,NODE3)) S TMP1=$P(REC,")")_","_NODE_","_NODE1_","_NODE2_","_NODE3_")="_TMP D ELOGV(TMP1)
. . . . Q
. . . Q
. . Q
. Q
Q
ELOGV(MESG,LIMIT) ;TMP Log
N INDX
N X S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S INDX=+$O(^TMP("MAGQ",$J,"BPV",""),-1)+1
S ^TMP("MAGQ",$J,"BPV",INDX)=MESG
Q
ELOGRV(RESULT,LIMIT) ; [MAGQ LOGV] Error log report and purge
; Please test this
N FN,INDX,CNT
N X S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S CNT=0,INDX=""
F S INDX=$O(^TMP("MAGQ",$J,"BPV",INDX)) Q:INDX'?1N.N Q:CNT=LIMIT D
. S CNT=CNT+1,RESULT(CNT)=^TMP("MAGQ",$J,"BPV",INDX)
. K ^TMP("MAGQ",$J,"BPV",INDX)
. Q
S RESULT(0)=CNT
S INDX=$O(^TMP("MAGQ",$J,"BPV",""))
I INDX?1N.N S RESULT(0)=RESULT(0)_U_"MORE"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBPG1 12321 printed Jan 18, 2025@03:09:01 Page 2
MAGQBPG1 ;WOIFO/RMP,JSL,DAC - REMOTE Task SERVER Program ; 27 Jul 2017 11:12 AM
+1 ;;3.0;IMAGING;**7,8,20,81,39,135,154,186**;;Build 23
+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 JBS]
+1 NEW X,SYSIEN,SYSNAME,ZNODE,NODE,INDX,CNT,PROC,%,QPTR,QCNT,SHARE,PLACE,SCANDATE
+2 SET SCANDATE=$$FMTE^XLFDT($$NOW^XLFDT)
+3 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+4 SET (SYSIEN,CNT)=0
SET SYSNAME=""
SET U="^"
SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+5 ;TRUE WORKSTATION NAME
SET SYSIEN=$ORDER(^MAG(2006.8,"C",PLACE,WSTAT,""))
+6 IF 'SYSIEN
SET SYSIEN=$ORDER(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4(WSTAT),""))
+7 ;ATTEMPT TO FIND A MATCH FROM LOCAL NAME
IF 'SYSIEN
Begin DoDot:1
+8 NEW TRY
+9 FOR TRY=1:1:$LENGTH(WSTAT,".")
Begin DoDot:2
+10 SET SYSIEN=$ORDER(^MAG(2006.8,"C",PLACE,$PIECE(WSTAT,".",TRY),""))
+11 IF 'SYSIEN
SET SYSIEN=$ORDER(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4($PIECE(WSTAT,".",TRY)),""))
End DoDot:2
if SYSIEN?1N.N
QUIT
End DoDot:1
+12 IF SYSIEN=""
Begin DoDot:1
+13 SET RESULT(0)="-1^This workstation is not currently setup as a Background Processor."
+14 QUIT
End DoDot:1
QUIT
+15 SET NODE=^MAG(2006.8,SYSIEN,0)
+16 SET SYSNAME=$PIECE(NODE,U)
+17 IF SYSNAME=""
Begin DoDot:1
+18 SET RESULT(0)="-1^This workstation is not currently setup as a Background Processor."
+19 QUIT
End DoDot:1
QUIT
+20 SET RESULT(0)="0^BP List^PID: "_$$BASE^XLFUTL($JOB,10,16)_U_SYSNAME_U_WSTAT_U_$PIECE(^MAG(2006.1,PLACE,0),U,2)
+21 SET (X,CNT)=0
+22 FOR
SET X=$ORDER(^MAG(2005.2,X))
if X'?1N.N
QUIT
SET ZNODE=$GET(^(X,0))
Begin DoDot:1
+23 ;1=online
if '$PIECE(ZNODE,U,6)
QUIT
+24 if $EXTRACT($PIECE(ZNODE,U,2),1,2)'="\\"
QUIT
+25 if $PIECE(ZNODE,U,10)'=PLACE
QUIT
+26 if (($PIECE(ZNODE,U,7)'["WORM")&($PIECE(ZNODE,U,7)'="RW"))
QUIT
+27 SET CNT=CNT+1
SET SHARE=$PIECE(ZNODE,U,2)
+28 IF $EXTRACT(SHARE,$LENGTH(SHARE))="\"
SET SHARE=$EXTRACT(SHARE,1,$LENGTH(SHARE)-1)
+29 SET RESULT(CNT)=X_U_SHARE_U_$PIECE(ZNODE,U,8)
End DoDot:1
+30 QUIT
SHR(RESULT) ; RPC[MAGQ SHARES]
+1 NEW TMP,INDX,DATA,CNT,SHARE,CWL,VALUE,PLACE
+2 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+3 SET (CNT,INDX)=0
SET U="^"
SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+4 SET CWL=$$CWL^MAGBAPI(PLACE)
+5 FOR
SET INDX=$ORDER(^MAG(2005.2,INDX))
if INDX'?1N.N
QUIT
Begin DoDot:1
+6 SET DATA=$GET(^MAG(2005.2,INDX,0))
+7 if $PIECE(DATA,U,6,7)'["1^MAG"
QUIT
+8 ;ROUTING SHARE
if $PIECE(DATA,U,9)="1"
QUIT
+9 if $PIECE(DATA,U,2)["
QUIT
+10 if $PIECE(DATA,U,10)'=PLACE
QUIT
+11 SET SHARE=$PIECE(DATA,U,2)
+12 if $EXTRACT(SHARE,1,2)'="\\"
QUIT
+13 IF $EXTRACT(SHARE,$LENGTH(SHARE))="\"
SET SHARE=$EXTRACT(SHARE,1,$LENGTH(SHARE)-1)
+14 SET SHARE=SHARE_U_$PIECE(DATA,U,8)
+15 if $DATA(TMP(SHARE))
QUIT
+16 SET TMP(SHARE)=INDX
End DoDot:1
+17 SET INDX=""
+18 FOR
SET INDX=$ORDER(TMP(INDX))
if INDX=""
QUIT
Begin DoDot:1
+19 SET RESULT(CNT)=TMP(INDX)_U_INDX
SET CNT=CNT+1
+20 SET ^TMP("MAGQBP",$JOB,"SHRLST",CNT-1)=TMP(INDX)_U_INDX
End DoDot:1
+21 KILL TMP
+22 QUIT
CNP2(RESULT,IEN,START,STOP,AUTO) ;[MAGQ JBSCN]
+1 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+2 NEW FNAME,PIECE,ZNODE,NODE2,BNODE,BNAME,PTR,HASH,TEMP,ORDER,RDATE,PLACE,OFFLINE,PLACEOK,GL,END,ACQSITE,MAGDA,SCANCNT,OFFCNT,ALTPLACE,CORREC
+3 SET (RESULT,GL)=""
SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
SET (OFFLINE,PLACEOK,SCANCNT,ALTPLACE,OFFCNT)=0
SET CORREC=""
+4 IF AUTO
Begin DoDot:1
+5 SET (IEN,MAGDA)=+IEN
+6 SET ORDER="R"
+7 IF START=""
SET START=$SELECT(IEN>0:IEN,1:$ORDER(^MAG(2005,"A"),-1))
+8 SET STOP=$ORDER(^MAG(2005,0))
+9 QUIT
End DoDot:1
+10 if START=""
SET START=$ORDER(^MAG(2005,0))
if STOP=""
SET STOP=$ORDER(^MAG(2005,"A"),-1)
+11 SET ORDER=$SELECT(START>STOP:"R",1:"F")
+12 IF (IEN'?1N.N)!IEN=0
Begin DoDot:1
+13 IF START=0
SET IEN=START
QUIT
+14 IF ORDER="R"
Begin DoDot:2
+15 SET I1=+$ORDER(^MAG(2005," "),-1)
SET I2=+$ORDER(^MAG(2005.1," "),-1)
SET END=$SELECT(I1>I2:I1,1:I2)
+16 SET IEN=$SELECT(START>END:START,1:START+1)
QUIT
End DoDot:2
+17 IF '$TEST
SET (IEN,MAGDA)=START-1
+18 QUIT
End DoDot:1
IF IEN=""
SET RESULT=0
QUIT
+19 SET (IEN,MAGDA)=+IEN
+20 FOR
DO SCAN^MAGQBPG1(.IEN,ORDER,.GL)
Begin DoDot:1
+21 if 'IEN
QUIT
+22 SET SCANCNT=SCANCNT+1
SET OFFLINE=0
+23 SET ZNODE=$GET(@(GL_IEN_",0)"))
SET ACQSITE=$PIECE($GET(@(GL_IEN_",100)")),U,3)
+24 SET NODE2=$GET(@(GL_IEN_",2)"))
+25 IF ((ZNODE']"")!($PIECE(ZNODE,U,1,2)="^^"))!(NODE2']"")!(($PIECE(NODE2,U,1,8)="^^^^^^^")&(($GET(@(GL_IEN_",1)"))']"")))
DO KLOG(GL,IEN,.CORREC)
QUIT
+26 SET PLACEOK=$SELECT($$PLACE^MAGBAPI(+ACQSITE)=$$PLACE^MAGBAPI($GET(DUZ(2))):1,1:"")
+27 ; Only check the offline status of image files
IF $PIECE(ZNODE,U,2)'=""
SET OFFLINE=$$IMOFFLN^MAGFILEB($PIECE(ZNODE,U,2))
+28 IF OFFLINE
SET OFFCNT=OFFCNT+1
QUIT
+29 IF 'PLACEOK
SET ALTPLACE=ALTPLACE+1
QUIT
+30 ; P186 DAC - If PLACE is OK and auto verifier is running and IQ is set end processing
IF AUTO
IF $PIECE(ZNODE,U,11)'=""
Begin DoDot:2
+31 SET $PIECE(RESULT,U,1)=0
+32 SET IEN=0
+33 QUIT
End DoDot:2
QUIT
+34 ; Image is duplicated in the Archive file
IF ($DATA(^MAG(2005.1,IEN,0))&$DATA(^MAG(2005,IEN,0)))
Begin DoDot:2
+35 IF $PIECE(^MAG(2005,IEN,0),U,1,8)="^^^^^^^"
IF +$PIECE(^MAG(2005,IEN,0),U,9)
DO KLOG(GL,IEN,.CORREC)
QUIT
+36 ; Set Dupe field in the Image File
SET FDA(2005,IEN_",",13.5)="1"
+37 ; Set IQ field in the Image File
SET FDA(2005,IEN_",",13)="1"
+38 DO FILE^DIE("I","FDA","MSG")
KILL FDA,MSG
+39 ; Set the Dupe field in the archive file
SET FDA(2005.1,IEN_",",13.5)="1"
+40 ; and set the IQ field in the archive file
SET FDA(2005.1,IEN_",",13)="1"
+41 DO FILE^DIE("I","FDA","MSG")
KILL FDA,MSG
+42 SET $PIECE(RESULT,U,21)="DUPE"
+43 SET $PIECE(RESULT,U)=IEN
+44 IF $PIECE(ZNODE,U,2)=$PIECE($GET(^MAG(2005.1,IEN,0)),U,2)
SET $PIECE(RESULT,U,2)=$PIECE(ZNODE,U,2)
Begin DoDot:3
+45 IF $PIECE(RESULT,U,2)=""
SET $PIECE(RESULT,U,2)="No File Name"
QUIT
End DoDot:3
+46 IF '$TEST
SET $PIECE(RESULT,U,2)=$PIECE(ZNODE,U,2)_"/"_$PIECE($GET(^MAG(2005.1,IEN,0)),U,2)
Begin DoDot:3
+47 IF $PIECE($PIECE(RESULT,U,2),"/")=""
SET $PIECE(RESULT,U,2)="No File Name"_$PIECE(RESULT,U,2)
+48 IF $PIECE($PIECE(RESULT,U,2),"/",2)=""
SET $PIECE(RESULT,U,2)=$PIECE(RESULT,U,2)_"No File Name"
+49 QUIT
End DoDot:3
+50 QUIT
End DoDot:2
QUIT
+51 IF '$TEST
IF $PIECE(ZNODE,U,2)'=""
SET $PIECE(@(GL_IEN_",0)"),U,12)="0"
+52 QUIT
End DoDot:1
if (((ORDER="R")&(IEN<STOP))!((ORDER="F")&(IEN>STOP))!(('OFFLINE)&PLACEOK)!(CORREC]"")!('IEN)!(SCANCNT>249)!($PIECE(RESULT,U,21)="DUPE")!'$GET(ACQSITE))
QUIT
+53 SET $PIECE(RESULT,U,25)=OFFCNT
+54 SET $PIECE(RESULT,U,26)=ALTPLACE
+55 IF CORREC]""
Begin DoDot:1
+56 SET $PIECE(RESULT,U,27)=CORREC
+57 DO SCAN^MAGQBPG1(.IEN,ORDER,.GL)
+58 SET $PIECE(RESULT,U,24)=IEN
+59 QUIT
End DoDot:1
QUIT
+60 IF $SELECT('IEN:1,((ORDER="F")&(IEN>STOP)):1,(SCANCNT>249):1,((ORDER="R")&(IEN<STOP)):1,1:0)
Begin DoDot:1
+61 if SCANCNT>249
SET $PIECE(RESULT,U,24)=IEN
+62 SET $PIECE(RESULT,U,1)=0
+63 QUIT
End DoDot:1
QUIT
+64 SET FNAME=$PIECE(ZNODE,U,2)
+65 SET $PIECE(RESULT,U)=IEN
+66 if ($PIECE(RESULT,U,21)="DUPE")
QUIT
+67 SET $PIECE(RESULT,U,19)=$PIECE($PIECE($GET(@(GL_IEN_",2)")),U),".")
+68 ;NON-GROUP PARENT
IF $PIECE(ZNODE,U,2)'=""
Begin DoDot:1
+69 SET BNODE=$GET(@(GL_IEN_",""FBIG"")"))
+70 IF $PIECE(ZNODE,U,5)?1N.N
SET $PIECE(RESULT,U,3)=$PIECE(ZNODE,U,5)
+71 if $PIECE(BNODE,U,2)?1N.N
SET $PIECE(RESULT,U,4)=$SELECT($PIECE(BNODE,U,3)'="":"["_$PIECE(BNODE,U,3)_"]",1:"")_$PIECE(BNODE,U,2)
+72 if $PIECE(ZNODE,U,3)?1N.N
SET $PIECE(RESULT,U,5)=$PIECE(ZNODE,U,3)
+73 if $PIECE(ZNODE,U,4)?1N.N
SET $PIECE(RESULT,U,6)=$PIECE(ZNODE,U,4)
+74 if $PIECE(BNODE,U)?1N.N
SET $PIECE(RESULT,U,7)=$SELECT($PIECE(BNODE,U,3)'="":"["_$PIECE(BNODE,U,3)_"]",1:"")_$PIECE(BNODE,U)
+75 SET $PIECE(RESULT,U,8)=$$CWL^MAGBAPI(PLACE)
+76 SET $PIECE(RESULT,U,2)=FNAME
+77 IF $DATA(@(GL_IEN_",""FBIG"")"))
IF '$PIECE(BNODE,U)
IF '$PIECE(BNODE,U,2)
SET $PIECE(RESULT,U,22)="EMPTY_FBIG"
+78 QUIT
End DoDot:1
+79 ;"NO ACQ SITE VALUE"
IF '$PIECE($GET(@(GL_IEN_",100)")),U,3)
SET $PIECE(RESULT,U,23)=-1
+80 IF GL[("^MAG(2005.1,")
SET $PIECE(RESULT,U,21)=$SELECT($PIECE($GET(^MAG(2005.1,IEN,100)),U,8)=13:"NE",1:"ARCH")
+81 IF '$TEST
SET $PIECE(RESULT,U,12,17)=$$CHKIMG^MAGQBUT2(IEN)
+82 QUIT
JPUD(RESULT,JPTR,EXT,IEN) ; RPC[MAGQ JPUD]
+1 NEW TYPE,PIECE,NODE,GL
+2 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
SET RESULT="0"
+3 SET TYPE=$$FTYPE^MAGQBPRG(EXT,IEN)
+4 SET PIECE=$SELECT(TYPE="BIG":2,1:5)
+5 SET NODE=$SELECT(TYPE="BIG":"FBIG",1:0)
+6 IF JPTR="0"
Begin DoDot:1
+7 SET JPTR=""
+8 SET GL=$SELECT($DATA(^MAG(2005,IEN)):"^MAG(2005,",$DATA(^MAG(2005.1,IEN)):"^MAG(2005.1,",1:0)
+9 IF GL=0
SET RESULT="-1"
QUIT
+10 ;*154 No file ref.
SET GL=$GET(@(GL_IEN_",0)"))
IF $PIECE(GL,U,2)=""
SET RESULT=-1
QUIT
+11 ;*154 +fix
IF $DATA(^MAGQUEUE(2006.033,"B",$PIECE(GL,U,2)))
Begin DoDot:2
+12 ;Don't clear the JB pointer if image is on an Offline Platter
SET RESULT=-2
QUIT
+13 QUIT
End DoDot:2
QUIT
+14 QUIT
End DoDot:1
if (RESULT<0)
QUIT
+15 if $DATA(^MAG(2005,IEN,NODE))
SET $PIECE(^MAG(2005,IEN,NODE),U,PIECE)=JPTR
+16 if $DATA(^MAG(2005.1,IEN,NODE))
SET $PIECE(^MAG(2005.1,IEN,NODE),U,PIECE)=JPTR
+17 SET RESULT="1"
+18 QUIT
VCUD(RESULT,VCPTR,EXT,IEN) ; RPC[MAGQ VCUD]
+1 NEW TYPE,PIECE,NODE
+2 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
SET RESULT="0"
+3 SET TYPE=$$FTYPE^MAGQBPRG(EXT,IEN)
+4 SET PIECE=$SELECT(TYPE="BIG":1,TYPE="ABS":4,1:3)
+5 SET NODE=$SELECT(TYPE="BIG":"FBIG",1:0)
+6 if VCPTR="0"
SET VCPTR=""
+7 if $DATA(^MAG(2005,IEN,NODE))
SET $PIECE(^MAG(2005,IEN,NODE),U,PIECE)=VCPTR
+8 if $DATA(^MAG(2005.1,IEN,NODE))
SET $PIECE(^MAG(2005.1,IEN,NODE),U,PIECE)=VCPTR
+9 SET RESULT="1"
+10 QUIT
DFNIQ(RESULT,INPUT,SEND,PLACE,APP) ;
+1 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+2 NEW LOC,CNT,Y,XMSUB
+3 SET U="^"
SET RESULT="1"
+4 SET CNT=+$ORDER(^TMP($JOB,"MAGQDFN",PLACE,APP,""),-1)
+5 IF CNT<2
Begin DoDot:1
+6 SET LOC=$$KSP^XUPARAM("WHERE")
+7 SET ^TMP($JOB,"MAGQDFN",PLACE,APP,1)=" SITE: "_LOC
+8 SET ^TMP($JOB,"MAGQDFN",PLACE,APP,2)=" DATE: "_$$FMTE^XLFDT($$NOW^XLFDT)_" "_$G(^XMB("TIMEZONE"))
+9 SET CNT=2
QUIT
End DoDot:1
+10 IF SEND="1"
Begin DoDot:1
+11 SET RESULT=$$SUBCHK^XMGAPI0(INPUT,0)
+12 if $PIECE(RESULT,U)
QUIT
+13 SET XMSUB=INPUT
+14 NEW XMTEXT,INTERVAL,XMDUZ,XMZ
+15 SET INTERVAL=$$GETMI^MAGQBUT5(XMSUB,PLACE)
+16 IF $$FMADD^XLFDT(+$PIECE(INTERVAL,"^",2),"",+$PIECE(INTERVAL,U,1),"","")>$$NOW^XLFDT
Begin DoDot:2
+17 KILL ^TMP($JOB,"MAGQDFN",PLACE,APP)
QUIT
End DoDot:2
QUIT
+18 SET XMTEXT="^TMP($J,""MAGQDFN"",PLACE,APP)"
+19 if $$PROD^XUPROD("1")
DO ADDMG^MAGQBUT5(INPUT,.XMY,PLACE)
+20 SET XMY(DUZ)=""
SET XMDUZ=DUZ
SET XMY(XMDUZ)=""
+21 SET XMID=$GET(DUZ)
if 'XMID
SET XMID=.5
+22 SET XMINSTR("FLAGS")="I"
SET XMINSTR("FROM")="VistA Imaging "_APP
+23 DO SENDMSG^XMXAPI(XMID,XMSUB,XMTEXT,.XMY,.XMINSTR,.XMZ,)
+24 KILL ^TMP($JOB,"MAGQDFN",PLACE,APP)
+25 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
KILL XMERR
+26 KILL ^TMP($JOB,"MAGQDFN",PLACE,APP)
+27 DO UDMI^MAGQBUT5(INPUT,PLACE)
QUIT
End DoDot:1
+28 IF '$TEST
SET CNT=CNT+1
SET ^TMP($JOB,"MAGQDFN",PLACE,APP,CNT)=INPUT
+29 SET $PIECE(RESULT,U)=$SELECT($PIECE(RESULT,U):"1",1:0)
+30 KILL XMY,XMINSTR,XMID
+31 QUIT
SCAN(IEN,ORDER,GB) ; Find the next image spanning the Image and the Image Archive file
+1 IF IEN
IF GB="^MAG(2005,"
IF $DATA(^MAG(2005.1,IEN))
Begin DoDot:1
+2 SET IEN=IEN
SET GB="^MAG(2005.1,"
QUIT
End DoDot:1
QUIT
+3 NEW I1,I2
+4 IF $GET(ORDER)="F"
Begin DoDot:1
+5 SET I1=$ORDER(^MAG(2005,IEN))
SET I1=$SELECT(I1:I1,1:"")
+6 SET I2=$ORDER(^MAG(2005.1,IEN))
SET I2=$SELECT(I2:I2,1:"")
+7 IF I1
IF 'I2
SET IEN=I1
SET GB="^MAG(2005,"
QUIT
+8 IF I2
IF 'I1
SET IEN=I2
SET GB="^MAG(2005.1,"
QUIT
+9 SET GB=$SELECT(I1>I2:"^MAG(2005.1,",1:"^MAG(2005,")
+10 SET IEN=$SELECT(I1>I2:I2,1:I1)
+11 QUIT
End DoDot:1
+12 ;Reverse
IF '$TEST
Begin DoDot:1
+13 SET I1=$ORDER(^MAG(2005,IEN),-1)
SET I1=$SELECT(I1:I1,1:"")
+14 SET I2=$ORDER(^MAG(2005.1,IEN),-1)
SET I2=$SELECT(I2:I2,1:"")
+15 IF I1
IF 'I2
SET IEN=I1
SET GB="^MAG(2005,"
QUIT
+16 IF I2
IF 'I1
SET IEN=I2
SET GB="^MAG(2005.1,"
QUIT
+17 SET GB=$SELECT(I1<I2:"^MAG(2005.1,",1:"^MAG(2005,")
+18 SET IEN=$SELECT(I1<I2:I2,1:I1)
+19 QUIT
End DoDot:1
+20 SET (IEN,MAGDA)=$SELECT('IEN:"",1:IEN)
+21 QUIT
KLOG(GL,IEN,CORREC) ;
+1 SET CORREC=$PIECE($PIECE(GL,","),"^MAG(",2)_"~"_IEN
+2 ;Journal the nodes and content being killed
DO LOGKILL(GL_IEN_")")
+3 KILL @(GL_IEN_")")
+4 QUIT
LOGKILL(REC) ; Log the content into the ^TMP global error log rpc
+1 NEW NODE,NODE1,NODE2,NODE3,TMP,TMP1
+2 SET NODE=""
+3 FOR
SET NODE=$ORDER(@REC@(NODE))
if NODE=""
QUIT
Begin DoDot:1
+4 SET TMP=$GET(@REC@(NODE))
IF TMP]""
SET TMP1=$PIECE(REC,")")_","_NODE_")="_TMP
DO ELOGV(TMP1)
+5 SET NODE1=""
FOR
SET NODE1=$ORDER(@REC@(NODE,NODE1))
if NODE1=""
QUIT
Begin DoDot:2
+6 SET TMP=$GET(@REC@(NODE,NODE1))
IF TMP]""
SET TMP1=$PIECE(REC,")")_","_NODE_","_NODE1_")="_TMP
DO ELOGV(TMP1)
+7 SET NODE2=""
FOR
SET NODE2=$ORDER(@REC@(NODE,NODE1,NODE2))
if NODE2=""
QUIT
Begin DoDot:3
+8 SET TMP=$GET(@REC@(NODE,NODE1,NODE2))
IF TMP]""
SET TMP1=$PIECE(REC,")")_","_NODE_","_NODE1_","_NODE2_")"_"="_TMP
DO ELOGV(TMP1)
+9 SET NODE3=""
FOR
SET NODE3=$ORDER(@REC@(NODE,NODE1,NODE2,NODE3))
if NODE3=""
QUIT
Begin DoDot:4
+10 SET TMP=$GET(@REC@(NODE,NODE1,NODE2,NODE3))
SET TMP1=$PIECE(REC,")")_","_NODE_","_NODE1_","_NODE2_","_NODE3_")="_TMP
DO ELOGV(TMP1)
+11 QUIT
End DoDot:4
+12 QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 QUIT
ELOGV(MESG,LIMIT) ;TMP Log
+1 NEW INDX
+2 NEW X
SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+3 SET INDX=+$ORDER(^TMP("MAGQ",$JOB,"BPV",""),-1)+1
+4 SET ^TMP("MAGQ",$JOB,"BPV",INDX)=MESG
+5 QUIT
ELOGRV(RESULT,LIMIT) ; [MAGQ LOGV] Error log report and purge
+1 ; Please test this
+2 NEW FN,INDX,CNT
+3 NEW X
SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+4 SET CNT=0
SET INDX=""
+5 FOR
SET INDX=$ORDER(^TMP("MAGQ",$JOB,"BPV",INDX))
if INDX'?1N.N
QUIT
if CNT=LIMIT
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
SET RESULT(CNT)=^TMP("MAGQ",$JOB,"BPV",INDX)
+7 KILL ^TMP("MAGQ",$JOB,"BPV",INDX)
+8 QUIT
End DoDot:1
+9 SET RESULT(0)=CNT
+10 SET INDX=$ORDER(^TMP("MAGQ",$JOB,"BPV",""))
+11 IF INDX?1N.N
SET RESULT(0)=RESULT(0)_U_"MORE"
+12 QUIT
