MAGJEX2 ;WIRMFO/JHC,NST - Rad. Workstation RPC calls ; 10/17/2022
;;3.0;IMAGING;**51,18,76,120,201,341**;Dec 21, 2022;Build 28
;; 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. |
;; +---------------------------------------------------------------+
;;
;; ISI IMAGING;**99,106**
Q
; Subroutines for pre-fetch/ auto-route prior exams' images
; Entry Points:
; PRIOR1 -- Pre-Fetch/Auto-route images for other related cases;
; RPC Call: MAGJ PRIOREXAMS
; PREFETCH -- Subroutine call via Protocol trigger
;
Q
ERR N ERR S ERR=$$EC^%ZOSV S MAGGRY(0)="0^Server Program Error: "_ERR
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
PREFETCH ; Entry point from HL7 processing, to initiate prefetch at
; time of radiology "Register Patient for Exam" function
; Do not process if the exam is being Canceled (RACANC true)
;
N RET S RET=""
I '$P($G(^MAG(2006.69,1,0)),U,5) G PREFQ ; Prefetch disabled
I '($G(RADFN)&$G(RADTI)&$G(RACNI)&'$G(RACANC)) G PREFQ ; Required vars
D PRIOR1(.RET,"P"_U_RADFN_U_RADTI_U_RACNI)
PREFQ ;
Q
;
PRIOR1(MAGGRY,DATA) ; review all exams for a patient to find "related" exams
; This ep also called as subroutine from routing software (P51)
; MAGGRY - return array of exams to PreFetch or Auto-route
; DATA: - input params for the Current Exam
; 1) ACTION = P -- Pre-fetch Exams (from Jukebox to Magnetic Disk)
; = A -- Auto-route priors
; = C -- Pre-cache exams
; 2) RADFN = Case pointers to Rad/Nuc Med Patient file
; 3) RADTI = "" "" "" ""
; 4) RACNI = "" "" "" ""
; 5) RARPT - Case pointer to ^RARPT global
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX2"
K MAGGRY
N RADFN,RADTI,RACNI,RARPT,RADATA,RADATA2 ; ISI P106
N DAYCASE,DIQUIET,ACTION,CPT,HDR,MAGDFN,MAGDTI,MAGCNI,MAGRET,MAGRACNT
S ACTION=$P(DATA,U)
I ACTION="P"!(ACTION="A")!(ACTION="C")!(ACTION="ISIP") ; ISI new prefetch action ISIP
E S MAGGRY(0)="0^Invalid Request (Action code="_ACTION_")" G PRIOR1Z
S MAGDFN=$P(DATA,U,2),MAGDTI=$P(DATA,U,3),MAGCNI=$P(DATA,U,4)
I MAGDFN,MAGDTI,MAGCNI
E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_DATA_")" G PRIOR1Z
S DIQUIET=1 D DT^DICRW
N MAGJOB D MAGJOBNC^MAGJUTL3
S HDR=$S(ACTION="P":"Pre-fetch",ACTION="A":"Auto-route",ACTION="C":"Pre-cache",1:"???")_" Prior Exams for CASE: "
I '$D(^DPT(MAGDFN,0)) S MAGGRY(0)="0^Request Contains Invalid Patient Pointer ("_MAGDFN_")" G PRIOR1Z
I $D(^RADPT(MAGDFN,"DT",MAGDTI,"P",MAGCNI))
E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_MAGCNI_")" G PRIOR1Z
S MAGRACNT=0
S MAGGRY(0)="0^Compiling Prior Radiology Exams"
D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET) ; Current Exam only
S RADFN=MAGDFN,RADTI=MAGDTI,RACNI=MAGCNI
I 'MAGRET S MAGGRY(0)="0^Current Case is Not Accessible" G PRIOR1Z
S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),RADATA2=$G(^(2)),DAYCASE=$P(RADATA,U,12) D SVMAG2A ; ISI P106
I 'MAGGRY(0) S MAGGRY(0)="0^Current Case either has no CPT code, or has no rules defined for its CPT code." G PRIOR1Z
S HDR=HDR_DAYCASE
D SRCH(MAGDFN) ; Search prior exams for this patient
PRIOR1Z ;
I 'MAGGRY(0) S:(MAGGRY(0)["Compiling") MAGGRY(0)="0^No Exams Found"
E I +MAGGRY(0)=1 S MAGGRY(0)="0^No Prior Exams Found" K MAGGRY(1)
E D SVMAG2B
K ^TMP($J,"MAGRAEX"),^("RAE1")
Q
;
SRCH(RADFN) ; Traverse all exams for a patient, up to limits of age & total
; numbers of exams to consider
N BEGDT,LIMYRS,LIMEXAMS
S LIMYRS=30,LIMEXAMS=100 ; default limit # Exams
S BEGDT=($E(DT,1,3)-LIMYRS)_$E(DT,4,7)
I BEGDT<2950101 S BEGDT=2950101 ; 2 yrs prior to earliest VistaPACS
S MAGRACNT=1 D GETEXAM3^MAGJUTL1(RADFN,BEGDT,"",.MAGRACNT,.MAGRET,"",LIMEXAMS)
I MAGRET N IDAT S IDAT=1 D
. F S IDAT=$O(^TMP($J,"MAGRAEX",IDAT)) Q:'IDAT S RADATA=^(IDAT,1),RADATA2=$G(^(2)) D ; ISI P106
. . S RADTI=$P(RADATA,U,2),RACNI=$P(RADATA,U,3)
. . I RADTI=MAGDTI&(RACNI=MAGCNI) Q ; skip current case
. . D SVMAG2A
Q
;
SVMAG2A ; 2A and 2B used by subroutine at tag PRIOR1
; Find all the patient's exams whose CPT codes are related to the
; Current exam's CPT code, according to dictionary 2006.65
N RAIMGTYP,X,RASTCAT ; ISI P106
N CPT,CPT3,CPT4,CPT5,CURCPTX,CURCPTS,HIT,MAGMATCH,MAGDTH,I
S RARPT=+$P(RADATA,U,10)
S RASTCAT=$P(RADATA2,U,11) ; ISI P106
I MAGGRY(0) Q:'$P(MAGGRY(1),U) ; Cur Case CPT not in map file
I Q:(ACTION="P")&'$D(^RARPT(RARPT,2005)) ; nothing to pre-fetch
I Q:$P(RADATA,U,15)<2!(RASTCAT="R") ; Cancel or Waiting ; or Ready for Interp ISI P106
; Note: if no images, may still want to do Auto-Disp to get Report;
; also, Current Case should still proceed
S CPT=$P(RADATA,U,17)
Q:'CPT ; algorithm REQUIRES CPT codes be used
S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3)
S MAGMATCH="^^"
I 'MAGGRY(0) D Q:'MAGMATCH ; No rules defined for Cur. Case's CPT
. S Y=""
. ; Order of CPT5/4/3 is important for the algorithm, which
. ; uses the 1st rule found at the LOWEST level of detail defined
. F X=CPT5,CPT4,CPT3 I $D(^MAG(2006.65,"B",X)) S Y=Y_$S(Y:",",1:"")_X S $P(MAGMATCH,U)=Y
I CPT,MAGGRY(0) D
. ; curcpts has the cpt5/4/3 list generated above for Cur. Case CPT's
. S HIT=0,CURCPTS=$P(MAGGRY(1),U)
. F Q:CURCPTS="" S CURCPTX=$O(^MAG(2006.65,"B",$P(CURCPTS,","),"")) S CURCPTS=$P(CURCPTS,",",2,9) I CURCPTX]"" D Q:HIT ; 1st hit only
. . ; This algorithm checks from lowest detail to most general, and acts
. . ; on the information found at the FIRST Hit only
. . F CPT="CPT5","CPT4","CPT3" S CPT=@CPT I CPT]"",$D(^MAG(2006.65,CURCPTX,1,"B",CPT)) S X=$O(^(CPT,"")) D S HIT=1 Q ;1st hit only
. . . S X=^MAG(2006.65,CURCPTX,1,X,0) S Y=$S(ACTION="A":2,1:5),X=$P(X,U,Y,Y+2)
. . . I +X S MAGMATCH=CPT F I=2,3 S $P(MAGMATCH,U,I)=$P(X,U,I)
; sample of logic file:
; ^MAG(2006.65,1,0) = 730
; ^MAG(2006.65,1,1,0) = ^12000011.01^2^2
; ^MAG(2006.65,1,1,1,0) = 730^1^40^6^1^120^10
; ^MAG(2006.65,1,1,2,0) = 732^1^40^2^1^120^4
; ^MAG(2006.65,1,1,"B",730,1) =
; ^MAG(2006.65,1,1,"B",732,2) =
; ^MAG(2006.65,"B",730,1) =
;
Q:'MAGMATCH
; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
; 6 RADATE RADTE RACN RAPRC RARPT
; 11 RAST DAYCASE RAELOC RASTP RASTORD
; 16 RADTPRT RACPT RAIMGTYP
S MAGDTH=$$FMTH^XLFDT($P(RADATA,U,7),1)
S X=$P(RADATA,U,18)
S RAIMGTYP=$S(X]"":$O(^RA(79.2,"C",X,"")),1:X)
S Y=MAGGRY(0)+1,$P(MAGGRY(0),U)=Y,MAGGRY(Y)=MAGMATCH_U_MAGDTH_U_U_$P(RADATA,U,9)_U_RAIMGTYP_U_RADFN_U_RADTI_U_RACNI_U_RARPT_U_$P(RADATA,U,12)_U_$P(RADATA,U,11)
Q
;
SVMAG2B ; For exams whose CPTs match, select a subset that are within defined
; limits with respect to time interval & maximum # exams to retrieve
; Return MAGGRY(0) = count ^ message
; MAGGRY(1:N) = "M08" | RADFN ^ RADTI ^ RACNI ^ RARPT
N CPT,CT,CURDAT,ICPT,IREC,GO,Y
S CURDAT=$P(MAGGRY(1),U,4)
F IREC=2:1:MAGGRY(0) S X=MAGGRY(IREC),CPT=+X D K MAGGRY(IREC)
. I $P(X,U,2) S Y=CURDAT-$P(X,U,4) S:Y<0 Y=-Y I Y>$P(X,U,2) Q ;too old
. S Y=$G(GO(CPT))+1 I CPT,(Y>$P(X,U,3)) Q ; already have enough cases
. S GO(CPT)=Y,GO(CPT,Y)=X
K MAGGRY
I $D(GO) S CT=0,CPT="" D
. F S CPT=$O(GO(CPT)) Q:CPT="" F ICPT=1:1:GO(CPT) D
. . S CT=CT+1,X=GO(CPT,ICPT),RARPT=$P(X,U,11)
. . S MAGGRY(CT)="M08^"_CPT_"|"_$P(X,U,8,11)
. . I ACTION="P"!(ACTION="A") S Y=$$JBFETCH^MAGJUTL2(RARPT) ; fetch from jukebox
. . I ACTION="C" S Y=$$CACHE^MAGNUTL2(RARPT) ; precache exams
. . I ACTION="ISIP" S:$T(^ISINUTL2)'="" Y=$$FETCH^ISINUTL2(RARPT) ; ISI -- ISIX pre-fetch
. S MAGGRY(0)=CT_"^"_HDR
E S MAGGRY(0)="0^No Exams Found for "_HDR
Q
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJEX2 8592 printed Dec 13, 2024@02:06:42 Page 2
MAGJEX2 ;WIRMFO/JHC,NST - Rad. Workstation RPC calls ; 10/17/2022
+1 ;;3.0;IMAGING;**51,18,76,120,201,341**;Dec 21, 2022;Build 28
+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 ;; ISI IMAGING;**99,106**
+18 QUIT
+19 ; Subroutines for pre-fetch/ auto-route prior exams' images
+20 ; Entry Points:
+21 ; PRIOR1 -- Pre-Fetch/Auto-route images for other related cases;
+22 ; RPC Call: MAGJ PRIOREXAMS
+23 ; PREFETCH -- Subroutine call via Protocol trigger
+24 ;
+25 QUIT
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET MAGGRY(0)="0^Server Program Error: "_ERR
+1 DO @^%ZOSF("ERRTN")
+2 if $QUIT
QUIT 1
QUIT
PREFETCH ; Entry point from HL7 processing, to initiate prefetch at
+1 ; time of radiology "Register Patient for Exam" function
+2 ; Do not process if the exam is being Canceled (RACANC true)
+3 ;
+4 NEW RET
SET RET=""
+5 ; Prefetch disabled
IF '$PIECE($GET(^MAG(2006.69,1,0)),U,5)
GOTO PREFQ
+6 ; Required vars
IF '($GET(RADFN)&$GET(RADTI)&$GET(RACNI)&'$GET(RACANC))
GOTO PREFQ
+7 DO PRIOR1(.RET,"P"_U_RADFN_U_RADTI_U_RACNI)
PREFQ ;
+1 QUIT
+2 ;
PRIOR1(MAGGRY,DATA) ; review all exams for a patient to find "related" exams
+1 ; This ep also called as subroutine from routing software (P51)
+2 ; MAGGRY - return array of exams to PreFetch or Auto-route
+3 ; DATA: - input params for the Current Exam
+4 ; 1) ACTION = P -- Pre-fetch Exams (from Jukebox to Magnetic Disk)
+5 ; = A -- Auto-route priors
+6 ; = C -- Pre-cache exams
+7 ; 2) RADFN = Case pointers to Rad/Nuc Med Patient file
+8 ; 3) RADTI = "" "" "" ""
+9 ; 4) RACNI = "" "" "" ""
+10 ; 5) RARPT - Case pointer to ^RARPT global
+11 ;
+12 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJEX2"
+13 KILL MAGGRY
+14 ; ISI P106
NEW RADFN,RADTI,RACNI,RARPT,RADATA,RADATA2
+15 NEW DAYCASE,DIQUIET,ACTION,CPT,HDR,MAGDFN,MAGDTI,MAGCNI,MAGRET,MAGRACNT
+16 SET ACTION=$PIECE(DATA,U)
+17 ; ISI new prefetch action ISIP
IF ACTION="P"!(ACTION="A")!(ACTION="C")!(ACTION="ISIP")
+18 IF '$TEST
SET MAGGRY(0)="0^Invalid Request (Action code="_ACTION_")"
GOTO PRIOR1Z
+19 SET MAGDFN=$PIECE(DATA,U,2)
SET MAGDTI=$PIECE(DATA,U,3)
SET MAGCNI=$PIECE(DATA,U,4)
+20 IF MAGDFN
IF MAGDTI
IF MAGCNI
+21 IF '$TEST
SET MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_DATA_")"
GOTO PRIOR1Z
+22 SET DIQUIET=1
DO DT^DICRW
+23 NEW MAGJOB
DO MAGJOBNC^MAGJUTL3
+24 SET HDR=$SELECT(ACTION="P":"Pre-fetch",ACTION="A":"Auto-route",ACTION="C":"Pre-cache",1:"???")_" Prior Exams for CASE: "
+25 IF '$DATA(^DPT(MAGDFN,0))
SET MAGGRY(0)="0^Request Contains Invalid Patient Pointer ("_MAGDFN_")"
GOTO PRIOR1Z
+26 IF $DATA(^RADPT(MAGDFN,"DT",MAGDTI,"P",MAGCNI))
+27 IF '$TEST
SET MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_MAGCNI_")"
GOTO PRIOR1Z
+28 SET MAGRACNT=0
+29 SET MAGGRY(0)="0^Compiling Prior Radiology Exams"
+30 ; Current Exam only
DO GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET)
+31 SET RADFN=MAGDFN
SET RADTI=MAGDTI
SET RACNI=MAGCNI
+32 IF 'MAGRET
SET MAGGRY(0)="0^Current Case is Not Accessible"
GOTO PRIOR1Z
+33 ; ISI P106
SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
SET RADATA2=$GET(^(2))
SET DAYCASE=$PIECE(RADATA,U,12)
DO SVMAG2A
+34 IF 'MAGGRY(0)
SET MAGGRY(0)="0^Current Case either has no CPT code, or has no rules defined for its CPT code."
GOTO PRIOR1Z
+35 SET HDR=HDR_DAYCASE
+36 ; Search prior exams for this patient
DO SRCH(MAGDFN)
PRIOR1Z ;
+1 IF 'MAGGRY(0)
if (MAGGRY(0)["Compiling")
SET MAGGRY(0)="0^No Exams Found"
+2 IF '$TEST
IF +MAGGRY(0)=1
SET MAGGRY(0)="0^No Prior Exams Found"
KILL MAGGRY(1)
+3 IF '$TEST
DO SVMAG2B
+4 KILL ^TMP($JOB,"MAGRAEX"),^("RAE1")
+5 QUIT
+6 ;
SRCH(RADFN) ; Traverse all exams for a patient, up to limits of age & total
+1 ; numbers of exams to consider
+2 NEW BEGDT,LIMYRS,LIMEXAMS
+3 ; default limit # Exams
SET LIMYRS=30
SET LIMEXAMS=100
+4 SET BEGDT=($EXTRACT(DT,1,3)-LIMYRS)_$EXTRACT(DT,4,7)
+5 ; 2 yrs prior to earliest VistaPACS
IF BEGDT<2950101
SET BEGDT=2950101
+6 SET MAGRACNT=1
DO GETEXAM3^MAGJUTL1(RADFN,BEGDT,"",.MAGRACNT,.MAGRET,"",LIMEXAMS)
+7 IF MAGRET
NEW IDAT
SET IDAT=1
Begin DoDot:1
+8 ; ISI P106
FOR
SET IDAT=$ORDER(^TMP($JOB,"MAGRAEX",IDAT))
if 'IDAT
QUIT
SET RADATA=^(IDAT,1)
SET RADATA2=$GET(^(2))
Begin DoDot:2
+9 SET RADTI=$PIECE(RADATA,U,2)
SET RACNI=$PIECE(RADATA,U,3)
+10 ; skip current case
IF RADTI=MAGDTI&(RACNI=MAGCNI)
QUIT
+11 DO SVMAG2A
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
SVMAG2A ; 2A and 2B used by subroutine at tag PRIOR1
+1 ; Find all the patient's exams whose CPT codes are related to the
+2 ; Current exam's CPT code, according to dictionary 2006.65
+3 ; ISI P106
NEW RAIMGTYP,X,RASTCAT
+4 NEW CPT,CPT3,CPT4,CPT5,CURCPTX,CURCPTS,HIT,MAGMATCH,MAGDTH,I
+5 SET RARPT=+$PIECE(RADATA,U,10)
+6 ; ISI P106
SET RASTCAT=$PIECE(RADATA2,U,11)
+7 ; Cur Case CPT not in map file
IF MAGGRY(0)
if '$PIECE(MAGGRY(1),U)
QUIT
+8 ; nothing to pre-fetch
IF $TEST
if (ACTION="P")&'$DATA(^RARPT(RARPT,2005))
QUIT
+9 ; Cancel or Waiting ; or Ready for Interp ISI P106
IF $TEST
if $PIECE(RADATA,U,15)<2!(RASTCAT="R")
QUIT
+10 ; Note: if no images, may still want to do Auto-Disp to get Report;
+11 ; also, Current Case should still proceed
+12 SET CPT=$PIECE(RADATA,U,17)
+13 ; algorithm REQUIRES CPT codes be used
if 'CPT
QUIT
+14 SET CPT5=CPT
SET CPT4=$EXTRACT(CPT,1,4)
SET CPT3=$EXTRACT(CPT,1,3)
+15 SET MAGMATCH="^^"
+16 ; No rules defined for Cur. Case's CPT
IF 'MAGGRY(0)
Begin DoDot:1
+17 SET Y=""
+18 ; Order of CPT5/4/3 is important for the algorithm, which
+19 ; uses the 1st rule found at the LOWEST level of detail defined
+20 FOR X=CPT5,CPT4,CPT3
IF $DATA(^MAG(2006.65,"B",X))
SET Y=Y_$SELECT(Y:",",1:"")_X
SET $PIECE(MAGMATCH,U)=Y
End DoDot:1
if 'MAGMATCH
QUIT
+21 IF CPT
IF MAGGRY(0)
Begin DoDot:1
+22 ; curcpts has the cpt5/4/3 list generated above for Cur. Case CPT's
+23 SET HIT=0
SET CURCPTS=$PIECE(MAGGRY(1),U)
+24 ; 1st hit only
FOR
if CURCPTS=""
QUIT
SET CURCPTX=$ORDER(^MAG(2006.65,"B",$PIECE(CURCPTS,","),""))
SET CURCPTS=$PIECE(CURCPTS,",",2,9)
IF CURCPTX]""
Begin DoDot:2
+25 ; This algorithm checks from lowest detail to most general, and acts
+26 ; on the information found at the FIRST Hit only
+27 ;1st hit only
FOR CPT="CPT5","CPT4","CPT3"
SET CPT=@CPT
IF CPT]""
IF $DATA(^MAG(2006.65,CURCPTX,1,"B",CPT))
SET X=$ORDER(^(CPT,""))
Begin DoDot:3
+28 SET X=^MAG(2006.65,CURCPTX,1,X,0)
SET Y=$SELECT(ACTION="A":2,1:5)
SET X=$PIECE(X,U,Y,Y+2)
+29 IF +X
SET MAGMATCH=CPT
FOR I=2,3
SET $PIECE(MAGMATCH,U,I)=$PIECE(X,U,I)
End DoDot:3
SET HIT=1
QUIT
End DoDot:2
if HIT
QUIT
End DoDot:1
+30 ; sample of logic file:
+31 ; ^MAG(2006.65,1,0) = 730
+32 ; ^MAG(2006.65,1,1,0) = ^12000011.01^2^2
+33 ; ^MAG(2006.65,1,1,1,0) = 730^1^40^6^1^120^10
+34 ; ^MAG(2006.65,1,1,2,0) = 732^1^40^2^1^120^4
+35 ; ^MAG(2006.65,1,1,"B",730,1) =
+36 ; ^MAG(2006.65,1,1,"B",732,2) =
+37 ; ^MAG(2006.65,"B",730,1) =
+38 ;
+39 if 'MAGMATCH
QUIT
+40 ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
+41 ; 6 RADATE RADTE RACN RAPRC RARPT
+42 ; 11 RAST DAYCASE RAELOC RASTP RASTORD
+43 ; 16 RADTPRT RACPT RAIMGTYP
+44 SET MAGDTH=$$FMTH^XLFDT($PIECE(RADATA,U,7),1)
+45 SET X=$PIECE(RADATA,U,18)
+46 SET RAIMGTYP=$SELECT(X]"":$ORDER(^RA(79.2,"C",X,"")),1:X)
+47 SET Y=MAGGRY(0)+1
SET $PIECE(MAGGRY(0),U)=Y
SET MAGGRY(Y)=MAGMATCH_U_MAGDTH_U_U_$PIECE(RADATA,U,9)_U_RAIMGTYP_U_RADFN_U_RADTI_U_RACNI_U_RARPT_U_$PIECE(RADATA,U,12)_U_$PIECE(RADATA,U,11)
+48 QUIT
+49 ;
SVMAG2B ; For exams whose CPTs match, select a subset that are within defined
+1 ; limits with respect to time interval & maximum # exams to retrieve
+2 ; Return MAGGRY(0) = count ^ message
+3 ; MAGGRY(1:N) = "M08" | RADFN ^ RADTI ^ RACNI ^ RARPT
+4 NEW CPT,CT,CURDAT,ICPT,IREC,GO,Y
+5 SET CURDAT=$PIECE(MAGGRY(1),U,4)
+6 FOR IREC=2:1:MAGGRY(0)
SET X=MAGGRY(IREC)
SET CPT=+X
Begin DoDot:1
+7 ;too old
IF $PIECE(X,U,2)
SET Y=CURDAT-$PIECE(X,U,4)
if Y<0
SET Y=-Y
IF Y>$PIECE(X,U,2)
QUIT
+8 ; already have enough cases
SET Y=$GET(GO(CPT))+1
IF CPT
IF (Y>$PIECE(X,U,3))
QUIT
+9 SET GO(CPT)=Y
SET GO(CPT,Y)=X
End DoDot:1
KILL MAGGRY(IREC)
+10 KILL MAGGRY
+11 IF $DATA(GO)
SET CT=0
SET CPT=""
Begin DoDot:1
+12 FOR
SET CPT=$ORDER(GO(CPT))
if CPT=""
QUIT
FOR ICPT=1:1:GO(CPT)
Begin DoDot:2
+13 SET CT=CT+1
SET X=GO(CPT,ICPT)
SET RARPT=$PIECE(X,U,11)
+14 SET MAGGRY(CT)="M08^"_CPT_"|"_$PIECE(X,U,8,11)
+15 ; fetch from jukebox
IF ACTION="P"!(ACTION="A")
SET Y=$$JBFETCH^MAGJUTL2(RARPT)
+16 ; precache exams
IF ACTION="C"
SET Y=$$CACHE^MAGNUTL2(RARPT)
+17 ; ISI -- ISIX pre-fetch
IF ACTION="ISIP"
if $TEXT(^ISINUTL2)'=""
SET Y=$$FETCH^ISINUTL2(RARPT)
End DoDot:2
+18 SET MAGGRY(0)=CT_"^"_HDR
End DoDot:1
+19 IF '$TEST
SET MAGGRY(0)="0^No Exams Found for "_HDR
+20 QUIT
+21 ;
END ;
