Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGJEX2

MAGJEX2.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ;; ISI IMAGING;**99,106**
  1. Q
  1. ; Subroutines for pre-fetch/ auto-route prior exams' images
  1. ; Entry Points:
  1. ; PRIOR1 -- Pre-Fetch/Auto-route images for other related cases;
  1. ; RPC Call: MAGJ PRIOREXAMS
  1. ; PREFETCH -- Subroutine call via Protocol trigger
  1. ;
  1. Q
  1. ERR N ERR S ERR=$$EC^%ZOSV S MAGGRY(0)="0^Server Program Error: "_ERR
  1. D @^%ZOSF("ERRTN")
  1. Q:$Q 1 Q
  1. PREFETCH ; Entry point from HL7 processing, to initiate prefetch at
  1. ; time of radiology "Register Patient for Exam" function
  1. ; Do not process if the exam is being Canceled (RACANC true)
  1. ;
  1. N RET S RET=""
  1. I '$P($G(^MAG(2006.69,1,0)),U,5) G PREFQ ; Prefetch disabled
  1. I '($G(RADFN)&$G(RADTI)&$G(RACNI)&'$G(RACANC)) G PREFQ ; Required vars
  1. D PRIOR1(.RET,"P"_U_RADFN_U_RADTI_U_RACNI)
  1. PREFQ ;
  1. Q
  1. ;
  1. PRIOR1(MAGGRY,DATA) ; review all exams for a patient to find "related" exams
  1. ; This ep also called as subroutine from routing software (P51)
  1. ; MAGGRY - return array of exams to PreFetch or Auto-route
  1. ; DATA: - input params for the Current Exam
  1. ; 1) ACTION = P -- Pre-fetch Exams (from Jukebox to Magnetic Disk)
  1. ; = A -- Auto-route priors
  1. ; = C -- Pre-cache exams
  1. ; 2) RADFN = Case pointers to Rad/Nuc Med Patient file
  1. ; 3) RADTI = "" "" "" ""
  1. ; 4) RACNI = "" "" "" ""
  1. ; 5) RARPT - Case pointer to ^RARPT global
  1. ;
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX2"
  1. K MAGGRY
  1. N RADFN,RADTI,RACNI,RARPT,RADATA,RADATA2 ; ISI P106
  1. N DAYCASE,DIQUIET,ACTION,CPT,HDR,MAGDFN,MAGDTI,MAGCNI,MAGRET,MAGRACNT
  1. S ACTION=$P(DATA,U)
  1. I ACTION="P"!(ACTION="A")!(ACTION="C")!(ACTION="ISIP") ; ISI new prefetch action ISIP
  1. E S MAGGRY(0)="0^Invalid Request (Action code="_ACTION_")" G PRIOR1Z
  1. S MAGDFN=$P(DATA,U,2),MAGDTI=$P(DATA,U,3),MAGCNI=$P(DATA,U,4)
  1. I MAGDFN,MAGDTI,MAGCNI
  1. E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_DATA_")" G PRIOR1Z
  1. S DIQUIET=1 D DT^DICRW
  1. N MAGJOB D MAGJOBNC^MAGJUTL3
  1. S HDR=$S(ACTION="P":"Pre-fetch",ACTION="A":"Auto-route",ACTION="C":"Pre-cache",1:"???")_" Prior Exams for CASE: "
  1. I '$D(^DPT(MAGDFN,0)) S MAGGRY(0)="0^Request Contains Invalid Patient Pointer ("_MAGDFN_")" G PRIOR1Z
  1. I $D(^RADPT(MAGDFN,"DT",MAGDTI,"P",MAGCNI))
  1. E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_MAGCNI_")" G PRIOR1Z
  1. S MAGRACNT=0
  1. S MAGGRY(0)="0^Compiling Prior Radiology Exams"
  1. D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET) ; Current Exam only
  1. S RADFN=MAGDFN,RADTI=MAGDTI,RACNI=MAGCNI
  1. I 'MAGRET S MAGGRY(0)="0^Current Case is Not Accessible" G PRIOR1Z
  1. S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),RADATA2=$G(^(2)),DAYCASE=$P(RADATA,U,12) D SVMAG2A ; ISI P106
  1. 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
  1. S HDR=HDR_DAYCASE
  1. D SRCH(MAGDFN) ; Search prior exams for this patient
  1. PRIOR1Z ;
  1. I 'MAGGRY(0) S:(MAGGRY(0)["Compiling") MAGGRY(0)="0^No Exams Found"
  1. E I +MAGGRY(0)=1 S MAGGRY(0)="0^No Prior Exams Found" K MAGGRY(1)
  1. E D SVMAG2B
  1. K ^TMP($J,"MAGRAEX"),^("RAE1")
  1. Q
  1. ;
  1. SRCH(RADFN) ; Traverse all exams for a patient, up to limits of age & total
  1. ; numbers of exams to consider
  1. N BEGDT,LIMYRS,LIMEXAMS
  1. S LIMYRS=30,LIMEXAMS=100 ; default limit # Exams
  1. S BEGDT=($E(DT,1,3)-LIMYRS)_$E(DT,4,7)
  1. I BEGDT<2950101 S BEGDT=2950101 ; 2 yrs prior to earliest VistaPACS
  1. S MAGRACNT=1 D GETEXAM3^MAGJUTL1(RADFN,BEGDT,"",.MAGRACNT,.MAGRET,"",LIMEXAMS)
  1. I MAGRET N IDAT S IDAT=1 D
  1. . F S IDAT=$O(^TMP($J,"MAGRAEX",IDAT)) Q:'IDAT S RADATA=^(IDAT,1),RADATA2=$G(^(2)) D ; ISI P106
  1. . . S RADTI=$P(RADATA,U,2),RACNI=$P(RADATA,U,3)
  1. . . I RADTI=MAGDTI&(RACNI=MAGCNI) Q ; skip current case
  1. . . D SVMAG2A
  1. Q
  1. ;
  1. SVMAG2A ; 2A and 2B used by subroutine at tag PRIOR1
  1. ; Find all the patient's exams whose CPT codes are related to the
  1. ; Current exam's CPT code, according to dictionary 2006.65
  1. N RAIMGTYP,X,RASTCAT ; ISI P106
  1. N CPT,CPT3,CPT4,CPT5,CURCPTX,CURCPTS,HIT,MAGMATCH,MAGDTH,I
  1. S RARPT=+$P(RADATA,U,10)
  1. S RASTCAT=$P(RADATA2,U,11) ; ISI P106
  1. I MAGGRY(0) Q:'$P(MAGGRY(1),U) ; Cur Case CPT not in map file
  1. I Q:(ACTION="P")&'$D(^RARPT(RARPT,2005)) ; nothing to pre-fetch
  1. I Q:$P(RADATA,U,15)<2!(RASTCAT="R") ; Cancel or Waiting ; or Ready for Interp ISI P106
  1. ; Note: if no images, may still want to do Auto-Disp to get Report;
  1. ; also, Current Case should still proceed
  1. S CPT=$P(RADATA,U,17)
  1. Q:'CPT ; algorithm REQUIRES CPT codes be used
  1. S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3)
  1. S MAGMATCH="^^"
  1. I 'MAGGRY(0) D Q:'MAGMATCH ; No rules defined for Cur. Case's CPT
  1. . S Y=""
  1. . ; Order of CPT5/4/3 is important for the algorithm, which
  1. . ; uses the 1st rule found at the LOWEST level of detail defined
  1. . F X=CPT5,CPT4,CPT3 I $D(^MAG(2006.65,"B",X)) S Y=Y_$S(Y:",",1:"")_X S $P(MAGMATCH,U)=Y
  1. I CPT,MAGGRY(0) D
  1. . ; curcpts has the cpt5/4/3 list generated above for Cur. Case CPT's
  1. . S HIT=0,CURCPTS=$P(MAGGRY(1),U)
  1. . 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
  1. . . ; This algorithm checks from lowest detail to most general, and acts
  1. . . ; on the information found at the FIRST Hit only
  1. . . 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
  1. . . . S X=^MAG(2006.65,CURCPTX,1,X,0) S Y=$S(ACTION="A":2,1:5),X=$P(X,U,Y,Y+2)
  1. . . . I +X S MAGMATCH=CPT F I=2,3 S $P(MAGMATCH,U,I)=$P(X,U,I)
  1. ; sample of logic file:
  1. ; ^MAG(2006.65,1,0) = 730
  1. ; ^MAG(2006.65,1,1,0) = ^12000011.01^2^2
  1. ; ^MAG(2006.65,1,1,1,0) = 730^1^40^6^1^120^10
  1. ; ^MAG(2006.65,1,1,2,0) = 732^1^40^2^1^120^4
  1. ; ^MAG(2006.65,1,1,"B",730,1) =
  1. ; ^MAG(2006.65,1,1,"B",732,2) =
  1. ; ^MAG(2006.65,"B",730,1) =
  1. ;
  1. Q:'MAGMATCH
  1. ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
  1. ; 6 RADATE RADTE RACN RAPRC RARPT
  1. ; 11 RAST DAYCASE RAELOC RASTP RASTORD
  1. ; 16 RADTPRT RACPT RAIMGTYP
  1. S MAGDTH=$$FMTH^XLFDT($P(RADATA,U,7),1)
  1. S X=$P(RADATA,U,18)
  1. S RAIMGTYP=$S(X]"":$O(^RA(79.2,"C",X,"")),1:X)
  1. 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)
  1. Q
  1. ;
  1. SVMAG2B ; For exams whose CPTs match, select a subset that are within defined
  1. ; limits with respect to time interval & maximum # exams to retrieve
  1. ; Return MAGGRY(0) = count ^ message
  1. ; MAGGRY(1:N) = "M08" | RADFN ^ RADTI ^ RACNI ^ RARPT
  1. N CPT,CT,CURDAT,ICPT,IREC,GO,Y
  1. S CURDAT=$P(MAGGRY(1),U,4)
  1. F IREC=2:1:MAGGRY(0) S X=MAGGRY(IREC),CPT=+X D K MAGGRY(IREC)
  1. . 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
  1. . S Y=$G(GO(CPT))+1 I CPT,(Y>$P(X,U,3)) Q ; already have enough cases
  1. . S GO(CPT)=Y,GO(CPT,Y)=X
  1. K MAGGRY
  1. I $D(GO) S CT=0,CPT="" D
  1. . F S CPT=$O(GO(CPT)) Q:CPT="" F ICPT=1:1:GO(CPT) D
  1. . . S CT=CT+1,X=GO(CPT,ICPT),RARPT=$P(X,U,11)
  1. . . S MAGGRY(CT)="M08^"_CPT_"|"_$P(X,U,8,11)
  1. . . I ACTION="P"!(ACTION="A") S Y=$$JBFETCH^MAGJUTL2(RARPT) ; fetch from jukebox
  1. . . I ACTION="C" S Y=$$CACHE^MAGNUTL2(RARPT) ; precache exams
  1. . . I ACTION="ISIP" S:$T(^ISINUTL2)'="" Y=$$FETCH^ISINUTL2(RARPT) ; ISI -- ISIX pre-fetch
  1. . S MAGGRY(0)=CT_"^"_HDR
  1. E S MAGGRY(0)="0^No Exams Found for "_HDR
  1. Q
  1. ;
  1. END ;