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

MAGVORDR.m

Go to the documentation of this file. 
  1. MAGVORDR ;WOIFO/RRB/BT/PMK/DAC/JSJ - MAGV Order Lookup ; 14 Jul 2021@10:07:45
  1.  ;;3.0;IMAGING;**118,138,156,307**;Mar 19, 2002;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.  ;
  1.  ; Reference to FIND1^DIC in ICR #2051
  1.  ; Reference to GET1^DIQ in ICR #2056
  1.  ; Reference to ACCFIND^RAAPI in ICR #5020
  1.  ;
  1.  ;
  1.  ; Lookup the patient/study in the imaging service's database
  1.  ; The imaging service, IMGSVC (RAD or CON), and case number, CASENUMB(accession)
  1.  ; are required variables that must be passed to the LOOKUP subroutine.
  1.  ; 
  1.  ; Output will be in the form of a string:
  1.  ; 
  1.  ;     Happy case example: 0~DFN~SITE (0~12345~660)
  1.  ;     
  1.  ;     Incorrect accession # format or not present: -1~BAD CASE #
  1.  ;     
  1.  ;     No case on file: -1~NO CASE #
  1.  Q
  1.  ;
  1. LOOKUP(CASENUMB,IMGSVC) ; MAGV Order Lookup
  1.  ;
  1.  N RADATA
  1.  ;
  1.  I "^RAD^CON^LAB^"'[("^"_IMGSVC_"^") Q "-1~INVALID IMAGE SERVICE"
  1.  I $G(CASENUMB)="" Q "-1~BAD CASE #"
  1.  ; 
  1.  I IMGSVC="RAD" D
  1.  . S RADATA=$$RADLKUP(CASENUMB)
  1.  . Q
  1.  E  I IMGSVC="CON" D
  1.  . I '$$GMRCIEN^MAGDFCNV(CASENUMB) S RADATA="-1~BAD CASE #" Q
  1.  . S RADATA=$$CONLKUP(CASENUMB)
  1.  . Q
  1.  E  I IMGSVC="LAB" D  ; P138
  1.  . S RADATA=$$LABLKUP(CASENUMB)
  1.  . Q
  1.  ;
  1.  Q RADATA
  1.  ;
  1. RADLKUP(CASENUMB) ; Radiology patient/study lookup
  1.  ;
  1.  N CPTCODE ;-- CPT code for the procedure
  1.  N CPTNAME ;-- CPT name for the procedure
  1.  N DFN
  1.  N EXAMSTS ;-- Exam status (don't post images to CANCELLED exams)
  1.  N PROCIEN ;-- radiology procedure ien in ^RAMIS(71)
  1.  N RAIX ;----- cross reference subscript for case number lookup
  1.  N RADPT1 ;--- first level subscript in ^RADPT
  1.  N RADPT2 ;--- second level subscript in ^RADPT (after "DT")
  1.  N RADPT3 ;--- third level subscript in ^RADPT (after "P")
  1.  N SITE
  1.  N I,LIST,VARIABLE,X,Z
  1.  ;
  1.  ; find the patient/study in ^RARPT using the Radiology Case Number
  1.  ; 
  1.  S X=$S(CASENUMB'["-"!($L($T(ACCFIND^RAAPI))=0):$$OLDCASE(CASENUMB,.LIST),1:$$ACCFIND^RAAPI(CASENUMB,.LIST))
  1.  I X'=1 Q "-1~NO CASE #"  ; No Case
  1.  ;
  1.  S X=LIST(1) ; two conditions, no accession number & duplicate
  1.  S RADPT1=$P(X,"^",1),RADPT2=$P(X,"^",2),RADPT3=$P(X,"^",3)
  1.  I RADPT1=""!(RADPT2="")!(RADPT3="") Q "-1~BAD CASE #"
  1.  ;
  1.  I '$D(^RADPT(RADPT1,0)) Q "-1~NO CASE #"  ; no patient demographics file pointer
  1.  ;
  1.  ; get patient demographics file pointer
  1.  S X=^RADPT(RADPT1,0),DFN=$P(X,"^")
  1.  S SITE=$P($G(^RADPT(RADPT1,"DT",RADPT2,0)),"^",3)
  1.  ;
  1.  ; do not include cancelled exam
  1.  S EXAMSTS=$P($G(^RADPT(RADPT1,"DT",RADPT2,"P",RADPT3,0)),"^",3) ; P156 DAC - Fixed undefined error
  1.  I EXAMSTS="" Q "-1~BAD CASE #"
  1.  S EXAMSTS=$$GET1^DIQ(72,EXAMSTS,.01)
  1.  I EXAMSTS="" Q "-1~BAD CASE #"
  1.  I EXAMSTS="CANCELLED" Q "-1~NO CASE #"
  1.  ;
  1.  Q "0~"_DFN_"~"_SITE
  1.  ;
  1. CONLKUP(CASENUMB) ; CPRS Consult/Procedure patient/study lookup
  1.  ;
  1.  N DFN
  1.  N EXAMSTS ;-- Exam status (don't post images to CANCELLED exams)
  1.  N GMRCIEN
  1.  N SITE
  1.  ;
  1.  S GMRCIEN=$$GMRCIEN^MAGDFCNV(CASENUMB)
  1.  S DFN=$$GET1^DIQ(123,GMRCIEN,.02,"I")
  1.  I DFN="" Q "-1~NO CASE #" ; no patient demographics file pointer
  1.  S SITE=$$GET1^DIQ(123,GMRCIEN,.05,"I")
  1.  I SITE="" Q "-1~NO CASE #"  ; incomplete consult study
  1.  ;
  1.  S EXAMSTS=$$GET1^DIQ(123,GMRCIEN,8) ; check for cancelled exam
  1.  I EXAMSTS="CANCELLED" Q "-1~NO CASE #"
  1.  ;
  1.  Q "0~"_DFN_"~"_SITE
  1.  ;
  1. OLDCASE(CASENUMB,LIST)  ; Lookup case numbers using old method
  1.  ;
  1.  S RAIX=$S($D(^RADPT("C")):"C",CASENUMB["-":"ADC",1:"AE") ; for Radiology Patch RA*5*7
  1.  S RADPT1=$O(^RADPT(RAIX,CASENUMB,"")) I 'RADPT1 Q 0
  1.  S RADPT2=$O(^RADPT(RAIX,CASENUMB,RADPT1,"")) I 'RADPT2 Q 0
  1.  S RADPT3=$O(^RADPT(RAIX,CASENUMB,RADPT1,RADPT2,"")) I 'RADPT3 Q 0
  1.  S LIST(1)=RADPT1_"^"_RADPT2_"^"_RADPT3
  1.  Q 1  ; Success
  1.  ;
  1.  ;
  1. LABLKUP(ACNUMB) ; Lab patient/study lookup - P138
  1.  N FMYEAR,LRAA,LRDFN,LRSS,IENS,YEAR,CASE,SITE,ABBR  ;P307
  1.  S ABBR=$P(ACNUMB," ",1),YEAR=$P(ACNUMB," ",2),CASE=$P(ACNUMB," ",3)  ;P307
  1.  S LRAA=$$FIND1^DIC(68,"","BX",ABBR,"","","ERR") ; get lab area index ;P307
  1.  S FMYEAR="3"_YEAR_"0000"
  1.  S IENS=CASE_","_FMYEAR_","_LRAA
  1.  ; lookup in ACCESSION file (#68)
  1.  S LRDFN=$$GET1^DIQ(68.02,IENS,.01)
  1.  I LRDFN="" Q "-1~PATIENT NOT IN LAB FILE" ; patient not in LAB DATA file (#63)
  1.  S SITE=$$GET1^DIQ(68.02,IENS,26,"I")
  1.  I $$GET1^DIQ(68.02,IENS,1)'="PATIENT" Q "-1~WRONG PATIENT" ; patient not in PATIENT file (#2)
  1.  I $$GET1^DIQ(68.02,IENS,15)'=CASENUMB Q "-1~WRONG SPECIMEN" ; not right specimen
  1.  ; lookup in LAB DATA file (#63)
  1.  I $$GET1^DIQ(63,LRDFN,.02)'="PATIENT" Q "-1~PATIENT NOT ON FILE" ; patient not in PATIENT file (#2)
  1.  S DFN=$$GET1^DIQ(63,LRDFN,.03,"I")
  1.  Q "0~"_DFN_"~"_SITE