| 1 | MAGJEX2 ;;WIRMFO/JHC Rad. Workstation RPC calls;[ 02/25/2000 4:40 PM ] ; 09 Jun 2003 2:58 PM
|
|---|
| 2 | ;;3.0;IMAGING;**51,18,76**;Jun 22, 2007;Build 19
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;; +---------------------------------------------------------------+
|
|---|
| 5 | ;; | Property of the US Government. |
|
|---|
| 6 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 7 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 8 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 9 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 10 | ;; | telephone (301) 734-0100. |
|
|---|
| 11 | ;; | |
|
|---|
| 12 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 13 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 14 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 15 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 16 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 17 | ;; +---------------------------------------------------------------+
|
|---|
| 18 | ;;
|
|---|
| 19 | Q
|
|---|
| 20 | ; Subroutines for pre-fetch/ auto-display prior exams' images
|
|---|
| 21 | ; Entry Points:
|
|---|
| 22 | ; PRIOR1 -- Pre-Fetch/Auto-Display images for other related cases;
|
|---|
| 23 | ; RPC Call: MAGJ PRIOREXAMS
|
|---|
| 24 | ; PREFETCH -- Pre-Fetch initiated from
|
|---|
| 25 | ;
|
|---|
| 26 | Q
|
|---|
| 27 | ERR N ERR S ERR=$$EC^%ZOSV S MAGGRY(0)="0^Server Program Error: "_ERR
|
|---|
| 28 | D @^%ZOSF("ERRTN")
|
|---|
| 29 | Q:$Q 1 Q
|
|---|
| 30 | PREFETCH ; Entry point from HL7 processing, to initiate prefetch at
|
|---|
| 31 | ; time of radiology "Register Patient for Exam" function
|
|---|
| 32 | ; Do not process if the exam is being Canceled (RACANC true)
|
|---|
| 33 | ;
|
|---|
| 34 | N RET S RET=""
|
|---|
| 35 | I '$P($G(^MAG(2006.69,1,0)),U,5) G PREFQ ; Prefetch disabled
|
|---|
| 36 | I '($G(RADFN)&$G(RADTI)&$G(RACNI)&'$G(RACANC)) G PREFQ ; Required vars
|
|---|
| 37 | D PRIOR1(.RET,"P"_U_RADFN_U_RADTI_U_RACNI)
|
|---|
| 38 | PREFQ ; W !,"End PRE-FETCH RET=" N JHC R JHC ZW RET
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | PRIOR1(MAGGRY,DATA) ; review all exams for a patient to find "related" exams
|
|---|
| 42 | ; This ep also called as subroutine from routing software (P51)
|
|---|
| 43 | ; MAGGRY - return array of exams to PreFetch, or Auto-send to RAD W/S
|
|---|
| 44 | ; DATA: - input params for the Current Exam
|
|---|
| 45 | ; 1) ACTION = P -- Pre-fetch Exams (from Jukebox to Magnetic Disk)
|
|---|
| 46 | ; = A -- Auto-route priors
|
|---|
| 47 | ; 2) RADFN = Case pointers to Rad/Nuc Med Patient file
|
|---|
| 48 | ; 3) RADTI = "" "" "" ""
|
|---|
| 49 | ; 4) RACNI = "" "" "" ""
|
|---|
| 50 | ; 5) RARPT - Case pointer to ^RARPT global
|
|---|
| 51 | ;
|
|---|
| 52 | N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX2"
|
|---|
| 53 | K MAGGRY
|
|---|
| 54 | N RADFN,RADTI,RACNI,RARPT,RADATA
|
|---|
| 55 | N DAYCASE,DIQUIET,ACTION,CPT,HDR,MAGDFN,MAGDTI,MAGCNI,MAGRET,MAGRACNT
|
|---|
| 56 | S ACTION=$P(DATA,U)
|
|---|
| 57 | I ACTION="P"!(ACTION="A")
|
|---|
| 58 | E S MAGGRY(0)="0^Invalid Request (Action code="_ACTION_")" G PRIOR1Z
|
|---|
| 59 | S MAGDFN=$P(DATA,U,2),MAGDTI=$P(DATA,U,3),MAGCNI=$P(DATA,U,4)
|
|---|
| 60 | I MAGDFN,MAGDTI,MAGCNI
|
|---|
| 61 | E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_DATA_")" G PRIOR1Z
|
|---|
| 62 | S DIQUIET=1 D DT^DICRW
|
|---|
| 63 | N MAGJOB D MAGJOBNC^MAGJUTL3
|
|---|
| 64 | S HDR=$S(ACTION="P":"Pre-fetch",ACTION="A":"Auto-Display",1:"???")_" Prior Exams for CASE: "
|
|---|
| 65 | I '$D(^DPT(MAGDFN,0)) S MAGGRY(0)="0^Request Contains Invalid Patient Pointer ("_MAGDFN_")" G PRIOR1Z
|
|---|
| 66 | I $D(^RADPT(MAGDFN,"DT",MAGDTI,"P",MAGCNI))
|
|---|
| 67 | E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_MAGCNI_")" G PRIOR1Z
|
|---|
| 68 | S MAGRACNT=0
|
|---|
| 69 | S MAGGRY(0)="0^Compiling Prior Radiology Exams"
|
|---|
| 70 | D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET) ; Current Exam only
|
|---|
| 71 | S RADFN=MAGDFN,RADTI=MAGDTI,RACNI=MAGCNI
|
|---|
| 72 | I 'MAGRET S MAGGRY(0)="0^Current Case is Not Accessible" G PRIOR1Z
|
|---|
| 73 | S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) S DAYCASE=$P(RADATA,U,12) D SVMAG2A
|
|---|
| 74 | 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
|
|---|
| 75 | S HDR=HDR_DAYCASE
|
|---|
| 76 | D SRCH(MAGDFN) ; Search prior exams for this patient
|
|---|
| 77 | PRIOR1Z ;
|
|---|
| 78 | I 'MAGGRY(0) S:(MAGGRY(0)["Compiling") MAGGRY(0)="0^No Exams Found"
|
|---|
| 79 | E I +MAGGRY(0)=1 S MAGGRY(0)="0^No Prior Exams Found" K MAGGRY(1)
|
|---|
| 80 | E D SVMAG2B
|
|---|
| 81 | K ^TMP($J,"MAGRAEX"),^("RAE1")
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | SRCH(RADFN) ; Traverse all exams for a patient, up to limits of age & total
|
|---|
| 85 | ; numbers of exams to consider
|
|---|
| 86 | N BEGDT,LIMYRS,LIMEXAMS,X
|
|---|
| 87 | S X=$G(^MAG(2006.69,1,0))
|
|---|
| 88 | S LIMYRS=+$P(X,U,14),LIMEXAMS=+$P(X,U,15)
|
|---|
| 89 | S:'LIMYRS LIMYRS=7 S:'LIMEXAMS LIMEXAMS=50 ; default limit # Exams
|
|---|
| 90 | S BEGDT=($E(DT,1,3)-LIMYRS)_$E(DT,4,7)
|
|---|
| 91 | I BEGDT<2950101 S BEGDT=2950101 ; 2 yrs prior to earliest VistaPACS
|
|---|
| 92 | S MAGRACNT=1 D GETEXAM3^MAGJUTL1(RADFN,BEGDT,"",.MAGRACNT,.MAGRET,"",LIMEXAMS)
|
|---|
| 93 | I MAGRET N IDAT S IDAT=1 D
|
|---|
| 94 | . F S IDAT=$O(^TMP($J,"MAGRAEX",IDAT)) Q:'IDAT S RADATA=^(IDAT,1) D
|
|---|
| 95 | .. S RADTI=$P(RADATA,U,2),RACNI=$P(RADATA,U,3)
|
|---|
| 96 | .. I RADTI=MAGDTI&(RACNI=MAGCNI) Q ; skip current case
|
|---|
| 97 | .. D SVMAG2A
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | SVMAG2A ; 2A and 2B used by subroutine at tag PRIOR1
|
|---|
| 101 | ; Find all the patient's exams whose CPT codes are related to the
|
|---|
| 102 | ; Current exam's CPT code, according to dictionary 2006.65
|
|---|
| 103 | N RAIMGTYP
|
|---|
| 104 | N CPT,CPT3,CPT4,CPT5,CURCPTX,CURCPTS,HIT,MAGMATCH,MAGDTH
|
|---|
| 105 | S RARPT=+$P(RADATA,U,10)
|
|---|
| 106 | I MAGGRY(0) Q:'$P(MAGGRY(1),U) ; Cur Case CPT not in map file
|
|---|
| 107 | I Q:(ACTION="P")&'$D(^RARPT(RARPT,2005)) ; nothing to pre-fetch
|
|---|
| 108 | I Q:$P(RADATA,U,15)<2 ; Cancel or Waiting
|
|---|
| 109 | ; Note: if no images, may still want to do Auto-Disp to get Report;
|
|---|
| 110 | ; also, Current Case should still proceed
|
|---|
| 111 | S CPT=$P(RADATA,U,17)
|
|---|
| 112 | Q:'CPT ; algorithm REQUIRES CPT codes be used
|
|---|
| 113 | S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3)
|
|---|
| 114 | S MAGMATCH="^^"
|
|---|
| 115 | I 'MAGGRY(0) D Q:'MAGMATCH ; No rules defined for Cur. Case's CPT
|
|---|
| 116 | . S Y=""
|
|---|
| 117 | . ; Order of CPT5/4/3 is important for the algorithm, which
|
|---|
| 118 | . ; uses the 1st rule found at the LOWEST level of detail defined
|
|---|
| 119 | . F X=CPT5,CPT4,CPT3 I $D(^MAG(2006.65,"B",X)) S Y=Y_$S(Y:",",1:"")_X S $P(MAGMATCH,U)=Y
|
|---|
| 120 | I CPT,MAGGRY(0) D
|
|---|
| 121 | . ; curcpts has the cpt5/4/3 list generated above for Cur. Case CPT's
|
|---|
| 122 | . S HIT=0,CURCPTS=$P(MAGGRY(1),U)
|
|---|
| 123 | . 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
|
|---|
| 124 | .. ; This algorithm checks from lowest detail to most general, and acts
|
|---|
| 125 | .. ; on the information found at the FIRST Hit only
|
|---|
| 126 | .. 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
|
|---|
| 127 | ... S X=^MAG(2006.65,CURCPTX,1,X,0) S Y=$S(ACTION="A":2,1:5),X=$P(X,U,Y,Y+2)
|
|---|
| 128 | ... I +X S MAGMATCH=CPT F I=2,3 S $P(MAGMATCH,U,I)=$P(X,U,I)
|
|---|
| 129 | ; sample of logic file:
|
|---|
| 130 | ; ^MAG(2006.65,1,0) = 730
|
|---|
| 131 | ; ^MAG(2006.65,1,1,0) = ^12000011.01^2^2
|
|---|
| 132 | ; ^MAG(2006.65,1,1,1,0) = 730^1^40^6^1^120^10
|
|---|
| 133 | ; ^MAG(2006.65,1,1,2,0) = 732^1^40^2^1^120^4
|
|---|
| 134 | ; ^MAG(2006.65,1,1,"B",730,1) =
|
|---|
| 135 | ; ^MAG(2006.65,1,1,"B",732,2) =
|
|---|
| 136 | ; ^MAG(2006.65,"B",730,1) =
|
|---|
| 137 | ;
|
|---|
| 138 | Q:'MAGMATCH
|
|---|
| 139 | ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
|
|---|
| 140 | ; 6 RADATE RADTE RACN RAPRC RARPT
|
|---|
| 141 | ; 11 RAST DAYCASE RAELOC RASTP RASTORD
|
|---|
| 142 | ; 16 RADTPRT RACPT RAIMGTYP
|
|---|
| 143 | S MAGDTH=$$FMTH^XLFDT($P(RADATA,U,7),1)
|
|---|
| 144 | S X=$P(RADATA,U,18)
|
|---|
| 145 | S RAIMGTYP=$S(X]"":$O(^RA(79.2,"C",X,"")),1:X)
|
|---|
| 146 | 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)
|
|---|
| 147 | Q
|
|---|
| 148 | ;
|
|---|
| 149 | SVMAG2B ; For exams whose CPTs match, select a subset that are within defined
|
|---|
| 150 | ; limits with respect to time interval & maximum # exams to retrieve
|
|---|
| 151 | ; Return MAGGRY(0) = count ^ message
|
|---|
| 152 | ; MAGGRY(1:N) = "M08" | RADFN ^ RADTI ^ RACNI ^ RARPT
|
|---|
| 153 | N CPT,CT,CURDAT,ICPT,IREC,GO
|
|---|
| 154 | S CURDAT=$P(MAGGRY(1),U,4)
|
|---|
| 155 | F IREC=2:1:MAGGRY(0) S X=MAGGRY(IREC),CPT=+X D K MAGGRY(IREC)
|
|---|
| 156 | . 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
|
|---|
| 157 | . S Y=$G(GO(CPT))+1 I CPT,(Y>$P(X,U,3)) Q ; already have enough cases
|
|---|
| 158 | . S GO(CPT)=Y,GO(CPT,Y)=X
|
|---|
| 159 | K MAGGRY
|
|---|
| 160 | I $D(GO) S CT=0,CPT="" D
|
|---|
| 161 | . F S CPT=$O(GO(CPT)) Q:CPT="" F ICPT=1:1:GO(CPT) D
|
|---|
| 162 | .. S CT=CT+1,X=GO(CPT,ICPT),RARPT=$P(X,U,11)
|
|---|
| 163 | .. S MAGGRY(CT)="M08^"_CPT_"|"_$P(X,U,8,11)
|
|---|
| 164 | .. I ACTION="P"!(ACTION="A") S Y=$$JBFETCH^MAGJUTL2(RARPT) ; fetch from jukebox
|
|---|
| 165 | . S MAGGRY(0)=CT_"^"_HDR
|
|---|
| 166 | E S MAGGRY(0)="0^No Exams Found for "_HDR
|
|---|
| 167 | Q
|
|---|
| 168 | ;
|
|---|
| 169 | END ;
|
|---|
