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

MAGVRS81.m

Go to the documentation of this file.
  1. MAGVRS81 ;WOIFO/MLH - RPC calls for DICOM file processing ; 12 Apr 2010 5:45 PM
  1. ;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
  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. GETRPROC(OUT,ACCNUM) ; Call from GETPINFO^MAGVRS08 - get radiology procedure information
  1. N RPTIX,RPTREC,EXAMDT,MAGD0,MAGD1,V,MAGD2,EXAMREC,OUTIX
  1. N EXAMCODE,EXAMCODEREC,EXAMDESC,EXAMCODECPT,CPTREC,CPTCODE,CPTDESC,REFPHY,TERMGY
  1. S RPTIX=$O(^RARPT("B",ACCNUM,"")) ; ICR 3323
  1. I RPTIX="" S OUT(1)="-21"_SSEP_SSEP_"Accession number doesn't point to Radiology report" Q
  1. S RPTREC=$G(^RARPT(RPTIX,0))
  1. I RPTREC="" S OUT(1)="-22"_SSEP_SSEP_"Radiology report record not found" Q
  1. S EXAMDT=$P(RPTREC,"^",3)
  1. S MAGD0=$P(RPTREC,"^",2)
  1. S MAGD1=9999999.9999-EXAMDT
  1. S V=$P(RPTREC,"^",4)
  1. I $L(MAGD0)*$L(MAGD1)*$L(V)=0 D Q
  1. . S OUT(1)="-23"_SSEP_SSEP_"Radiology exam reference pointers not found" Q
  1. . Q
  1. S MAGD2=$O(^RADPT(MAGD0,"DT",MAGD1,"P","B",V,"")) ; ICR 65
  1. I MAGD2="" S OUT(1)="-24"_SSEP_SSEP_"Radiology exam record pointer not found" Q
  1. S EXAMREC=$G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0))
  1. I EXAMREC="" S OUT(1)="-25"_SSEP_SSEP_"Radiology exam record not found" Q
  1. ;
  1. ; EXAM FOUND - populate attributes to return
  1. S EXAMCODE=$P(EXAMREC,"^",2),TERMGY="LOCAL"
  1. D:EXAMCODE
  1. . S EXAMCODEREC=$G(^RAMIS(71,EXAMCODE,0))
  1. . S EXAMDESC=$P(EXAMCODEREC,"^",1)
  1. . S EXAMCODECPT=$P(EXAMCODEREC,"^",9)
  1. . D:EXAMCODECPT'=""
  1. . . S CPTREC=$$CPT^ICPTCOD(EXAMCODECPT,EXAMDT) ; ICR 1995
  1. . . S CPTCODE=$P(CPTREC,"^",2)
  1. . . S CPTDESC=$P(CPTREC,"^",3)
  1. . . D:$L(CPTCODE)*$L(CPTDESC)
  1. . . . S EXAMCODE=CPTCODE
  1. . . . S EXAMDESC=CPTDESC
  1. . . . S TERMGY=$P(CPTREC,"^",5)
  1. . . . S TERMGY=$S(TERMGY="C":"CPT",TERMGY="H":"HCPCS",TERMGY="L":"LOCAL",1:"")
  1. . . . Q
  1. . . Q
  1. . Q
  1. S REFPHY=$$GET1^DIQ(200,(+$P(EXAMREC,"^",14))_",",.01)
  1. S OUTIX=0
  1. D:$G(EXAMDESC)'="" POP(.OUT,"DESCRIPTION",EXAMDESC)
  1. D:$G(EXAMDT)'="" POP(.OUT,"DATE/TIME",$$CVTDT(EXAMDT))
  1. D:$G(EXAMCODE)'="" POP(.OUT,"PROCEDURE CODE",EXAMCODE)
  1. D:$G(TERMGY)'="" POP(.OUT,"TERMINOLOGY",TERMGY)
  1. D POP(.OUT,"CODING AUTHORITY","USDVA")
  1. D:$G(REFPHY)'="" POP(.OUT,"REFERRING PHYSICIAN",REFPHY)
  1. Q
  1. GETRRPT(OUT,ACCNUM) ; Call from GETPINFO^MAGVRS08 - get a radiology report
  1. N RPTIX,RPTIEN,TEXT,RET,ERR,TXTIX,OSEP,ISEP,SSEP
  1. S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
  1. I ACCNUM="" S OUT(1)="-51"_SSEP_SSEP_"No accession number provided" Q
  1. ; look up reports for this accession number - ICR 2479
  1. K ^TMP("DILIST",$J)
  1. D LIST^DIC(74,,"6I;7I",,,,ACCNUM,"B")
  1. ; did Lister encounter an exception?
  1. I $D(^TMP("DIERR",$J)) D Q ; yes, exception encountered; report and terminate
  1. . S OUT(1)="-53"_SSEP_SSEP_$G(^TMP("DIERR",$J,1,"TEXT",1))
  1. . Q
  1. I '$D(^TMP("DILIST",$J,1)) D Q ; no, but no report on file; bail
  1. . S OUT(1)="-52"_SSEP_SSEP_"No report on file for this exam"
  1. . Q
  1. ; no exception encountered, report results
  1. S RPTIX=0
  1. F S RPTIX=$O(^TMP("DILIST",$J,2,RPTIX)) Q:'RPTIX D
  1. . S RPTIEN=^TMP("DILIST",$J,2,RPTIX) Q:'RPTIEN
  1. . S RET=$$GET1^DIQ(74,RPTIEN_",",200,,"TEXT") Q:'$D(TEXT) ; no report text, plow on
  1. . D POP(.OUT,"REPORT INDEX",RPTIEN)
  1. . D POP(.OUT,"DATE REPORT ENTERED",$$CVTDT($G(^TMP("DILIST",$J,"ID",RPTIX,6))))
  1. . D POP(.OUT,"VERIFIED DATE",$$CVTDT($G(^TMP("DILIST",$J,"ID",RPTIX,7))))
  1. . D POP(.OUT,"REPORT TEXT",.TEXT)
  1. . Q
  1. K ^TMP("DILIST",$J),^TMP("DIERR",$J)
  1. Q
  1. ;
  1. POP(ARY,NAME,VALUE) ; populate an array with a name value pair
  1. N IX
  1. S:$D(VALUE)#10 ARY($O(ARY(" "),-1)+1)=NAME_OSEP_VALUE_SSEP
  1. S IX=0
  1. F S IX=$O(VALUE(IX)) Q:'IX S ARY($O(ARY(" "),-1)+1)=NAME_OSEP_VALUE(IX)_SSEP
  1. Q
  1. CVTDT(FMDT) ; convert from FM to ISO date
  1. Q $S(FMDT:(17000000+$P(FMDT,".",1))_"."_$P($J(FMDT#1,0,6),".",2),1:"")