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

MAGNPCHE.m

Go to the documentation of this file. 
  1. 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
  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.  Q
  1.  ;***** PRE-CACHE PATIENT EXAM BY CPT
  1.  ;
  1.  ; RPC: MAGN PRECACHE BY CPT
  1.  ;
  1.  ; .MAGOUT   Reference to a local variable where the results are returned to
  1.  ; IDTYPE    - "DFN" or "ICN"
  1.  ; ID        = Patient DFN or ICN
  1.  ; CPT       - CPT Code to search for prior patient exams
  1.  ;
  1.  ; Return Values
  1.  ; =============   
  1.  ; MAGRY(0) if error 0^error message
  1.  ; MAGRY(1..n) = SITE NUMBER ^ DFN ^ ICN ^ CPRSCONTEXTID 
  1.  ;
  1. PRECACHE(MAGRY,IDTYPE,ID,CPT) ; RPC [MAGN PRECACHE BY CPT]
  1.  N DFN,BEGDT,CHK,CNT,LIMYRS,LIMEXAMS,IDAT,MAGRET,RADATA,RARPT,MAGCPTS,Y
  1.  ;
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGSERR"
  1.  ;
  1.  S MAGRY(0)=1
  1.  ;
  1.  S CNT=0
  1.  I (IDTYPE'="DFN")&(IDTYPE'="ICN") S MAGRY(0)="0^Invalid IDTYPE "_IDTYPE Q
  1.  ;
  1.  S DFN=$G(ID)
  1.  I IDTYPE="ICN" D
  1.  . S DFN=$S($T(GETDFN^MPIF001)'="":$$GETDFN^MPIF001(ID),1:"-1^NO MPI") ; Supported IA (#2701)
  1.  . Q
  1.  I DFN'>0 S MAGRY(0)="0^Error: "_DFN Q
  1.  ;
  1.  S MAGCPTS=$$GETCPTS(CPT)
  1.  I 'MAGCPTS Q  ; No rules defined for CPT
  1.  ;
  1.  S LIMYRS=30    ; default limit
  1.  S LIMEXAMS=100 ; default # 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.  D GETEXAM3^MAGJUTL1(DFN,BEGDT,"",0,.MAGRET,"",LIMEXAMS)  ; Get Patient's exams
  1.  S IDAT=""
  1.  F  S IDAT=$O(^TMP($J,"MAGRAEX",IDAT)) Q:'IDAT  D
  1.  . S RADATA=^TMP($J,"MAGRAEX",IDAT,1)
  1.  . S CHK=$$MATCHED(MAGCPTS,RADATA)
  1.  . I CHK D
  1.  . . S RARPT=+$P(RADATA,U,10)
  1.  . . S CNT=CNT+1,MAGRY(CNT)=$$GCPRSID^MAGNUTL2(RARPT)  ; pre-cache exams
  1.  . . Q
  1.  . Q
  1.  ;
  1.  K ^TMP($J,"MAGRAEX"),^TMP($J,"RAE1")
  1.  Q
  1.  ;
  1. GETCPTS(CPT)  ; Get CPT to search for
  1.  ; CPT - CPT to search for
  1.  N CPT3,CPT4,CPT5,MAGMATCH,X,Y
  1.  S MAGMATCH=""
  1.  S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3)
  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.  Q MAGMATCH
  1.  ;
  1. MATCHED(MAGCPTS,RADATA) ;
  1.  ; Compare the patient's exams CPT codes to the
  1.  ; MAGCPTS CPT code, according to dictionary 2006.65
  1.  N RADFN,RARPT,RADTI,RACNI,RAIMGTYP,X,Y
  1.  N CPT,MAGMATCH,MAGDTH
  1.  S RADFN=$P(RADATA,U,1)
  1.  S RARPT=+$P(RADATA,U,10)
  1.  S RADTI=$P(RADATA,U,2)
  1.  S RACNI=$P(RADATA,U,3)
  1.  ;Q:$P(RADATA,U,15)<2 ""          ; Cancel or Waiting
  1.  S CPT=$P(RADATA,U,17)
  1.  Q:'CPT  ;  algorithm REQUIRES CPT codes be used
  1.  ;
  1.  S MAGMATCH=$$CPTMATCH(MAGCPTS,CPT)
  1.  ;
  1.  Q MAGMATCH
  1.  ;
  1. CPTMATCH(MAGCPTS,CPT) ; Find CPT match
  1.  N CPT3,CPT4,CPT5,CURCPTS,CURCPTX,HIT,MAGMATCH,X,Y,I
  1.  ;
  1.  I ('CPT)!('MAGCPTS) Q ""  ; No CPT
  1.  ;
  1.  S CURCPTS=MAGCPTS
  1.  S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3)
  1.  S MAGMATCH=""
  1.  S HIT=0
  1.  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
  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" Q:HIT  D  ;1st hit only
  1.  . . S CPT=@CPT
  1.  . . I CPT]"",$D(^MAG(2006.65,CURCPTX,1,"B",CPT)) D
  1.  . . . S HIT=1
  1.  . . . S X=$O(^MAG(2006.65,CURCPTX,1,"B",CPT,"")) D
  1.  . . . . S X=^MAG(2006.65,CURCPTX,1,X,0) S Y=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.  . . . . Q
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  Q MAGMATCH