MAGNPCHE ;WOIFO/NST - Pre-Cach RPC calls; OCT 18, 2018@4:05 PM
;;3.0;IMAGING;**221**;Mar 19, 2002;Build 27;May 23, 2012
;; 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
;***** PRE-CACHE PATIENT EXAM BY CPT
;
; RPC: MAGN PRECACHE BY CPT
;
; .MAGOUT Reference to a local variable where the results are returned to
; IDTYPE - "DFN" or "ICN"
; ID = Patient DFN or ICN
; CPT - CPT Code to search for prior patient exams
;
; Return Values
; =============
; MAGRY(0) if error 0^error message
; MAGRY(1..n) = SITE NUMBER ^ DFN ^ ICN ^ CPRSCONTEXTID
;
PRECACHE(MAGRY,IDTYPE,ID,CPT) ; RPC [MAGN PRECACHE BY CPT]
N DFN,BEGDT,CHK,CNT,LIMYRS,LIMEXAMS,IDAT,MAGRET,RADATA,RARPT,MAGCPTS,Y
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGSERR"
;
S MAGRY(0)=1
;
S CNT=0
I (IDTYPE'="DFN")&(IDTYPE'="ICN") S MAGRY(0)="0^Invalid IDTYPE "_IDTYPE Q
;
S DFN=$G(ID)
I IDTYPE="ICN" D
. S DFN=$S($T(GETDFN^MPIF001)'="":$$GETDFN^MPIF001(ID),1:"-1^NO MPI") ; Supported IA (#2701)
. Q
I DFN'>0 S MAGRY(0)="0^Error: "_DFN Q
;
S MAGCPTS=$$GETCPTS(CPT)
I 'MAGCPTS Q ; No rules defined for CPT
;
S LIMYRS=30 ; default limit
S LIMEXAMS=100 ; default # Exams
S BEGDT=($E(DT,1,3)-LIMYRS)_$E(DT,4,7)
I BEGDT<2950101 S BEGDT=2950101 ; 2 yrs prior to earliest VistaPACS
D GETEXAM3^MAGJUTL1(DFN,BEGDT,"",0,.MAGRET,"",LIMEXAMS) ; Get Patient's exams
S IDAT=""
F S IDAT=$O(^TMP($J,"MAGRAEX",IDAT)) Q:'IDAT D
. S RADATA=^TMP($J,"MAGRAEX",IDAT,1)
. S CHK=$$MATCHED(MAGCPTS,RADATA)
. I CHK D
. . S RARPT=+$P(RADATA,U,10)
. . S CNT=CNT+1,MAGRY(CNT)=$$GCPRSID^MAGNUTL2(RARPT) ; pre-cache exams
. . Q
. Q
;
K ^TMP($J,"MAGRAEX"),^TMP($J,"RAE1")
Q
;
GETCPTS(CPT) ; Get CPT to search for
; CPT - CPT to search for
N CPT3,CPT4,CPT5,MAGMATCH,X,Y
S MAGMATCH=""
S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3)
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
Q MAGMATCH
;
MATCHED(MAGCPTS,RADATA) ;
; Compare the patient's exams CPT codes to the
; MAGCPTS CPT code, according to dictionary 2006.65
N RADFN,RARPT,RADTI,RACNI,RAIMGTYP,X,Y
N CPT,MAGMATCH,MAGDTH
S RADFN=$P(RADATA,U,1)
S RARPT=+$P(RADATA,U,10)
S RADTI=$P(RADATA,U,2)
S RACNI=$P(RADATA,U,3)
;Q:$P(RADATA,U,15)<2 "" ; Cancel or Waiting
S CPT=$P(RADATA,U,17)
Q:'CPT ; algorithm REQUIRES CPT codes be used
;
S MAGMATCH=$$CPTMATCH(MAGCPTS,CPT)
;
Q MAGMATCH
;
CPTMATCH(MAGCPTS,CPT) ; Find CPT match
N CPT3,CPT4,CPT5,CURCPTS,CURCPTX,HIT,MAGMATCH,X,Y,I
;
I ('CPT)!('MAGCPTS) Q "" ; No CPT
;
S CURCPTS=MAGCPTS
S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3)
S MAGMATCH=""
S HIT=0
F Q:CURCPTS="" S CURCPTX=$O(^MAG(2006.65,"B",$P(CURCPTS,","),"")),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" Q:HIT D ;1st hit only
. . S CPT=@CPT
. . I CPT]"",$D(^MAG(2006.65,CURCPTX,1,"B",CPT)) D
. . . S HIT=1
. . . S X=$O(^MAG(2006.65,CURCPTX,1,"B",CPT,"")) D
. . . . S X=^MAG(2006.65,CURCPTX,1,X,0) S Y=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)
. . . . Q
. . . Q
. . Q
. Q
Q MAGMATCH
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNPCHE 4440 printed Sep 23, 2025@19:43:36 Page 2
MAGNPCHE ;WOIFO/NST - Pre-Cach RPC calls; OCT 18, 2018@4:05 PM
+1 ;;3.0;IMAGING;**221**;Mar 19, 2002;Build 27;May 23, 2012
+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 QUIT
+18 ;***** PRE-CACHE PATIENT EXAM BY CPT
+19 ;
+20 ; RPC: MAGN PRECACHE BY CPT
+21 ;
+22 ; .MAGOUT Reference to a local variable where the results are returned to
+23 ; IDTYPE - "DFN" or "ICN"
+24 ; ID = Patient DFN or ICN
+25 ; CPT - CPT Code to search for prior patient exams
+26 ;
+27 ; Return Values
+28 ; =============
+29 ; MAGRY(0) if error 0^error message
+30 ; MAGRY(1..n) = SITE NUMBER ^ DFN ^ ICN ^ CPRSCONTEXTID
+31 ;
PRECACHE(MAGRY,IDTYPE,ID,CPT) ; RPC [MAGN PRECACHE BY CPT]
+1 NEW DFN,BEGDT,CHK,CNT,LIMYRS,LIMEXAMS,IDAT,MAGRET,RADATA,RARPT,MAGCPTS,Y
+2 ;
+3 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGGSERR"
+4 ;
+5 SET MAGRY(0)=1
+6 ;
+7 SET CNT=0
+8 IF (IDTYPE'="DFN")&(IDTYPE'="ICN")
SET MAGRY(0)="0^Invalid IDTYPE "_IDTYPE
QUIT
+9 ;
+10 SET DFN=$GET(ID)
+11 IF IDTYPE="ICN"
Begin DoDot:1
+12 ; Supported IA (#2701)
SET DFN=$SELECT($TEXT(GETDFN^MPIF001)'="":$$GETDFN^MPIF001(ID),1:"-1^NO MPI")
+13 QUIT
End DoDot:1
+14 IF DFN'>0
SET MAGRY(0)="0^Error: "_DFN
QUIT
+15 ;
+16 SET MAGCPTS=$$GETCPTS(CPT)
+17 ; No rules defined for CPT
IF 'MAGCPTS
QUIT
+18 ;
+19 ; default limit
SET LIMYRS=30
+20 ; default # Exams
SET LIMEXAMS=100
+21 SET BEGDT=($EXTRACT(DT,1,3)-LIMYRS)_$EXTRACT(DT,4,7)
+22 ; 2 yrs prior to earliest VistaPACS
IF BEGDT<2950101
SET BEGDT=2950101
+23 ; Get Patient's exams
DO GETEXAM3^MAGJUTL1(DFN,BEGDT,"",0,.MAGRET,"",LIMEXAMS)
+24 SET IDAT=""
+25 FOR
SET IDAT=$ORDER(^TMP($JOB,"MAGRAEX",IDAT))
if 'IDAT
QUIT
Begin DoDot:1
+26 SET RADATA=^TMP($JOB,"MAGRAEX",IDAT,1)
+27 SET CHK=$$MATCHED(MAGCPTS,RADATA)
+28 IF CHK
Begin DoDot:2
+29 SET RARPT=+$PIECE(RADATA,U,10)
+30 ; pre-cache exams
SET CNT=CNT+1
SET MAGRY(CNT)=$$GCPRSID^MAGNUTL2(RARPT)
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 ;
+34 KILL ^TMP($JOB,"MAGRAEX"),^TMP($JOB,"RAE1")
+35 QUIT
+36 ;
GETCPTS(CPT) ; Get CPT to search for
+1 ; CPT - CPT to search for
+2 NEW CPT3,CPT4,CPT5,MAGMATCH,X,Y
+3 SET MAGMATCH=""
+4 SET CPT5=CPT
SET CPT4=$EXTRACT(CPT,1,4)
SET CPT3=$EXTRACT(CPT,1,3)
+5 SET Y=""
+6 ; Order of CPT5/4/3 is important for the algorithm, which
+7 ; uses the 1st rule found at the LOWEST level of detail defined
+8 FOR X=CPT5,CPT4,CPT3
IF $DATA(^MAG(2006.65,"B",X))
SET Y=Y_$SELECT(Y:",",1:"")_X
SET $PIECE(MAGMATCH,U)=Y
+9 QUIT MAGMATCH
+10 ;
MATCHED(MAGCPTS,RADATA) ;
+1 ; Compare the patient's exams CPT codes to the
+2 ; MAGCPTS CPT code, according to dictionary 2006.65
+3 NEW RADFN,RARPT,RADTI,RACNI,RAIMGTYP,X,Y
+4 NEW CPT,MAGMATCH,MAGDTH
+5 SET RADFN=$PIECE(RADATA,U,1)
+6 SET RARPT=+$PIECE(RADATA,U,10)
+7 SET RADTI=$PIECE(RADATA,U,2)
+8 SET RACNI=$PIECE(RADATA,U,3)
+9 ;Q:$P(RADATA,U,15)<2 "" ; Cancel or Waiting
+10 SET CPT=$PIECE(RADATA,U,17)
+11 ; algorithm REQUIRES CPT codes be used
if 'CPT
QUIT
+12 ;
+13 SET MAGMATCH=$$CPTMATCH(MAGCPTS,CPT)
+14 ;
+15 QUIT MAGMATCH
+16 ;
CPTMATCH(MAGCPTS,CPT) ; Find CPT match
+1 NEW CPT3,CPT4,CPT5,CURCPTS,CURCPTX,HIT,MAGMATCH,X,Y,I
+2 ;
+3 ; No CPT
IF ('CPT)!('MAGCPTS)
QUIT ""
+4 ;
+5 SET CURCPTS=MAGCPTS
+6 SET CPT5=CPT
SET CPT4=$EXTRACT(CPT,1,4)
SET CPT3=$EXTRACT(CPT,1,3)
+7 SET MAGMATCH=""
+8 SET HIT=0
+9 ; 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:1
+10 ; This algorithm checks from lowest detail to most general, and acts
+11 ; on the information found at the FIRST Hit only
+12 ;1st hit only
FOR CPT="CPT5","CPT4","CPT3"
if HIT
QUIT
Begin DoDot:2
+13 SET CPT=@CPT
+14 IF CPT]""
IF $DATA(^MAG(2006.65,CURCPTX,1,"B",CPT))
Begin DoDot:3
+15 SET HIT=1
+16 SET X=$ORDER(^MAG(2006.65,CURCPTX,1,"B",CPT,""))
Begin DoDot:4
+17 SET X=^MAG(2006.65,CURCPTX,1,X,0)
SET Y=5
SET X=$PIECE(X,U,Y,Y+2)
+18 IF +X
SET MAGMATCH=CPT
FOR I=2,3
SET $PIECE(MAGMATCH,U,I)=$PIECE(X,U,I)
+19 QUIT
End DoDot:4
+20 QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
if HIT
QUIT
+23 QUIT MAGMATCH
