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

MAGDRPCC.m

Go to the documentation of this file. 
  1. MAGDRPCC ;WOIFO/PMK - Imaging RPCs ; Mar 07, 2022@09:43:28
  1.  ;;3.0;IMAGING;**138,305**;Mar 19, 2002;Build 3
  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.  ;
  1. CONLKUP(OUT,ACNUMB) ; RPC = MAG DICOM LOOKUP CON STUDY
  1.  ; Consult patient/study lookup
  1.  N A ;-------- array data from $$GETS^DIQ
  1.  N CPTIEN ;--- ien for file #81
  1.  N CPTCODE ;-- CPT code for the procedure
  1.  N CPTNAME ;-- CPT name for the procedure
  1.  N CPTSCHM ;-- CPT coding scheme
  1.  N DATETIME ;- timestamp
  1.  N DFN ;------ patient pointer
  1.  N EXAMSTS ;-- exam status (don't post images to CANCELLED exams)
  1.  N GMRCIEN ;-- IEN for REQUEST/CONSULTATION file (#123)
  1.  N GMRCIENS ;- GMRC concatenated with a comma (for GETS^DIQ results)
  1.  N PROCEDURE ; procedure (#123.3) <internal ^ external>
  1.  N PROCIEN ;-- radiology procedure ien in ^RAMIS(71)
  1.  N SERVICE ;-- request service (#123.5) <internal ^ external)>
  1.  N TIMESTAMP ; date/time of last activity
  1.  N VACODE ;--- VA code for the procedure
  1.  N VANAME ;--- VA name for the procedure
  1.  N VASCHM ;-- VA coding scheme
  1.  N IEN,X
  1.  ; find the patient/study in ^GMR using the Consult Accession Number
  1.  K OUT
  1.  ;
  1.  I $G(ACNUMB)="" S OUT(1)="-1,No Accession Number Specified" Q
  1.  ;
  1.  S GMRCIEN=$$GMRCIEN^MAGDFCNV(ACNUMB),GMRCIENS=GMRCIEN_","
  1.  ;
  1.  D GETS^DIQ(123,GMRCIEN,"**","EI","A")
  1.  I '$D(A) S OUT(1)="-2,Error in Accession Number Lookup" Q
  1.  ;
  1.  ; get patient demographics file pointer
  1.  S DFN=A(123,GMRCIENS,.02,"I")
  1.  ;
  1.  ; get the request service and procedure (if present)
  1.  S SERVICE=A(123,GMRCIENS,1,"I")_"^"_A(123,GMRCIENS,1,"E")
  1.  S X=A(123,GMRCIENS,4,"I") I X?1N.N1";GMR(123.3," S X=$P(X,";",1)
  1.  S PROCEDURE=X_"^"_A(123,GMRCIENS,4,"E")
  1.  I PROCEDURE="^" D  ; consult
  1.  . S VACODE="C"_$P(SERVICE,"^",1)
  1.  . S VANAME=$P(SERVICE,"^",2)
  1.  . S VASCHM="99CON"
  1.  . Q
  1.  E  D  ; procedure
  1.  . S VACODE="P"_$P(PROCEDURE,"^",1)
  1.  . S VANAME=$P(PROCEDURE,"^",2)
  1.  . S VASCHM="99PROC"
  1.  . Q
  1.  ;
  1.  ; get CPT code and CPT name
  1.  S IEN=$$IREQUEST^MAGDHOW1(+SERVICE,+PROCEDURE)
  1.  I IEN S CPTIEN=$P(^MAG(2006.5831,IEN,0),"^",6)
  1.  E  S CPTIEN=""
  1.  I CPTIEN'="" D
  1.  . S CPTCODE=$$GET1^DIQ(81,CPTIEN,.01)
  1.  . S CPTNAME=$$GET1^DIQ(81,CPTIEN,2)
  1.  . S CPTSCHM="C4"
  1.  . Q
  1.  E  D  ; use VA values for CPT
  1.  . S CPTCODE=VACODE
  1.  . S CPTNAME=VANAME
  1.  . S CPTSCHM=VASCHM
  1.  . Q
  1.  ;
  1.  ; get exam status
  1.  S EXAMSTS=A(123,GMRCIENS,8,"E")
  1.  ;
  1.  S TIMESTAMP=A(123.02,"1,"_GMRCIENS,2,"I")
  1.  ;
  1.  ; stuff the data into the return array
  1.  ;
  1.  S OUT(1)=1 ; OK
  1.  S OUT(2)=DFN
  1.  S OUT(3)=SERVICE
  1.  S OUT(4)=PROCEDURE
  1.  S OUT(5)=VACODE
  1.  S OUT(6)=VANAME
  1.  S OUT(7)=VASCHM
  1.  S OUT(8)=CPTCODE
  1.  S OUT(9)=CPTNAME
  1.  S OUT(10)=CPTSCHM
  1.  S OUT(11)=$G(TIMESTAMP)
  1.  S OUT(12)=EXAMSTS
  1.  S OUT(13)=$$STATNUMB^MAGDFCNV()
  1.  S OUT(14)=$$GMRCACN^MAGDFCNV(GMRCIEN)
  1.  S OUT(15)=GMRCIEN
  1.  Q
  1.  ;
  1. XMITSTAT(OUT,D0) ; RPC = MAG DICOM GET XMIT STATS
  1.  ; return statistics array for a DICOM Export
  1.  N D1,STATUS,X
  1.  K OUT
  1.  I '$G(D0) S OUT="-1,IEN for DICOM OBJECT EXPORT file (#2006.574) is missing" Q
  1.  I '$D(^MAGDOUTP(2006.574,D0)) S OUT="-2,No entry #"_D0_" in DICOM OBJECT EXPORT file (#2006.574)" Q
  1.  S OUT=1 ; indicate output
  1.  S D1=0 F  S D1=$O(^MAGDOUTP(2006.574,D0,1,D1)) Q:'D1  D
  1.  . S X=$G(^MAGDOUTP(2006.574,D0,1,D1,0))
  1.  . S STATUS=$P(X,"^",2)
  1.  . S OUT(STATUS)=($P($G(OUT(STATUS)),"^",1)+1)_"^"_STATUS
  1.  . Q
  1.  Q