MAGSIXG3 ;WOIFO/SG/NST/DAC - LIST OF IMAGES RPCS (CALLBACK) ; Aug 20, 2020@06:55:25
;;3.0;IMAGING;**93,117,150,138,167,221,258**;Mar 19, 2002;Build 21
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; This routine uses the following ICRs:
;
; #3268 Read file #8925 (controlled)
; #10060 Read file #200 (supported)
; #2321 Read file #8925.1 (controlled)
; #2937 Read file #8925 (controlled)
;
; LOCAL VARIABLE ------ DESCRIPTION
;
; MAGDATA See the ^MAGSIXG4.
;
; TEMPORARY GLOBAL ---- DESCRIPTION
;
; ^TMP("MAGSIXG3",$J) See the ^MAGSIXG4.
;
Q
;
;+++++ APPENDS THE IMAGE ENTRY TO THE RPC RESULT ARRAY
;
; IMGIEN IEN of the image record in file #2005 or #2005.1
;
; DATA First half ("|"-piece) of the result item
;
; GRPCNTS Group counts (result of the $$GRPCT^MAGGI14)
;
; FLAGS Control flags for the $$INFO^MAGGAII
;
; Input Variables
; ===============
; MAGDATA
;
; Output Variables
; ================
; MAGDATA, MAGOUT
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Success
;
APPEND(IMGIEN,DATA,GRPCNTS,FLAGS) ;
N IMGINFO,X
;
;--- Get the internal image data
S IMGINFO=$$INFO^MAGGAII(IMGIEN,FLAGS,GRPCNTS)
Q:IMGINFO<0 IMGINFO
S $P(DATA,U,2)=$P(IMGINFO,U,16) ; Site Code
S $P(DATA,U,6)=$P(IMGINFO,U,14) ; Number of images in the group
S $P(DATA,U,16)=$P(IMGINFO,U) ; Image ID (IEN)
;
;--- Append the image data to the result array
S MAGDATA("RESCNT")=$G(MAGDATA("RESCNT"))+1
S $P(DATA,U)=MAGDATA("RESCNT")
S @MAGDATA@(MAGDATA("RESCNT")+1)=DATA_U_"|"_IMGINFO
Q:MAGDATA("RESCNT")<76 0 Q:MAGDATA["^" 0
;
;--- Image count is getting big, switch from
;--- a local array to a global node
S MAGDATA=$NA(^TMP("MAGSIXG1",$J))
K @MAGDATA M @MAGDATA=MAGOUT
S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
K MAGOUT S MAGOUT=MAGDATA
Q 0
;
;+++++ PERFORMS SPECIAL CONVERSION OF THE DATE/TIME
DTE(DTI) ;
N X S X=$$FMTE^XLFDT(DTI,"5Z")
Q $P(X,"@")_" "_$S($P(X,"@",2)'="":$P(X,"@",2),1:"00:01")
;
;+++++ CALLBACK FUNCTION FOR IMAGE QUERY
;
; IMGIEN IEN of the image record (file #2005 or #2005.1)
;
; FLAGS Parameters passed into the image query API
; .MAGDATA ($$QUERY^MAGGI13). See the GETIMGS^MAGSIXG1
; for details.
;
; Input Variables
; ===============
; MAGJOB, MAGOUT
;
; Output Variables
; ================
; MAGJOB, MAGOUT, ^TMP("MAGSIXG3",$J,...)
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Continue
; >0 Terminate the query
;
QRYCBK(IMGIEN,FLAGS,MAGDATA) ;
N FLTX,IIFLAGS,GRPCNTS,PTIEN,RC
;
S RC=$$FILTER(.FLTX,.GRPCNTS,.PTIEN,IMGIEN,FLAGS,.MAGDATA) ; Apply filter
Q:'RC 0 ; Filter is not matched
;
Q:RC=2 1 ; Terminate the query when maximum number of records is reached
;
;=== Flags for $$INFO^MAGGAII
S IIFLAGS=$$TRFLAGS^MAGUTL05(FLAGS,"DE")
;
;=== Sparse subset query does not append image entries to the result
; array right away. It saves them to the temporary buffers in the
; ^TMP("MAGSIXG3",$J) global node instead. After all images are
; preselected, the $$SUBSET^MAGSIXG4 processes those buffers and
;=== appends required number of image entries to the result array.
I MAGDATA("FLAGS")["S" S RC=0 D Q $S(RC<0:RC,1:0)
. N I,TCNT,X
. S (MAGDATA("TCNT"),TCNT)=$G(MAGDATA("TCNT"))+1
. ;--- If the image is associated with the same patient as the
. ;--- previous one, save it in the regular temporary buffer.
. I PTIEN=$G(MAGDATA("PREVPT")) D Q
. . S I=$O(^TMP("MAGSIXG3",$J,"R",""),-1)+1
. . S ^TMP("MAGSIXG3",$J,"R",I)=TCNT_"|"_IMGIEN_"|"_GRPCNTS
. . S ^TMP("MAGSIXG3",$J,"R",I,0)=FLTX
. . Q
. ;--- If the image is associated with a different patient, remember
. ;--- the new DFN and store the image into the "priority" buffer.
. S MAGDATA("PREVPT")=PTIEN
. S ^TMP("MAGSIXG3",$J,"P",TCNT)=TCNT_"|"_IMGIEN_"|"_GRPCNTS
. S ^TMP("MAGSIXG3",$J,"P",TCNT,0)=FLTX
. ;--- If the image that precedes the patient change is not in the
. ;--- "priority" buffer yet, move it there from the regular buffer.
. S X=TCNT-1 Q:$D(^TMP("MAGSIXG3",$J,"P",X))
. S I=$O(^TMP("MAGSIXG3",$J,"R",""),-1) Q:I=""
. I $P(^TMP("MAGSIXG3",$J,"R",I),"|")'=X D Q
. . S RC=$$ERROR^MAGUERR(-47) ; This should never happen!
. . Q
. M ^TMP("MAGSIXG3",$J,"P",X)=^TMP("MAGSIXG3",$J,"R",I)
. K ^TMP("MAGSIXG3",$J,"R",I)
. Q
;
;=== Append the image item to the result array
S RC=$$APPEND(IMGIEN,FLTX,GRPCNTS,IIFLAGS) Q:RC<0 RC
;
;=== Success
Q 0
;
;+++++ RETURNS THE NOTE TITLE
RPTITLE(FILE,IEN) ;
N TITLE,TMP
I FILE=8925,IEN>0 D S TITLE=$P($G(^TIU(8925.1,TMP,0)),U) ; IA #2321
. S TMP=+$P($G(^TIU(8925,+IEN,0)),U) ; IA #2937
. Q
Q $S($G(TITLE)'="":TITLE,1:" ")
;
MODALITY(IMGIEN) ; Get Image modality
N G,M,P,MAGFILD,MAGFILG,X
S MAGFILD=$$FILE^MAGGI11(IMGIEN)
S X=$S(MAGFILD:$G(^MAG(MAGFILD,IMGIEN,0)),1:"")
S G=+$P(X,"^",10) ;Group IEN
S M=$P(X,"^",8) ;Procedure
S:$E(M,1,4)="RAD " M=$E(M,5,$L(M))
Q:M="" ""
S MAGFILG=$$FILE^MAGGI11(G)
S G=$S(MAGFILG:$P($G(^MAG(MAGFILG,G,2)),"^",6),1:"") ;Parent Data File# for Group IEN
S P=$S(MAGFILD:$P($G(^MAG(MAGFILD,IMGIEN,2)),"^",6),1:"") ;Parent Data File# for IEN
I P'=74,G'=74 Q "" ;quit if not RAD/NUC MED REPORTS file (#74)
Q M
;
; Filter image based on filter data
FILTER(FLTX,GRPCNTS,PTIEN,IMGIEN,FLAGS,MAGDATA) ;
N CAPTAPP,CLASS,EVT,GROUP,IMGNODE
N ORIG,PKG,SENSIMG,SKIP,SPEC,STATUS,TYPE
N CPTCODE,MODALITY
N X,X0,X01,X100,X2,X40
N MAGFOUND ; temp loop flag
S FLTX=""
S IMGNODE=$$NODE^MAGGI11(IMGIEN) Q:IMGNODE="" 0
;=== Terminate the query when maximum number of records is reached
I MAGDATA("MAXNUM"),MAGDATA("RESCNT")'<MAGDATA("MAXNUM") Q 2
;
;=== Skip, if a group member
S X0=$G(@IMGNODE@(0))
Q:$P(X0,U,10) 0 ; GROUP PARENT (14)
;
;=== Check who captured the image
S X2=$G(@IMGNODE@(2)),X=+$G(MAGDATA("SAVEDBY"))
I X Q:$P(X2,U,2)'=X 0 ; IMAGE SAVE BY (8)
;
;=== Perform additional screening according to the image counts
S GRPCNTS=$$GRPCT^MAGGI14(IMGIEN)
S:GRPCNTS<0 GRPCNTS="" ;??? Ignore errors
S GROUP=$$ISGRP^MAGGI11(IMGIEN)
S SKIP=0 D Q:SKIP 0
. ;--- Check if the image entry references "child" images of
. ; requested kind(s). Also, safeguard against a wrong object
. ;--- type in the group header.
. I $P(GRPCNTS,U,1)>0 S GROUP=1 Q:FLAGS["E" ; Existing "children"
. I $P(GRPCNTS,U,2)>0 S GROUP=1 Q:FLAGS["D" ; Deleted "children"
. ;--- Skip group headers that do not reference
. ;--- any "child" images of requested kind(s)
. I GROUP S SKIP=1 Q
. ;--- If existing images are not requested, then
. ;--- skip existing standalone image entries
. I FLAGS'["E",'$$ISDEL^MAGGI11(IMGIEN) S SKIP=1 Q
. Q
;
;=== Load other data associated with the image
S X40=$G(@IMGNODE@(40)),X100=$G(@IMGNODE@(100))
S PTIEN=+$P(X0,U,7) ; PATIENT (5)
S PKG=$P(X40,U) ; PACKAGE INDEX (40)
S TYPE=$P(X40,U,3) ; TYPE INDEX (42)
S EVT=$P(X40,U,4) ; PROC/EVENT INDEX (43)
S SPEC=$P(X40,U,5) ; SPEC/SUBSPEC INDEX (44)
S ORIG=$P(X40,U,6) ; ORIGIN INDEX (45)
S:ORIG="" ORIG="V" ; Show VA by default
S SENSIMG=+$P(X100,U,7) ; CONTROLLED IMAGE (112)
S STATUS=$P(X100,U,8) ; STATUS(113)
S CAPTAPP=$P(X2,U,12) ; CAPTURE APPLICATION (8.1)
S CPTCODE=$$CPTCODE^MAGDQR21(IMGIEN) ; CPT CODE
S MODALITY=$$MODALITY(IMGIEN) ; Get Modality
;
; 150 T2 - if Group and Deleted and only 1 child: get Status of child.
I GROUP,$$ISDEL^MAGGI11(IMGIEN),$P(GRPCNTS,U,2)=1 D ;
. S X=$O(^MAG(2005.1,"AGP",IMGIEN,""))
. I 'X Q
. S X=$P($G(^MAG(2005.1,X,100)),"^",8)
. I X S STATUS=X
. Q
;=== Patch 150- Status 13 is a Non Existant Image. Don't include in Image List.
I STATUS=13 Q 0 ;P150
;=== Patch 59. Treat Class as a computed field.
;=== Arrange with Mike to change DB.
S CLASS=$S(TYPE:$P($G(^MAG(2005.83,+TYPE,0)),U,2),1:"")
I $D(MAGDATA("PKG")),PKG'="" Q:'$D(MAGDATA("PKG",PKG)) 0
I $D(MAGDATA("ORIG")),ORIG'="" Q:'$D(MAGDATA("ORIG",ORIG)) 0
I $D(MAGDATA("CLS")),CLASS'="" Q:'$D(MAGDATA("CLS",CLASS)) 0
; P258 DAC - Modified to exclude null types when doing a search with type parameters
I $D(MAGDATA("TYPE")) Q:TYPE="" 0
I $D(MAGDATA("TYPE")) Q:'$D(MAGDATA("TYPE",TYPE)) 0
I $D(MAGDATA("CPTCODE")),CPTCODE="" Q 0
I $D(MAGDATA("MODALITY")),MODALITY="" Q 0
I $D(MAGDATA("CPTCODE")),CPTCODE'="" Q:'$D(MAGDATA("CPTCODE",CPTCODE)) 0
I $D(MAGDATA("MODALITY")),MODALITY'="" Q:'$D(MAGDATA("MODALITY",MODALITY)) 0
;
I '(FLAGS["G") D Q:'MAGFOUND 0 ; doesn't meet the criteria. One strike and you have to quit
. S MAGFOUND=1
. I $D(MAGDATA("ISTAT")),'$D(MAGDATA("ISTAT",+STATUS)) S MAGFOUND=0 Q
. Q
;
I FLAGS["G" D Q:'MAGFOUND 0 ; Quit. It doesn't meet the criteria
. S MAGFOUND=0
. I '$D(MAGDATA("ISTAT")) S MAGFOUND=1 Q ;nothing to check. It means it is found
. ; Check for single images first
. I 'GROUP D Q
. . I $D(MAGDATA("ISTAT",+STATUS)) S MAGFOUND=1 ; need this image
. . Q
. ;-- check all children in the group
. N CHI,CHIEN,CHNODE,CH100,CHSTATUS
. S CHI=0
. F S CHI=$O(@IMGNODE@(1,CHI)) Q:CHI'>0 D Q:MAGFOUND
. . S CHIEN=+$G(@IMGNODE@(1,CHI,0))
. . Q:CHIEN'>0
. . S CHNODE=$$NODE^MAGGI11(CHIEN) Q:CHNODE=""
. . S CH100=$G(@CHNODE@(100))
. . S CHSTATUS=$P(CH100,U,8) ; STATUS(113)
. . I $D(MAGDATA("ISTAT",+CHSTATUS)) S MAGFOUND=1
. . Q
. Q
;
;=== Skip list entries with no event if event is in
;=== the selection criteria (MAG*3*8)
I $D(MAGDATA("EVT")) Q:EVT="" 0 Q:'$D(MAGDATA("EVT",EVT)) 0
;
;=== Skip list entries with no specialty if specialty is in
;=== the selection criteria (MAG*3*8)
I $D(MAGDATA("SPEC")) Q:SPEC="" 0 Q:'$D(MAGDATA("SPEC",SPEC)) 0
;
;=== Skip list entries with no capture application if
;=== application is in the selection criteria
I $D(MAGDATA("CAPTAPP")) Q:CAPTAPP="" 0 Q:'$D(MAGDATA("CAPTAPP",CAPTAPP)) 0
;
;=== Check the short description
I $D(MAGDATA("GDESC")) Q:$$UP^XLFSTR($P(X2,U,4))'[MAGDATA("GDESC") 0
;
;=== Build the result item
S $P(FLTX,U,3)=$$RPTITLE($P(X2,U,6),$P(X2,U,7)) ; Report title
S $P(FLTX,U,4)=$$DTE($P(X2,U,5)) ; Procedure date
S $P(FLTX,U,5)=$P(X0,U,8) ; Procedure
S $P(FLTX,U,7)=$P(X2,U,4) ; Short descr.
S $P(FLTX,U,8)=PKG ; Package
S $P(FLTX,U,9)=$P($G(^MAG(2005.82,+CLASS,0)),U) ; Class
S $P(FLTX,U,10)=$P($G(^MAG(2005.83,+TYPE,0)),U) ; Type
S $P(FLTX,U,11)=$P($G(^MAG(2005.84,+SPEC,0)),U) ; (Sub)Specialty
S $P(FLTX,U,12)=$P($G(^MAG(2005.85,+EVT,0)),U) ; Proc/Event
S $P(FLTX,U,13)=$$EXTERNAL^DILFD(2005,45,,ORIG) ; Origin
S $P(FLTX,U,14)=$$DTE($P(X2,U)) ; Capture date
S $P(FLTX,U,15)=$$GET1^DIQ(200,+$P(X2,U,2)_",",.01) ; Captured by
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGSIXG3 12160 printed Apr 09, 2024@21:00:46 Page 2
MAGSIXG3 ;WOIFO/SG/NST/DAC - LIST OF IMAGES RPCS (CALLBACK) ; Aug 20, 2020@06:55:25
+1 ;;3.0;IMAGING;**93,117,150,138,167,221,258**;Mar 19, 2002;Build 21
+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 ; This routine uses the following ICRs:
+19 ;
+20 ; #3268 Read file #8925 (controlled)
+21 ; #10060 Read file #200 (supported)
+22 ; #2321 Read file #8925.1 (controlled)
+23 ; #2937 Read file #8925 (controlled)
+24 ;
+25 ; LOCAL VARIABLE ------ DESCRIPTION
+26 ;
+27 ; MAGDATA See the ^MAGSIXG4.
+28 ;
+29 ; TEMPORARY GLOBAL ---- DESCRIPTION
+30 ;
+31 ; ^TMP("MAGSIXG3",$J) See the ^MAGSIXG4.
+32 ;
+33 QUIT
+34 ;
+35 ;+++++ APPENDS THE IMAGE ENTRY TO THE RPC RESULT ARRAY
+36 ;
+37 ; IMGIEN IEN of the image record in file #2005 or #2005.1
+38 ;
+39 ; DATA First half ("|"-piece) of the result item
+40 ;
+41 ; GRPCNTS Group counts (result of the $$GRPCT^MAGGI14)
+42 ;
+43 ; FLAGS Control flags for the $$INFO^MAGGAII
+44 ;
+45 ; Input Variables
+46 ; ===============
+47 ; MAGDATA
+48 ;
+49 ; Output Variables
+50 ; ================
+51 ; MAGDATA, MAGOUT
+52 ;
+53 ; Return Values
+54 ; =============
+55 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+56 ; 0 Success
+57 ;
APPEND(IMGIEN,DATA,GRPCNTS,FLAGS) ;
+1 NEW IMGINFO,X
+2 ;
+3 ;--- Get the internal image data
+4 SET IMGINFO=$$INFO^MAGGAII(IMGIEN,FLAGS,GRPCNTS)
+5 if IMGINFO<0
QUIT IMGINFO
+6 ; Site Code
SET $PIECE(DATA,U,2)=$PIECE(IMGINFO,U,16)
+7 ; Number of images in the group
SET $PIECE(DATA,U,6)=$PIECE(IMGINFO,U,14)
+8 ; Image ID (IEN)
SET $PIECE(DATA,U,16)=$PIECE(IMGINFO,U)
+9 ;
+10 ;--- Append the image data to the result array
+11 SET MAGDATA("RESCNT")=$GET(MAGDATA("RESCNT"))+1
+12 SET $PIECE(DATA,U)=MAGDATA("RESCNT")
+13 SET @MAGDATA@(MAGDATA("RESCNT")+1)=DATA_U_"|"_IMGINFO
+14 if MAGDATA("RESCNT")<76
QUIT 0
if MAGDATA["^"
QUIT 0
+15 ;
+16 ;--- Image count is getting big, switch from
+17 ;--- a local array to a global node
+18 SET MAGDATA=$NAME(^TMP("MAGSIXG1",$JOB))
+19 KILL @MAGDATA
MERGE @MAGDATA=MAGOUT
+20 SET X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
+21 KILL MAGOUT
SET MAGOUT=MAGDATA
+22 QUIT 0
+23 ;
+24 ;+++++ PERFORMS SPECIAL CONVERSION OF THE DATE/TIME
DTE(DTI) ;
+1 NEW X
SET X=$$FMTE^XLFDT(DTI,"5Z")
+2 QUIT $PIECE(X,"@")_" "_$SELECT($PIECE(X,"@",2)'="":$PIECE(X,"@",2),1:"00:01")
+3 ;
+4 ;+++++ CALLBACK FUNCTION FOR IMAGE QUERY
+5 ;
+6 ; IMGIEN IEN of the image record (file #2005 or #2005.1)
+7 ;
+8 ; FLAGS Parameters passed into the image query API
+9 ; .MAGDATA ($$QUERY^MAGGI13). See the GETIMGS^MAGSIXG1
+10 ; for details.
+11 ;
+12 ; Input Variables
+13 ; ===============
+14 ; MAGJOB, MAGOUT
+15 ;
+16 ; Output Variables
+17 ; ================
+18 ; MAGJOB, MAGOUT, ^TMP("MAGSIXG3",$J,...)
+19 ;
+20 ; Return Values
+21 ; =============
+22 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+23 ; 0 Continue
+24 ; >0 Terminate the query
+25 ;
QRYCBK(IMGIEN,FLAGS,MAGDATA) ;
+1 NEW FLTX,IIFLAGS,GRPCNTS,PTIEN,RC
+2 ;
+3 ; Apply filter
SET RC=$$FILTER(.FLTX,.GRPCNTS,.PTIEN,IMGIEN,FLAGS,.MAGDATA)
+4 ; Filter is not matched
if 'RC
QUIT 0
+5 ;
+6 ; Terminate the query when maximum number of records is reached
if RC=2
QUIT 1
+7 ;
+8 ;=== Flags for $$INFO^MAGGAII
+9 SET IIFLAGS=$$TRFLAGS^MAGUTL05(FLAGS,"DE")
+10 ;
+11 ;=== Sparse subset query does not append image entries to the result
+12 ; array right away. It saves them to the temporary buffers in the
+13 ; ^TMP("MAGSIXG3",$J) global node instead. After all images are
+14 ; preselected, the $$SUBSET^MAGSIXG4 processes those buffers and
+15 ;=== appends required number of image entries to the result array.
+16 IF MAGDATA("FLAGS")["S"
SET RC=0
Begin DoDot:1
+17 NEW I,TCNT,X
+18 SET (MAGDATA("TCNT"),TCNT)=$GET(MAGDATA("TCNT"))+1
+19 ;--- If the image is associated with the same patient as the
+20 ;--- previous one, save it in the regular temporary buffer.
+21 IF PTIEN=$GET(MAGDATA("PREVPT"))
Begin DoDot:2
+22 SET I=$ORDER(^TMP("MAGSIXG3",$JOB,"R",""),-1)+1
+23 SET ^TMP("MAGSIXG3",$JOB,"R",I)=TCNT_"|"_IMGIEN_"|"_GRPCNTS
+24 SET ^TMP("MAGSIXG3",$JOB,"R",I,0)=FLTX
+25 QUIT
End DoDot:2
QUIT
+26 ;--- If the image is associated with a different patient, remember
+27 ;--- the new DFN and store the image into the "priority" buffer.
+28 SET MAGDATA("PREVPT")=PTIEN
+29 SET ^TMP("MAGSIXG3",$JOB,"P",TCNT)=TCNT_"|"_IMGIEN_"|"_GRPCNTS
+30 SET ^TMP("MAGSIXG3",$JOB,"P",TCNT,0)=FLTX
+31 ;--- If the image that precedes the patient change is not in the
+32 ;--- "priority" buffer yet, move it there from the regular buffer.
+33 SET X=TCNT-1
if $DATA(^TMP("MAGSIXG3",$JOB,"P",X))
QUIT
+34 SET I=$ORDER(^TMP("MAGSIXG3",$JOB,"R",""),-1)
if I=""
QUIT
+35 IF $PIECE(^TMP("MAGSIXG3",$JOB,"R",I),"|")'=X
Begin DoDot:2
+36 ; This should never happen!
SET RC=$$ERROR^MAGUERR(-47)
+37 QUIT
End DoDot:2
QUIT
+38 MERGE ^TMP("MAGSIXG3",$JOB,"P",X)=^TMP("MAGSIXG3",$JOB,"R",I)
+39 KILL ^TMP("MAGSIXG3",$JOB,"R",I)
+40 QUIT
End DoDot:1
QUIT $SELECT(RC<0:RC,1:0)
+41 ;
+42 ;=== Append the image item to the result array
+43 SET RC=$$APPEND(IMGIEN,FLTX,GRPCNTS,IIFLAGS)
if RC<0
QUIT RC
+44 ;
+45 ;=== Success
+46 QUIT 0
+47 ;
+48 ;+++++ RETURNS THE NOTE TITLE
RPTITLE(FILE,IEN) ;
+1 NEW TITLE,TMP
+2 ; IA #2321
IF FILE=8925
IF IEN>0
Begin DoDot:1
+3 ; IA #2937
SET TMP=+$PIECE($GET(^TIU(8925,+IEN,0)),U)
+4 QUIT
End DoDot:1
SET TITLE=$PIECE($GET(^TIU(8925.1,TMP,0)),U)
+5 QUIT $SELECT($GET(TITLE)'="":TITLE,1:" ")
+6 ;
MODALITY(IMGIEN) ; Get Image modality
+1 NEW G,M,P,MAGFILD,MAGFILG,X
+2 SET MAGFILD=$$FILE^MAGGI11(IMGIEN)
+3 SET X=$SELECT(MAGFILD:$GET(^MAG(MAGFILD,IMGIEN,0)),1:"")
+4 ;Group IEN
SET G=+$PIECE(X,"^",10)
+5 ;Procedure
SET M=$PIECE(X,"^",8)
+6 if $EXTRACT(M,1,4)="RAD "
SET M=$EXTRACT(M,5,$LENGTH(M))
+7 if M=""
QUIT ""
+8 SET MAGFILG=$$FILE^MAGGI11(G)
+9 ;Parent Data File# for Group IEN
SET G=$SELECT(MAGFILG:$PIECE($GET(^MAG(MAGFILG,G,2)),"^",6),1:"")
+10 ;Parent Data File# for IEN
SET P=$SELECT(MAGFILD:$PIECE($GET(^MAG(MAGFILD,IMGIEN,2)),"^",6),1:"")
+11 ;quit if not RAD/NUC MED REPORTS file (#74)
IF P'=74
IF G'=74
QUIT ""
+12 QUIT M
+13 ;
+14 ; Filter image based on filter data
FILTER(FLTX,GRPCNTS,PTIEN,IMGIEN,FLAGS,MAGDATA) ;
+1 NEW CAPTAPP,CLASS,EVT,GROUP,IMGNODE
+2 NEW ORIG,PKG,SENSIMG,SKIP,SPEC,STATUS,TYPE
+3 NEW CPTCODE,MODALITY
+4 NEW X,X0,X01,X100,X2,X40
+5 ; temp loop flag
NEW MAGFOUND
+6 SET FLTX=""
+7 SET IMGNODE=$$NODE^MAGGI11(IMGIEN)
if IMGNODE=""
QUIT 0
+8 ;=== Terminate the query when maximum number of records is reached
+9 IF MAGDATA("MAXNUM")
IF MAGDATA("RESCNT")'<MAGDATA("MAXNUM")
QUIT 2
+10 ;
+11 ;=== Skip, if a group member
+12 SET X0=$GET(@IMGNODE@(0))
+13 ; GROUP PARENT (14)
if $PIECE(X0,U,10)
QUIT 0
+14 ;
+15 ;=== Check who captured the image
+16 SET X2=$GET(@IMGNODE@(2))
SET X=+$GET(MAGDATA("SAVEDBY"))
+17 ; IMAGE SAVE BY (8)
IF X
if $PIECE(X2,U,2)'=X
QUIT 0
+18 ;
+19 ;=== Perform additional screening according to the image counts
+20 SET GRPCNTS=$$GRPCT^MAGGI14(IMGIEN)
+21 ;??? Ignore errors
if GRPCNTS<0
SET GRPCNTS=""
+22 SET GROUP=$$ISGRP^MAGGI11(IMGIEN)
+23 SET SKIP=0
Begin DoDot:1
+24 ;--- Check if the image entry references "child" images of
+25 ; requested kind(s). Also, safeguard against a wrong object
+26 ;--- type in the group header.
+27 ; Existing "children"
IF $PIECE(GRPCNTS,U,1)>0
SET GROUP=1
if FLAGS["E"
QUIT
+28 ; Deleted "children"
IF $PIECE(GRPCNTS,U,2)>0
SET GROUP=1
if FLAGS["D"
QUIT
+29 ;--- Skip group headers that do not reference
+30 ;--- any "child" images of requested kind(s)
+31 IF GROUP
SET SKIP=1
QUIT
+32 ;--- If existing images are not requested, then
+33 ;--- skip existing standalone image entries
+34 IF FLAGS'["E"
IF '$$ISDEL^MAGGI11(IMGIEN)
SET SKIP=1
QUIT
+35 QUIT
End DoDot:1
if SKIP
QUIT 0
+36 ;
+37 ;=== Load other data associated with the image
+38 SET X40=$GET(@IMGNODE@(40))
SET X100=$GET(@IMGNODE@(100))
+39 ; PATIENT (5)
SET PTIEN=+$PIECE(X0,U,7)
+40 ; PACKAGE INDEX (40)
SET PKG=$PIECE(X40,U)
+41 ; TYPE INDEX (42)
SET TYPE=$PIECE(X40,U,3)
+42 ; PROC/EVENT INDEX (43)
SET EVT=$PIECE(X40,U,4)
+43 ; SPEC/SUBSPEC INDEX (44)
SET SPEC=$PIECE(X40,U,5)
+44 ; ORIGIN INDEX (45)
SET ORIG=$PIECE(X40,U,6)
+45 ; Show VA by default
if ORIG=""
SET ORIG="V"
+46 ; CONTROLLED IMAGE (112)
SET SENSIMG=+$PIECE(X100,U,7)
+47 ; STATUS(113)
SET STATUS=$PIECE(X100,U,8)
+48 ; CAPTURE APPLICATION (8.1)
SET CAPTAPP=$PIECE(X2,U,12)
+49 ; CPT CODE
SET CPTCODE=$$CPTCODE^MAGDQR21(IMGIEN)
+50 ; Get Modality
SET MODALITY=$$MODALITY(IMGIEN)
+51 ;
+52 ; 150 T2 - if Group and Deleted and only 1 child: get Status of child.
+53 ;
IF GROUP
IF $$ISDEL^MAGGI11(IMGIEN)
IF $PIECE(GRPCNTS,U,2)=1
Begin DoDot:1
+54 SET X=$ORDER(^MAG(2005.1,"AGP",IMGIEN,""))
+55 IF 'X
QUIT
+56 SET X=$PIECE($GET(^MAG(2005.1,X,100)),"^",8)
+57 IF X
SET STATUS=X
+58 QUIT
End DoDot:1
+59 ;=== Patch 150- Status 13 is a Non Existant Image. Don't include in Image List.
+60 ;P150
IF STATUS=13
QUIT 0
+61 ;=== Patch 59. Treat Class as a computed field.
+62 ;=== Arrange with Mike to change DB.
+63 SET CLASS=$SELECT(TYPE:$PIECE($GET(^MAG(2005.83,+TYPE,0)),U,2),1:"")
+64 IF $DATA(MAGDATA("PKG"))
IF PKG'=""
if '$DATA(MAGDATA("PKG",PKG))
QUIT 0
+65 IF $DATA(MAGDATA("ORIG"))
IF ORIG'=""
if '$DATA(MAGDATA("ORIG",ORIG))
QUIT 0
+66 IF $DATA(MAGDATA("CLS"))
IF CLASS'=""
if '$DATA(MAGDATA("CLS",CLASS))
QUIT 0
+67 ; P258 DAC - Modified to exclude null types when doing a search with type parameters
+68 IF $DATA(MAGDATA("TYPE"))
if TYPE=""
QUIT 0
+69 IF $DATA(MAGDATA("TYPE"))
if '$DATA(MAGDATA("TYPE",TYPE))
QUIT 0
+70 IF $DATA(MAGDATA("CPTCODE"))
IF CPTCODE=""
QUIT 0
+71 IF $DATA(MAGDATA("MODALITY"))
IF MODALITY=""
QUIT 0
+72 IF $DATA(MAGDATA("CPTCODE"))
IF CPTCODE'=""
if '$DATA(MAGDATA("CPTCODE",CPTCODE))
QUIT 0
+73 IF $DATA(MAGDATA("MODALITY"))
IF MODALITY'=""
if '$DATA(MAGDATA("MODALITY",MODALITY))
QUIT 0
+74 ;
+75 ; doesn't meet the criteria. One strike and you have to quit
IF '(FLAGS["G")
Begin DoDot:1
+76 SET MAGFOUND=1
+77 IF $DATA(MAGDATA("ISTAT"))
IF '$DATA(MAGDATA("ISTAT",+STATUS))
SET MAGFOUND=0
QUIT
+78 QUIT
End DoDot:1
if 'MAGFOUND
QUIT 0
+79 ;
+80 ; Quit. It doesn't meet the criteria
IF FLAGS["G"
Begin DoDot:1
+81 SET MAGFOUND=0
+82 ;nothing to check. It means it is found
IF '$DATA(MAGDATA("ISTAT"))
SET MAGFOUND=1
QUIT
+83 ; Check for single images first
+84 IF 'GROUP
Begin DoDot:2
+85 ; need this image
IF $DATA(MAGDATA("ISTAT",+STATUS))
SET MAGFOUND=1
+86 QUIT
End DoDot:2
QUIT
+87 ;-- check all children in the group
+88 NEW CHI,CHIEN,CHNODE,CH100,CHSTATUS
+89 SET CHI=0
+90 FOR
SET CHI=$ORDER(@IMGNODE@(1,CHI))
if CHI'>0
QUIT
Begin DoDot:2
+91 SET CHIEN=+$GET(@IMGNODE@(1,CHI,0))
+92 if CHIEN'>0
QUIT
+93 SET CHNODE=$$NODE^MAGGI11(CHIEN)
if CHNODE=""
QUIT
+94 SET CH100=$GET(@CHNODE@(100))
+95 ; STATUS(113)
SET CHSTATUS=$PIECE(CH100,U,8)
+96 IF $DATA(MAGDATA("ISTAT",+CHSTATUS))
SET MAGFOUND=1
+97 QUIT
End DoDot:2
if MAGFOUND
QUIT
+98 QUIT
End DoDot:1
if 'MAGFOUND
QUIT 0
+99 ;
+100 ;=== Skip list entries with no event if event is in
+101 ;=== the selection criteria (MAG*3*8)
+102 IF $DATA(MAGDATA("EVT"))
if EVT=""
QUIT 0
if '$DATA(MAGDATA("EVT",EVT))
QUIT 0
+103 ;
+104 ;=== Skip list entries with no specialty if specialty is in
+105 ;=== the selection criteria (MAG*3*8)
+106 IF $DATA(MAGDATA("SPEC"))
if SPEC=""
QUIT 0
if '$DATA(MAGDATA("SPEC",SPEC))
QUIT 0
+107 ;
+108 ;=== Skip list entries with no capture application if
+109 ;=== application is in the selection criteria
+110 IF $DATA(MAGDATA("CAPTAPP"))
if CAPTAPP=""
QUIT 0
if '$DATA(MAGDATA("CAPTAPP",CAPTAPP))
QUIT 0
+111 ;
+112 ;=== Check the short description
+113 IF $DATA(MAGDATA("GDESC"))
if $$UP^XLFSTR($PIECE(X2,U,4))'[MAGDATA("GDESC")
QUIT 0
+114 ;
+115 ;=== Build the result item
+116 ; Report title
SET $PIECE(FLTX,U,3)=$$RPTITLE($PIECE(X2,U,6),$PIECE(X2,U,7))
+117 ; Procedure date
SET $PIECE(FLTX,U,4)=$$DTE($PIECE(X2,U,5))
+118 ; Procedure
SET $PIECE(FLTX,U,5)=$PIECE(X0,U,8)
+119 ; Short descr.
SET $PIECE(FLTX,U,7)=$PIECE(X2,U,4)
+120 ; Package
SET $PIECE(FLTX,U,8)=PKG
+121 ; Class
SET $PIECE(FLTX,U,9)=$PIECE($GET(^MAG(2005.82,+CLASS,0)),U)
+122 ; Type
SET $PIECE(FLTX,U,10)=$PIECE($GET(^MAG(2005.83,+TYPE,0)),U)
+123 ; (Sub)Specialty
SET $PIECE(FLTX,U,11)=$PIECE($GET(^MAG(2005.84,+SPEC,0)),U)
+124 ; Proc/Event
SET $PIECE(FLTX,U,12)=$PIECE($GET(^MAG(2005.85,+EVT,0)),U)
+125 ; Origin
SET $PIECE(FLTX,U,13)=$$EXTERNAL^DILFD(2005,45,,ORIG)
+126 ; Capture date
SET $PIECE(FLTX,U,14)=$$DTE($PIECE(X2,U))
+127 ; Captured by
SET $PIECE(FLTX,U,15)=$$GET1^DIQ(200,+$PIECE(X2,U,2)_",",.01)
+128 QUIT 1
