| 1 | MAGQBTM ;WOIFO/RMP - REMOTE Task SERVER Program [ 03/25/2001 11:20 ]
|
|---|
| 2 | ;;3.0;IMAGING;**1,7,8,20,81**;May 17, 2007
|
|---|
| 3 | ;; Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;; +---------------------------------------------------------------+
|
|---|
| 5 | ;; | Property of the US Government. |
|
|---|
| 6 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 7 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 8 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 9 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 10 | ;; | telephone (301) 734-0100. |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | ;
|
|---|
| 19 | ENTRY(RESULT,WSTAT,PROCESS) ; RPC[MAGQ ABP]
|
|---|
| 20 | N X,SYSIEN,SYSNAME,NODE,INDX,CNT,PROC,%,QPTR,QCNT,VERS,EXEDATE,WSOS,PLACE,VOK
|
|---|
| 21 | D NOW^%DTC
|
|---|
| 22 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 23 | S (SYSIEN,CNT)=0,SYSNAME="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),VOK=""
|
|---|
| 24 | S $P(RESULT(0),U,6)=$D(^XUSEC("MAG SYSTEM",DUZ))
|
|---|
| 25 | Q:'$P(RESULT(0),U,6)
|
|---|
| 26 | S VERS=$P(WSTAT,U,2),EXEDATE=$P(WSTAT,U,3),WSOS=$P(WSTAT,U,4)
|
|---|
| 27 | S WSTAT=$P(WSTAT,U)
|
|---|
| 28 | S SYSIEN=$O(^MAG(2006.8,"C",PLACE,WSTAT,""))
|
|---|
| 29 | I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4(WSTAT),""))
|
|---|
| 30 | I 'SYSIEN D
|
|---|
| 31 | . N TRY
|
|---|
| 32 | . F TRY=1:1:$L(WSTAT,".") D Q:SYSIEN?1.N
|
|---|
| 33 | . . S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$P(WSTAT,".",TRY),""))
|
|---|
| 34 | . . I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4($P(WSTAT,".",TRY)),""))
|
|---|
| 35 | Q:SYSIEN=""
|
|---|
| 36 | S $P(^MAG(2006.8,SYSIEN,1),U,2)=VERS
|
|---|
| 37 | S $P(^MAG(2006.8,SYSIEN,1),U,3)=EXEDATE
|
|---|
| 38 | S $P(^MAG(2006.8,SYSIEN,1),U,4)=WSOS
|
|---|
| 39 | S VERS=$P(VERS,".",1,2)_"P"_$P(VERS,".",3)
|
|---|
| 40 | D VOKR^MAGQBUT4(.VOK,VERS)
|
|---|
| 41 | Q:'$P(VOK,U)
|
|---|
| 42 | S ^TMP("MAGQN",$J,0)=SYSIEN_"^"_WSTAT
|
|---|
| 43 | S NODE=^MAG(2006.8,SYSIEN,0)
|
|---|
| 44 | S SYSNAME=$P(NODE,U)
|
|---|
| 45 | I SYSNAME="" D Q
|
|---|
| 46 | . S $P(RESULT(0),U,1,2)="-1^No Background Processor parameters on system"
|
|---|
| 47 | I $P(NODE,U,12)'=1 D Q
|
|---|
| 48 | . S $P(RESULT(0),U,1,2)="-1^Not assigned as a Background Processor"
|
|---|
| 49 | F PROC="ABSTRACT","JUKEBOX","JBTOHD","DELETE","PREFET","GCC","IMPORT" D
|
|---|
| 50 | . N FNUM,PIECE
|
|---|
| 51 | . S FNUM=$$FNUM(PROC)
|
|---|
| 52 | . S PIECE=$$GET1^DID(2006.8,FNUM,"","GLOBAL SUBSCRIPT LOCATION")
|
|---|
| 53 | . S PIECE=$P(PIECE,";",2)
|
|---|
| 54 | . I $P(NODE,U,PIECE)="1" D
|
|---|
| 55 | . . N QCNT,QPTR
|
|---|
| 56 | . . D ADD^MAGBAPI(0,PROC,PLACE)
|
|---|
| 57 | . . S QPTR=$O(^MAGQUEUE(2006.031,"C",PLACE,PROC,""))
|
|---|
| 58 | . . S QCNT=$P($G(^MAGQUEUE(2006.031,+QPTR,0)),U,3)
|
|---|
| 59 | . . S CNT=CNT+1
|
|---|
| 60 | . . S RESULT(CNT)=PROC_U_QCNT
|
|---|
| 61 | . . Q
|
|---|
| 62 | . Q
|
|---|
| 63 | S $P(RESULT(0),U,1,5)="0^BP List^PID: "_$$BASE^XLFUTL($J,10,16)_"^"_SYSNAME_U_WSTAT
|
|---|
| 64 | Q
|
|---|
| 65 | FNUM(PROCESS) ;
|
|---|
| 66 | Q:PROC="ABSTRACT" 12
|
|---|
| 67 | Q:PROC="JUKEBOX" 13
|
|---|
| 68 | Q:PROC="JBTOHD" 14
|
|---|
| 69 | Q:PROC="PREFET" 15
|
|---|
| 70 | Q:PROC="IMPORT" 16
|
|---|
| 71 | Q:PROC="GCC" 17
|
|---|
| 72 | Q:PROC="DELETE" 20
|
|---|
| 73 | Q 0
|
|---|
| 74 | GETQUE(RESULT,ACTION) ; RPC[MAGQ GET]
|
|---|
| 75 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 76 | D @(ACTION_"(.RESULT)")
|
|---|
| 77 | I +RESULT<0 D
|
|---|
| 78 | . D NOW^%DTC
|
|---|
| 79 | . D QSTAT($P(RESULT,U,2),$P(RESULT,U,3),ACTION,$$PLACE^MAGBAPI(+$G(DUZ(2))))
|
|---|
| 80 | . D QPTER(ACTION,$P(RESULT,U,2))
|
|---|
| 81 | Q
|
|---|
| 82 | ABSTRACT(RESULT) ;
|
|---|
| 83 | D DEQUEUE("ABSTRACT",.RESULT) Q
|
|---|
| 84 | JUKEBOX(RESULT) ;
|
|---|
| 85 | D DEQUEUE("JUKEBOX",.RESULT) Q
|
|---|
| 86 | JBTOHD(RESULT) ;
|
|---|
| 87 | D DEQUEUE("JBTOHD",.RESULT) Q
|
|---|
| 88 | GCC(RESULT) ;
|
|---|
| 89 | D DEQUEUE("GCC",.RESULT) Q
|
|---|
| 90 | DELETE(RESULT) ;
|
|---|
| 91 | D DEQUEUE("DELETE",.RESULT) Q
|
|---|
| 92 | PREFET(RESULT) ;
|
|---|
| 93 | D DEQUEUE("PREFET",.RESULT) Q
|
|---|
| 94 | IMPORT(RESULT) ;
|
|---|
| 95 | D DEQUEUE("IMPORT",.RESULT) Q
|
|---|
| 96 | DEQUEUE(QUE,RESULT) ;
|
|---|
| 97 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 98 | N QPTR,QPTR2,ROU,MAGIEN,ZNODE,MSG,IMQUE,PLACE
|
|---|
| 99 | S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
|
|---|
| 100 | S QPTR2=$O(^MAGQUEUE(2006.031,"C",PLACE,QUE,""))
|
|---|
| 101 | S QPTR=$S(QPTR2:$P(^MAGQUEUE(2006.031,QPTR2,0),U,2),1:"")
|
|---|
| 102 | S QPTR=$O(^MAGQUEUE(2006.03,"C",PLACE,QUE,QPTR))
|
|---|
| 103 | I QPTR="" D Q
|
|---|
| 104 | . S RESULT="0"_U_QPTR2_U_"No "_QUE_" "_QPTR2_" to process."
|
|---|
| 105 | D QSTAT(QPTR,QUE_" in progress.",QUE,PLACE)
|
|---|
| 106 | S ZNODE=$G(^MAGQUEUE(2006.03,QPTR,0))
|
|---|
| 107 | I ZNODE="" S RESULT=-101_U_QPTR_U_"Queue Record does not exist" Q
|
|---|
| 108 | I QUE="IMPORT" D ENTRY^MAGQBIM(QPTR,QUE,QPTR2,ZNODE,.RESULT) Q
|
|---|
| 109 | S MAGIEN=$P(ZNODE,"^",7)
|
|---|
| 110 | I ("^DELETE^JUKEBOX^")'[(U_QUE_U),(('(+MAGIEN))!('$D(^MAG(2005,+MAGIEN,0)))!($P(ZNODE,U)'=QUE)) D Q
|
|---|
| 111 | . I $D(^MAG(2005.1,+MAGIEN,0)) D
|
|---|
| 112 | . . S MSG="Image Record Deleted and in archive file."
|
|---|
| 113 | . E S MSG="No valid image file number to process."
|
|---|
| 114 | . S RESULT=-101_U_QPTR_U_MSG
|
|---|
| 115 | S ROU=$$RESET(QUE)
|
|---|
| 116 | I ROU="" S RESULT="-1"_U_QPTR_U_QUE_" Is an inactive process" Q
|
|---|
| 117 | D @("ENTRY^"_ROU_"(.RESULT,QPTR)")
|
|---|
| 118 | Q
|
|---|
| 119 | QSTAT(QPTR,MESSAGE,ACTION,PLACE) ;
|
|---|
| 120 | N ZNODE
|
|---|
| 121 | Q:QPTR=""
|
|---|
| 122 | S MESSAGE=$TR(MESSAGE,":;<>.?/\'()*^%$#@!0123456789","")
|
|---|
| 123 | Q:'$D(^MAGQUEUE(2006.03,QPTR,0))
|
|---|
| 124 | S ZNODE=$G(^MAGQUEUE(2006.03,QPTR,0))
|
|---|
| 125 | D NOW^%DTC
|
|---|
| 126 | I $P(ZNODE,U,5)]"" D
|
|---|
| 127 | . K ^MAGQUEUE(2006.03,"D",PLACE,$P(ZNODE,U),$E($P(ZNODE,U,5),1,30),QPTR) Q
|
|---|
| 128 | S ^MAGQUEUE(2006.03,"D",PLACE,$P(ZNODE,U),$E(MESSAGE,1,30),QPTR)=""
|
|---|
| 129 | S $P(^MAGQUEUE(2006.03,QPTR,0),U,5,6)=$P(MESSAGE,U)_U_%
|
|---|
| 130 | I ACTION["IMPORT" D STAT^MAGQBIM(QPTR,%,MESSAGE)
|
|---|
| 131 | Q
|
|---|
| 132 | QPTER(QUEUE,QPTR) ;
|
|---|
| 133 | N QREC,PREV,PNODE,PLACE
|
|---|
| 134 | S PLACE=$P($G(^MAGQUEUE(2006.03,QPTR,0)),U,12)
|
|---|
| 135 | S PLACE=$S(PLACE:PLACE,1:$$PLACE^MAGBAPI(+$G(DUZ(2))))
|
|---|
| 136 | S QREC=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
|
|---|
| 137 | S PREV=$S(QREC:$P(^MAGQUEUE(2006.031,QREC,0),U,2),1:"")
|
|---|
| 138 | I PREV'=QPTR D Q
|
|---|
| 139 | . D ADD^MAGBAPI(-1,QUEUE,PLACE)
|
|---|
| 140 | . L +^MAGQUEUE(2006.031,QREC,0)
|
|---|
| 141 | . S $P(^MAGQUEUE(2006.031,QREC,0),U,2)=QPTR
|
|---|
| 142 | . L -^MAGQUEUE(2006.031,QREC,0)
|
|---|
| 143 | . Q
|
|---|
| 144 | D ADD^MAGBAPI(0,QUEUE,PLACE)
|
|---|
| 145 | Q
|
|---|
| 146 | RESET(QUEUE) ; Set Routine parameter
|
|---|
| 147 | Q:QUEUE="ABSTRACT" "MAGQBAB"
|
|---|
| 148 | Q:QUEUE="JUKEBOX" "MAGQBJB"
|
|---|
| 149 | Q:QUEUE="JBTOHD" "MAGQBJH"
|
|---|
| 150 | Q:QUEUE="DELETE" "MAGQBD"
|
|---|
| 151 | Q:QUEUE="PREFET" "MAGQBJH"
|
|---|
| 152 | Q:QUEUE="IMPORT" "MAGQBIM"
|
|---|
| 153 | Q:QUEUE="GCC" "MAGQBGCC"
|
|---|
| 154 | Q ""
|
|---|
| 155 | RQCNT(PLACE) ;
|
|---|
| 156 | N QIEN,QPTR,QNAM
|
|---|
| 157 | S QNAM=""
|
|---|
| 158 | F S QNAM=$O(^MAGQUEUE(2006.031,"C",PLACE,QNAM)) Q:QNAM="" D
|
|---|
| 159 | . S QIEN=$O(^MAGQUEUE(2006.031,"C",PLACE,QNAM,"")) Q:QIEN'?1.N
|
|---|
| 160 | . S QPTR=+$P(^MAGQUEUE(2006.031,QIEN,0),U,2)
|
|---|
| 161 | . S $P(^MAGQUEUE(2006.031,QIEN,0),U,3)=""
|
|---|
| 162 | . D ADD^MAGBAPI(0,QNAM,PLACE)
|
|---|
| 163 | . Q
|
|---|
| 164 | Q
|
|---|
| 165 | QUPDTE(RESULT,QPTR,UPDATE) ;RPC[MAGQ QUD]
|
|---|
| 166 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 167 | N NODE,STAT,TYPE,VPTR,MPTR,IEN,IDFN,MSG,PLACE
|
|---|
| 168 | S NODE=$G(^MAGQUEUE(2006.03,QPTR,0))
|
|---|
| 169 | S PLACE=$P(NODE,U,12)
|
|---|
| 170 | S RESULT="1^QUEUE UPDATE COMPLETE"
|
|---|
| 171 | S STAT=$P(UPDATE,U)
|
|---|
| 172 | S TYPE=$P(NODE,U)
|
|---|
| 173 | S MSG=$S($P(UPDATE,U,2)="":TYPE_" Process Error",1:$P(UPDATE,U,2))
|
|---|
| 174 | D QSTAT(QPTR,MSG,TYPE,PLACE)
|
|---|
| 175 | D QPTER(TYPE,QPTR)
|
|---|
| 176 | I STAT<0 Q
|
|---|
| 177 | I "^DELETE^"[("^"_TYPE_"^") D DQUE^MAGQBUT(QPTR) Q
|
|---|
| 178 | I "^IMPORT^"[("^"_TYPE_"^") D Q
|
|---|
| 179 | . D DQUE^MAGQBUT(QPTR)
|
|---|
| 180 | . S DIK="^MAG(2006.034,",DA=QPTR D ^DIK
|
|---|
| 181 | . S DIK="^MAG(2006.041,",DA=QPTR D ^DIK
|
|---|
| 182 | . K DIK,DA
|
|---|
| 183 | . Q
|
|---|
| 184 | S VPTR=$P(UPDATE,U,3)
|
|---|
| 185 | I VPTR?1.N D
|
|---|
| 186 | . S MPTR=$P(NODE,U,7)
|
|---|
| 187 | . I "^ABSTRACT^"[("^"_TYPE_"^") D Q
|
|---|
| 188 | . . S $P(^MAG(2005,MPTR,0),U,4)=VPTR
|
|---|
| 189 | . . S X=$$JUKEBOX^MAGBAPI(MPTR,PLACE)
|
|---|
| 190 | . . D DQUE^MAGQBUT(QPTR) Q
|
|---|
| 191 | . I ("^JBTOHD^"[("^"_TYPE_"^"))!("^PREFET^"[("^"_TYPE_"^")) D Q
|
|---|
| 192 | . . I "^FULL^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,0),U,3)=VPTR
|
|---|
| 193 | . . I "^ABSTRACT^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,0),U,4)=VPTR
|
|---|
| 194 | . . I "^BIG^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,"FBIG"),U)=VPTR
|
|---|
| 195 | . . D DQUE^MAGQBUT(QPTR) Q
|
|---|
| 196 | . I "^JUKEBOX^"[("^"_TYPE_"^") D Q
|
|---|
| 197 | . . I $P(UPDATE,U,2)["BIG" D Q
|
|---|
| 198 | . . . S:$D(^MAG(2005,MPTR)) $P(^MAG(2005,MPTR,"FBIG"),U,2)=VPTR
|
|---|
| 199 | . . . S:$D(^MAG(2005.1,MPTR)) $P(^MAG(2005.1,MPTR,"FBIG"),U,2)=VPTR
|
|---|
| 200 | . . . D DQUE^MAGQBUT(QPTR) Q
|
|---|
| 201 | . . E D
|
|---|
| 202 | . . . S:$D(^MAG(2005,MPTR)) $P(^MAG(2005,MPTR,0),U,5)=VPTR
|
|---|
| 203 | . . . S:$D(^MAG(2005.1,MPTR)) $P(^MAG(2005.1,MPTR,0),U,5)=VPTR
|
|---|
| 204 | . . . D DQUE^MAGQBUT(QPTR) Q
|
|---|
| 205 | . . Q
|
|---|
| 206 | . I "^GCC^"[("^"_TYPE_"^") D Q
|
|---|
| 207 | . . D NOW^%DTC
|
|---|
| 208 | . . S FDA(2005.01,"+1,"_MPTR_",",.01)=VPTR
|
|---|
| 209 | . . S FDA(2005.01,"+1,"_MPTR_",",1)=%
|
|---|
| 210 | . . S FDA(2005.01,"+1,"_MPTR_",",2)=$P($$TRIM^MAGQBUT4($P(UPDATE,U,2))," ")
|
|---|
| 211 | . . D UPDATE^DIE("U","FDA","","MAGIMP")
|
|---|
| 212 | . . S IDFN=$P(^MAG(2005,MPTR,0),U,7)
|
|---|
| 213 | . . D ENTRY^MAGLOG("EXPORT->"_$P($G(^MAG(2005.2,VPTR,0)),U,2),$P(NODE,U,2),MPTR,"Document Imaging",IDFN,0)
|
|---|
| 214 | . . D DQUE^MAGQBUT(QPTR) Q
|
|---|
| 215 | . Q
|
|---|
| 216 | Q
|
|---|
| 217 | REQUE(RESULT,QPTR) ;
|
|---|
| 218 | ; RPC[MAGQ REQ]
|
|---|
| 219 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 220 | N PROC,NODE,INDX,PARAM,OPDUZ,STATUS,TRACKID,PLACE
|
|---|
| 221 | S INDX=$$TRIM^MAGQBUT4(QPTR),TRACKID=0
|
|---|
| 222 | S NODE=$G(^MAGQUEUE(2006.03,INDX,0))
|
|---|
| 223 | Q:NODE']""
|
|---|
| 224 | S PLACE=$P(NODE,U,12)
|
|---|
| 225 | Q:'PLACE
|
|---|
| 226 | S PROC=$P(NODE,U),STATUS=$P(NODE,U,5)
|
|---|
| 227 | I PROC'="IMPORT" D
|
|---|
| 228 | . D RQP(PROC,NODE,.PARAM)
|
|---|
| 229 | . S @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,PLACE)")
|
|---|
| 230 | . Q
|
|---|
| 231 | E D
|
|---|
| 232 | . S $P(PARAM,U,3)=+$P(NODE,U,9)+1
|
|---|
| 233 | . S $P(PARAM,U,4)=$S($P(NODE,U,11)?1N.N:$P(NODE,U,11),1:QPTR)
|
|---|
| 234 | . D TIDL^MAGQBIM($S($P(NODE,U,11)?1N.N:$P(NODE,U,11),1:QPTR),PROC,.TRACKID)
|
|---|
| 235 | . Q:TRACKID=0
|
|---|
| 236 | . S @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,$P(NODE,U,10),TRACKID,PLACE)")
|
|---|
| 237 | Q:((PROC="IMPORT")&(TRACKID=0))
|
|---|
| 238 | D DQUE^MAGQBUT(INDX)
|
|---|
| 239 | Q
|
|---|
| 240 | RQP(P,N,PAR) ;
|
|---|
| 241 | N P1,P2,P3,P4
|
|---|
| 242 | 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
|
|---|
| 243 | I P["DELETE" S P1=$P(N,U,10),P2=+$P(N,U,9)+1,PAR=P2_U_P1 Q
|
|---|
| 244 | I P["GCC" D Q
|
|---|
| 245 | . 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
|
|---|
| 246 | S P1=$P(N,U,7)_"^^",P2=+$P(N,U,9)+1,PAR=P1_P2 ;JUKEBOX + ABSTRACT
|
|---|
| 247 | Q
|
|---|
| 248 | ERR ;
|
|---|
| 249 | N ERRXX
|
|---|
| 250 | S ERRXX=$$EC^%ZOSV
|
|---|
| 251 | D ^%ZTER
|
|---|
| 252 | D ^XUSCLEAN
|
|---|
| 253 | Q
|
|---|
