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

MAGNU003.m

Go to the documentation of this file.
  1. MAGNU003 ;WOIFO/NST - Misc fuctions for image list ; 16 Jan 2018 3:42 AM
  1. ;;3.0;IMAGING;**185,269**;Mar 19, 2002;Build 8;Feb 28, 2011
  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. STDINFO(IMGIEN,REFTYPE,REFIEN,MAGNCXT) ; Get study info by image IEN in file #2005 or #2005.1
  1. ; IMGIEN -- Image IEN
  1. ; REFTYPE = "RAD", "TIU"
  1. ; REFIEN = IEN in respective file of REFTYPE
  1. ; MAGNCXT = CPRS Context ID
  1. ;
  1. ; Return Study( Image ) info. The code is a copy from MAGSIXG3
  1. N X0,X2,X40
  1. N PKG,TYPE,EVT,SPEC,ORIG,ORIG,CAPTAPP,CLASS
  1. N IMGNODE,FLTX
  1. ;
  1. S IMGNODE=$$NODE^MAGGI11(IMGIEN) Q:IMGNODE="" 0
  1. ;
  1. S X0=$G(@IMGNODE@(0))
  1. S X2=$G(@IMGNODE@(2))
  1. S X40=$G(@IMGNODE@(40))
  1. ;
  1. S PKG=$P(X40,U) ; PACKAGE INDEX (40)
  1. S TYPE=$P(X40,U,3) ; TYPE INDEX (42)
  1. S EVT=$P(X40,U,4) ; PROC/EVENT INDEX (43)
  1. S SPEC=$P(X40,U,5) ; SPEC/SUBSPEC INDEX (44)
  1. S ORIG=$P(X40,U,6) ; ORIGIN INDEX (45)
  1. S:ORIG="" ORIG="V" ; Show VA by default
  1. S CAPTAPP=$P(X2,U,12) ; CAPTURE APPLICATION (8.1)
  1. ;
  1. S CLASS=$S(TYPE:$P($G(^MAG(2005.83,+TYPE,0)),U,2),1:"")
  1. ;
  1. S FLTX=""
  1. S $P(FLTX,U,3)=$$RPTITLE^MAGSIXG3($P(X2,U,6),$P(X2,U,7)) ; Report title
  1. S $P(FLTX,U,4)=$$DTE^MAGSIXG3($P(X2,U,5)) ; Procedure date
  1. S $P(FLTX,U,5)=$P(X0,U,8) ; Procedure
  1. S $P(FLTX,U,7)=$P(X2,U,4) ; Short descr.
  1. S $P(FLTX,U,8)=PKG ; Package
  1. S $P(FLTX,U,9)=$P($G(^MAG(2005.82,+CLASS,0)),U) ; Class
  1. S $P(FLTX,U,10)=$P($G(^MAG(2005.83,+TYPE,0)),U) ; Type
  1. S $P(FLTX,U,11)=$P($G(^MAG(2005.84,+SPEC,0)),U) ; (Sub)Specialty
  1. S $P(FLTX,U,12)=$P($G(^MAG(2005.85,+EVT,0)),U) ; Proc/Event
  1. S $P(FLTX,U,13)=$$EXTERNAL^DILFD(2005,45,,ORIG) ; Origin
  1. S $P(FLTX,U,14)=$$DTE^MAGSIXG3($P(X2,U)) ; Capture date
  1. S $P(FLTX,U,15)=$$GET1^DIQ(200,+$P(X2,U,2)_",",.01) ; Captured by
  1. S $P(FLTX,U,16)=IMGIEN ; Image IEN
  1. S $P(FLTX,U,20)=$$ACCNUM(REFTYPE,REFIEN,MAGNCXT) ; Accession Number
  1. Q FLTX_"|"_REFTYPE_"-"_REFIEN_"|"_$S(MAGNCXT'="":MAGNCXT,1:$$CPRSCTX(REFTYPE,REFIEN))
  1. ;
  1. INSFIMG(DATA,MAGNCNT,OUT) ; Append First Image Info from 2005 image structure
  1. N IMGGRP,IMGIEN
  1. S IMGGRP=$P(DATA,"|",2)
  1. S IMGIEN=$P(DATA,"|",4)
  1. S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="NEXT_SERIES"
  1. S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="SERIES_IEN|"_IMGGRP
  1. S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="SERIES_NUMBER|1"
  1. S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="NEXT_IMAGE"
  1. S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="IMAGE_IEN|"_IMGIEN
  1. S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="GROUP_IEN|"_IMGGRP
  1. S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="IMAGE_INFO|"_"^"_$$INFO^MAGGAII(IMGIEN,"E")
  1. Q
  1. ;
  1. ACCNUM(REFTYPE,REFIEN,MAGNCXT) ; Accession Number
  1. I REFTYPE="TIU" Q $$ACNTIU(REFIEN)
  1. I REFTYPE="RAD" Q $$ACNRAD(REFIEN,MAGNCXT)
  1. Q ""
  1. ;
  1. ACNRAD(RARPT,MAGNCXT) ; Get Accession number by RAD report IEN
  1. N ACN,DFN,ENT,INVDTTM,INVDT,INVTM
  1. I RARPT D Q ACN
  1. . S ACN=$P($G(^RARPT(RARPT,0)),"^") ; IA # 1171 ; Get Radiology Accession number
  1. . Q
  1. ;
  1. I MAGNCXT="" Q ""
  1. ;
  1. ; Report is not defined
  1. S DFN=+$P(MAGNCXT,U,3)
  1. S ENT=+$P($P(MAGNCXT,U,5),"-",2)
  1. S INVDTTM=$P($P(MAGNCXT,U,5),"-",1)
  1. S INVDT=$P(INVDTTM,".",1)
  1. S INVTM=$P(INVDTTM,".",2)
  1. F Q:($L(INVDT)<8) S INVDT=$E(INVDT,2,$L(INVDT))
  1. S INVDTTM=INVDT_"."_INVTM
  1. S ACN=$$ACCNUM^RAAPI(DFN,INVDTTM,ENT)
  1. I $L(ACN,"-")=3 S ACN=$P(ACN,"-",2,3)
  1. Q ACN
  1. ;
  1. ACNTIU(MAGTIUDA) ; Get Accession number by TIU Note IEN
  1. N MAGMRC,IEN
  1. ;
  1. D GET1405^TIUSRVR(.MAGMRC,MAGTIUDA)
  1. S IEN=+MAGMRC
  1. I (IEN'>0)!'(MAGMRC["GMR(123") Q ""
  1. Q $$GMRCACN^MAGDFCNV(IEN) ; site-specific accession number
  1. ;
  1. CPRSCTX(REFTYPE,REFIEN) ; Create CPRS Context ID
  1. ; REFTYPE = "RAD", "TIU"
  1. ; REFIEN = IEN in respective file of REFTYPE
  1. ;
  1. N CTXID
  1. I REFTYPE="TIU" D Q CTXID
  1. . S CTXID=$$TIUCPRS(REFIEN)
  1. . Q
  1. ;
  1. I REFTYPE="RAD" D Q CTXID
  1. . S CTXID=$$RACPRS(REFIEN)
  1. . Q
  1. ;
  1. Q ""
  1. ;
  1. REFBYACN(REFTYPE,REFIEN,ACNUMB) ; Get report by accession number
  1. N GMRCIEN,IEN,LST
  1. S (REFTYPE,REFIEN)=""
  1. ;
  1. I ACNUMB="" Q
  1. S IEN=$O(^MAGV(2005.62,"D",ACNUMB,""))
  1. I IEN'>0 Q
  1. S REFTYPE=$$GET1^DIQ(2005.62,IEN,"11:.03","I") ; Get procedure type (RAD, CON, etc)
  1. ;
  1. I REFTYPE="RAD" D Q
  1. . N I,DFN,INVDT,ENT
  1. . D ACCFIND^RAAPI(ACNUMB,.LST) ; IA 5020
  1. . S I=$O(LST(""))
  1. . Q:I'>0
  1. . S DFN=$P(LST(I),"^")
  1. . S INVDT=$P(LST(I),"^",2)
  1. . S ENT=$P(LST(I),"^",3)
  1. . S REFIEN=$P(^RADPT(DFN,"DT",INVDT,"P",ENT,0),U,17)
  1. . Q
  1. ;
  1. I REFTYPE="CON" D Q
  1. . S REFTYPE="TIU"
  1. . S GMRCIEN=$$GMRCIEN(ACNUMB)
  1. . Q:GMRCIEN'>0 ; invalid IEN
  1. . D GETDOCS^TIUSRVLR(.LST,GMRCIEN_";GMR(123,") ; IA 3536
  1. . S REFIEN=$P($G(@LST@(1)),"^")
  1. . Q
  1. Q
  1. ;
  1. GMRCIEN(ACNUMB) ; return the GMRC IEN, given a consult/procedure accession number
  1. ; ACNUMB is the accession number for a consult/procedure request
  1. ; OLD Format: GMRC-<gmrcien>, where <gmrcien>is the internal entry number of the request
  1. ; New Format: <sss>-GMR-<gmrcien>, where <sss> is station number, and <gmrcien>
  1. ; is the internal entry number of the request, up to 8 digits (100 million)
  1. N GMRCIEN ; CPRS Consult Request Tracking GMRC IEN - REQUEST/CONSULTATION file(#123)
  1. S GMRCIEN=""
  1. I ACNUMB?1"GMRC-"1N.N S GMRCIEN=$P(ACNUMB,"-",2) ; return the second piece
  1. E I ACNUMB?1N.N1"-GMR-"1N.N S:$P(ACNUMB,"-",1)=$$STATNUMB^MAGDFCNV() GMRCIEN=$P(ACNUMB,"-",3) ; return the third piece
  1. ;
  1. Q GMRCIEN
  1. ;
  1. RACPRS(REFIEN) ; Return Radiology CRPS context by Report IEN in file #74
  1. ; REFIEN - Radiology report IEN in file #74
  1. I REFIEN'>0 Q ""
  1. N DAYCASE,CASE,DATETIME,INVDAT,ENT,CONTEXT
  1. S DAYCASE=$$GET1^DIQ(74,REFIEN,.01)
  1. Q:DAYCASE="" "" ;*ZEB 269 prevent subscript error if study deleted
  1. S DFN=$$GET1^DIQ(74,REFIEN,2,"I")
  1. Q:DFN="" "" ;*ZEB 269 prevent subscript error if study deleted
  1. S DATETIME=$$GET1^DIQ(74,REFIEN,3,"I")
  1. S INVDAT=9999999.9999-DATETIME
  1. S CASE=$$GET1^DIQ(74,REFIEN,4)
  1. S ENT=$O(^RADPT("ADC1",DAYCASE,DFN,INVDAT,""))
  1. I 'ENT S ENT=$O(^RADPT("ADC",DAYCASE,DFN,INVDAT,""))
  1. S CONTEXT="RPT^CPRS^"_DFN_"^RA^i"_INVDAT_"-"_ENT_"^"_CASE
  1. Q CONTEXT
  1. ;
  1. TIUCPRS(REFIEN) ; Return TIU CRPS context by TIU note IEN in file #8925
  1. ; REFIEN - TIU note IEN in file #8925
  1. I REFIEN'>0 Q ""
  1. N DFN,CONTEXT
  1. S DFN=$$GET1^DIQ(8925,REFIEN,.02,"I")
  1. S CONTEXT="RPT^CPRS^"_DFN_"^TIU^"_REFIEN
  1. Q CONTEXT