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  Sep 23, 2025@19:44:02                                                                                                                                                                                                     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