MAGQBIM ;WOIFO/RMP - Import functions ; 18 Jan 2011 4:52 PM
;;3.0;IMAGING;**7,20,39**;Mar 19, 2002;Build 2010;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
ENTRY(QP,QUE,QP2,ZN,RES) ;
N IEN,TRACKID,ASIEN,XX,X,X2,PLACE
S IEN=$S($P(ZN,U,11)?1N.N:$P(ZN,U,11),1:QP),TRACKID=""
S ASIEN=$O(^MAG(2006.041,"B",IEN,""))
I ASIEN?1N.N S TRACKID=$P($G(^MAG(2006.041,ASIEN,0)),U,2)
I TRACKID']"" D Q:TRACKID']""
. D QSTAT^MAGQBTM(QP,"Import De-queue Holding FIVE sec for TrackID.",QUE,.PLACE)
. S X=$$DT^XLFDT,X2=$$FMADD^XLFDT(X,30)
. I '$D(^XTMP("MAGQBIM "_X,0)) D
. . S ^XTMP("MAGQBIM "_X,0)=X2_"^"_X_"^"_"Recording IMPORT Trackid failure"
. . Q
. S ^XTMP("MAGQBIM "_X,$$NOW^XLFDT)="Queue ptr: "_QP_U_"De-queue Holding FIVE sec for Station #: ^"_$P(^MAG(2006.1,$P($G(ZN),U,12),0),U,1)
. H 5
. S ASIEN=$O(^MAG(2006.041,"B",IEN,"")) ;try setting again after the hang
. I ASIEN?1N.N S TRACKID=$P($G(^MAG(2006.041,ASIEN,0)),U,2)
. S RES="-1"_U_QP_U_" Dequeue Failed on TrackId lookup."
. Q
S RES=QP_U_TRACKID_U_$TR($P(ZN,U,10),"|",U)_U_IEN
S $P(RES,U,8)=+$P(ZN,U,9)
Q
STAT(QP,TIME,MESS) ;
N STATID,STATIEN
S STATIEN=$O(^MAG(2006.041,"B",QP,"")),STATID=""
I STATIEN?1N.N S STATID=$P($G(^MAG(2006.041,STATIEN,0)),U,2)
Q:STATID']""
K FDA
S FDA(2006.041,"+1,",.01)=QP
S FDA(2006.041,"+1,",.02)=STATID
S FDA(2006.041,"+1,",1)="BP QUEUE STATUS"
S FDA(2006.041,"+1,",2)=TIME
S FDA(2006.041,"+1,",3)=MESS
D UPDATE^DIE("U","FDA","","MAGIMP")
Q
TIDL(QP,QUE,RES) ; Tracking ID Lookup - Used for IMPORT Re-Queue
N ASIEN,TRACKID
S RES=0,TRACKID=""
S ASIEN=$O(^MAG(2006.041,"B",QP,""))
I ASIEN?1N.N S TRACKID=$P($G(^MAG(2006.041,ASIEN,0)),U,2)
I TRACKID']"" D Q
. D QSTAT^MAGQBTM(QP,QUE_" Requeue Failed on TrackId lookup.",QUE,$$PLACE^MAGBAPI(+$G(DUZ(2))))
. Q
S RES=TRACKID
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBIM 2814 printed Oct 16, 2024@18:08:26 Page 2
MAGQBIM ;WOIFO/RMP - Import functions ; 18 Jan 2011 4:52 PM
+1 ;;3.0;IMAGING;**7,20,39**;Mar 19, 2002;Build 2010;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 ;
+18 QUIT
ENTRY(QP,QUE,QP2,ZN,RES) ;
+1 NEW IEN,TRACKID,ASIEN,XX,X,X2,PLACE
+2 SET IEN=$SELECT($PIECE(ZN,U,11)?1N.N:$PIECE(ZN,U,11),1:QP)
SET TRACKID=""
+3 SET ASIEN=$ORDER(^MAG(2006.041,"B",IEN,""))
+4 IF ASIEN?1N.N
SET TRACKID=$PIECE($GET(^MAG(2006.041,ASIEN,0)),U,2)
+5 IF TRACKID']""
Begin DoDot:1
+6 DO QSTAT^MAGQBTM(QP,"Import De-queue Holding FIVE sec for TrackID.",QUE,.PLACE)
+7 SET X=$$DT^XLFDT
SET X2=$$FMADD^XLFDT(X,30)
+8 IF '$DATA(^XTMP("MAGQBIM "_X,0))
Begin DoDot:2
+9 SET ^XTMP("MAGQBIM "_X,0)=X2_"^"_X_"^"_"Recording IMPORT Trackid failure"
+10 QUIT
End DoDot:2
+11 SET ^XTMP("MAGQBIM "_X,$$NOW^XLFDT)="Queue ptr: "_QP_U_"De-queue Holding FIVE sec for Station #: ^"_$P(^MAG(2006.1,$PIECE($GET(ZN),U,12),0),U,1)
+12 HANG 5
+13 ;try setting again after the hang
SET ASIEN=$ORDER(^MAG(2006.041,"B",IEN,""))
+14 IF ASIEN?1N.N
SET TRACKID=$PIECE($GET(^MAG(2006.041,ASIEN,0)),U,2)
+15 SET RES="-1"_U_QP_U_" Dequeue Failed on TrackId lookup."
+16 QUIT
End DoDot:1
if TRACKID']""
QUIT
+17 SET RES=QP_U_TRACKID_U_$TRANSLATE($PIECE(ZN,U,10),"|",U)_U_IEN
+18 SET $PIECE(RES,U,8)=+$PIECE(ZN,U,9)
+19 QUIT
STAT(QP,TIME,MESS) ;
+1 NEW STATID,STATIEN
+2 SET STATIEN=$ORDER(^MAG(2006.041,"B",QP,""))
SET STATID=""
+3 IF STATIEN?1N.N
SET STATID=$PIECE($GET(^MAG(2006.041,STATIEN,0)),U,2)
+4 if STATID']""
QUIT
+5 KILL FDA
+6 SET FDA(2006.041,"+1,",.01)=QP
+7 SET FDA(2006.041,"+1,",.02)=STATID
+8 SET FDA(2006.041,"+1,",1)="BP QUEUE STATUS"
+9 SET FDA(2006.041,"+1,",2)=TIME
+10 SET FDA(2006.041,"+1,",3)=MESS
+11 DO UPDATE^DIE("U","FDA","","MAGIMP")
+12 QUIT
TIDL(QP,QUE,RES) ; Tracking ID Lookup - Used for IMPORT Re-Queue
+1 NEW ASIEN,TRACKID
+2 SET RES=0
SET TRACKID=""
+3 SET ASIEN=$ORDER(^MAG(2006.041,"B",QP,""))
+4 IF ASIEN?1N.N
SET TRACKID=$PIECE($GET(^MAG(2006.041,ASIEN,0)),U,2)
+5 IF TRACKID']""
Begin DoDot:1
+6 DO QSTAT^MAGQBTM(QP,QUE_" Requeue Failed on TrackId lookup.",QUE,$$PLACE^MAGBAPI(+$GET(DUZ(2))))
+7 QUIT
End DoDot:1
QUIT
+8 SET RES=TRACKID
+9 QUIT
