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

MAGVRS08.m

Go to the documentation of this file.
  1. MAGVRS08 ;WOIFO/MLH,NST - RPC calls for DICOM file processing ; 28 Feb 2012 3:51 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. GETPATA(OUT,PATREFIEN) ; RPC - MAGV GET PAT REF ATTS
  1. D REFRESH^MAGVRS41(.OUT,2005.6,PATREFIEN,0,1)
  1. Q
  1. GETPROCA(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET PROC REF ATTS
  1. D REFRESH^MAGVRS41(.OUT,2005.61,PROCREFIEN,$G(PATREFIEN),$G(OVERRIDE))
  1. Q
  1. GETPATI(OUT,PATREFIEN) ; RPC - MAGV GET PAT INFO
  1. ; Currently works for VA patients only
  1. N OSEP,ISEP,SSEP,PATREFATTS,I,PATREFATTNAM
  1. N NAMEVAL,FMPREF,PATATTS,ERROR,OUTIX,DOB,PTSENS
  1. S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
  1. I $D(PATREFIEN)#10=0 S OUT(1)="-1"_SSEP_SSEP_"PATIENT REFERENCE IEN NOT RECEIVED" Q
  1. I +PATREFIEN'=PATREFIEN S OUT(1)="-2"_SSEP_SSEP_"INVALID PATIENT REFERENCE IEN FORMAT" Q
  1. I '$D(^MAGV(2005.6,PATREFIEN)) S OUT(1)="-3"_SSEP_SSEP_"PATIENT REFERENCE NOT FOUND" Q
  1. D REFRESH^MAGVRS41(.PATREFATTS,2005.6,PATREFIEN,0,1)
  1. I $G(PATREFATTS(1)) S OUT(1)=PATREFATTS(1) Q ; error in pt attribute fetch
  1. S I=1
  1. F S I=$O(PATREFATTS(I)) Q:'I D
  1. . S NAMEVAL=$P(PATREFATTS(I),SSEP,1)
  1. . S PATREFATTNAM($P(NAMEVAL,OSEP,1))=$P(NAMEVAL,OSEP,2)
  1. . Q
  1. I $G(PATREFATTNAM("ID TYPE"))'="D" S OUT(1)="-4"_SSEP_SSEP_"VA DFNs ONLY" Q
  1. I '$G(PATREFATTNAM("ENTERPRISE PATIENT ID")) S OUT(1)="-5"_SSEP_SSEP_"MISSING ENTERPRISE PATIENT ID" Q
  1. S FMPREF=PATREFATTNAM("ENTERPRISE PATIENT ID")
  1. N DFN,VA,VADM,VAERR,TMP
  1. S DFN=FMPREF
  1. D DEM^VADPT ; Supported IA (#10061)
  1. I +$G(VAERR) S OUT(1)=(-$G(VAERR))_SSEP_SSEP_"NO PATIENT INFO("_DFN_")" Q
  1. ; VADM(1)=Patient's name
  1. ; VADM(5)=Patient's sex (M^MALE)
  1. ; VADM(3)=Patient's DOB (internal^external)
  1. S TMP=$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI") ; Supported IA (#2701)
  1. S OUTIX=1,OUT(OUTIX)=0_SSEP
  1. S OUTIX=OUTIX+1,OUT(OUTIX)="ICN"_OSEP_TMP_SSEP
  1. S:$D(VA("PID")) OUTIX=OUTIX+1,OUT(OUTIX)="PID"_OSEP_$TR(VA("PID"),"-","")_SSEP
  1. S:$D(VADM(1)) OUTIX=OUTIX+1,OUT(OUTIX)="NAME"_OSEP_VADM(1)_SSEP
  1. S:$D(VADM(5)) OUTIX=OUTIX+1,OUT(OUTIX)="SEX"_OSEP_$P(VADM(5),"^")_SSEP
  1. S:$G(VADM(3)) OUTIX=OUTIX+1,OUT(OUTIX)="DOB"_OSEP_(17000000+VADM(3))_SSEP
  1. ; pt sensitivity
  1. K PTSENS S:'$G(DUZ) DUZ=.5 D PTSEC^DGSEC4(.PTSENS,FMPREF) ; ICR 3027
  1. S:$D(PTSENS(1))#10 OUTIX=OUTIX+1,OUT(OUTIX)="PATIENT SENSITIVITY"_OSEP_PTSENS(1)_SSEP
  1. Q
  1. GETACCNO(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET ACCESSION NUM
  1. N OSEP,ISEP,SSEP,ATTARY,ATTIX,ATTDTA,ACCNUM
  1. S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
  1. D REFRESH^MAGVRS41(.ATTARY,2005.61,PROCREFIEN,$G(PATREFIEN),$G(OVERRIDE))
  1. I ATTARY(1) S OUT(1)=ATTARY(1) Q ; an exception was found
  1. S ATTIX=1
  1. F S ATTIX=$O(ATTARY(ATTIX)) Q:'ATTIX D Q:$D(ACCNUM)
  1. . S ATTDTA=ATTARY(ATTIX)
  1. . S:$P(ATTDTA,OSEP,1)="ACCESSION NUMBER" ACCNUM=$P(ATTDTA,OSEP,2)
  1. . Q
  1. S OUT=$S($G(ACCNUM)'="":0_SSEP_ACCNUM,1:-99_SSEP_SSEP_"Accession number not defined")
  1. Q
  1. GETPROCI(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET PROCEDURE INFO
  1. N OSEP,ISEP,SSEP,PROCARY,ACCRETURN,ACCNUM,PROCARYIX,NAMVAL,SPCLTY,ACCNUM
  1. S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
  1. D GETPROCA(.PROCARY,$G(PATREFIEN),$G(PROCREFIEN),$G(OVERRIDE))
  1. I $G(PROCARY(1)) S OUT(1)=PROCARY(1) Q ; an exception was found
  1. S PROCARYIX=1
  1. F S PROCARYIX=$O(PROCARY(PROCARYIX)) Q:'PROCARYIX D
  1. . S NAMVAL=$P(PROCARY(PROCARYIX),SSEP,1)
  1. . I $P(NAMVAL,OSEP,1)="PROCEDURE TYPE" S SPCLTY=$P(NAMVAL,OSEP,2) Q
  1. . I $P(NAMVAL,OSEP,1)="ACCESSION NUMBER" S ACCNUM=$P(NAMVAL,OSEP,2) Q
  1. . Q
  1. I $G(SPCLTY)="" S OUT(1)="-21"_SSEP_SSEP_"No specialty associated with procedure reference" Q
  1. I $G(ACCNUM)="" S OUT(1)="-22"_SSEP_SSEP_"No accession number associated with procedure reference" Q
  1. I SPCLTY="RAD" D GETRPROC^MAGVRS81(.OUT,ACCNUM) Q
  1. I SPCLTY="CON" D GETCPROC^MAGVRS82(.OUT,ACCNUM) Q
  1. S OUT(1)="-199"_SSEP_SSEP_"Specialty "_SPCLTY_" not processed at this time" Q
  1. Q
  1. ;
  1. GETRPT(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET REPORT
  1. N OSEP,ISEP,SSEP,ACCRETURN,ACCNUM,PROCARYIX,NAMVAL,SPCLTY,ACCNUM
  1. S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
  1. D GETPROCA(.PROCARY,$G(PATREFIEN),$G(PROCREFIEN),$G(OVERRIDE))
  1. I $G(PROCARY(1)) S OUT(1)=PROCARY(1) Q ; an exception was found
  1. S PROCARYIX=1
  1. F S PROCARYIX=$O(PROCARY(PROCARYIX)) Q:'PROCARYIX D
  1. . S NAMVAL=$P(PROCARY(PROCARYIX),SSEP,1)
  1. . I $P(NAMVAL,OSEP,1)="PROCEDURE TYPE" S SPCLTY=$P(NAMVAL,OSEP,2) Q
  1. . I $P(NAMVAL,OSEP,1)="ACCESSION NUMBER" S ACCNUM=$P(NAMVAL,OSEP,2) Q
  1. . Q
  1. I $G(SPCLTY)="" S OUT(1)="-21"_SSEP_SSEP_"No specialty associated with procedure reference" Q
  1. I $G(ACCNUM)="" S OUT(1)="-22"_SSEP_SSEP_"No accession number associated with procedure reference" Q
  1. I SPCLTY="RAD" D GETRRPT^MAGVRS81(.OUT,ACCNUM) Q
  1. I SPCLTY="CON" D GETCRPT^MAGVRS82(.OUT,ACCNUM) Q
  1. S OUT(1)="-199"_SSEP_SSEP_"Specialty "_SPCLTY_" not processed at this time" Q
  1. Q
  1. POP(ARY,NAME,VALUE) ; populate an array with a name value pair
  1. S ARY($O(ARY(" "),-1)+1)=NAME_OSEP_VALUE_SSEP
  1. Q