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

MAGTP006.m

Go to the documentation of this file.
  1. MAGTP006 ;WOIFO/FG,JSL - TELEPATHOLOGY TAGS ; 25 Jul 2013 5:07pm
  1. ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 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. ;
  1. ;+++++ SET CONTEXT
  1. ;
  1. ; .MAGRY Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; LRSS AP Section
  1. ;
  1. ; YEAR Accession Year (Two figures)
  1. ;
  1. ; LRAN Accession Number
  1. ;
  1. ; Return Values
  1. ; =============
  1. ;
  1. ; If MAGRY(0) 1st '^'-piece is 0, then an error
  1. ; occurred during execution of the procedure: 0^0^ ERROR explanation
  1. ;
  1. ; Otherwise, the output array is as follows:
  1. ;
  1. ; MAGRY(0) Description
  1. ; ^01: 1
  1. ; ^02: 0
  1. ;
  1. ; "LRSF,LRI,LRDFN," if successful
  1. ; "" if error
  1. ;
  1. ; Where:
  1. ;
  1. ; LRSF Subfield Number in LAB DATA file (#63)
  1. ;
  1. ; LRI Reverse Date entry in LAB DATA file (#63)
  1. ;
  1. ; LRDFN DFN from LAB DATA file (#63) for a patient
  1. ;
  1. CONTEXT(MAGRY,LRSS,YEAR,LRAN) ;
  1. K MAGRY
  1. N LRX,LRSF,LRDFN,LRI,IEN,LRAA,LRYR
  1. I '$D(LRSS) S MAGRY(0)="0^0^Missing AP Section" Q ""
  1. I '$D(YEAR) S MAGRY(0)="0^0^Missing Year" Q ""
  1. I '$D(LRAN) S MAGRY(0)="0^0^Missing Accession Number" Q ""
  1. ; Only these three AP Sections considered
  1. S LRSF=$S(LRSS="CY":63.09,LRSS="EM":63.02,LRSS="SP":63.08,1:"")
  1. I LRSF="" S MAGRY(0)="0^0^Invalid AP Section" Q ""
  1. S LRAA=$O(^LRO(68,"B",LRSS,0))
  1. I LRAA="" S MAGRY(0)="0^0^Accession Area Not Found" Q ""
  1. ; Find year in index
  1. S LRYR=YEAR_"0000"
  1. S LRYR=$S($D(^LRO(68,LRAA,1,2E6+LRYR)):2E6+LRYR,$D(^LRO(68,LRAA,1,3E6+LRYR)):3E6+LRYR,1:"")
  1. I LRYR="" S MAGRY(0)="0^0^Invalid Year" Q ""
  1. I +LRAN=0 S MAGRY(0)="0^0^Invalid Accession Number" Q ""
  1. D Q:$D(MAGRY(0)) "" ; look up by accession number; crawl if necessary
  1. . N ACCID
  1. . S ACCID=LRSS_" "_YEAR_" "_LRAN
  1. . I $D(^LRO(68,LRAA,1,LRYR,1,LRAN)),$P($G(^(LRAN,.2)),"^",1)=ACCID Q ; found
  1. . D ; try to crawl, redefine LRAN (accession serial IEN)
  1. . . S LRAN=0 F S LRAN=$O(^LRO(68,LRAA,1,LRYR,1,LRAN)) Q:'LRAN I $P($G(^(LRAN,.2)),"^",1)=ACCID Q
  1. . . S:LRAN="" MAGRY(0)="0^0^Accession Record Not Found"
  1. . . Q
  1. . Q
  1. S LRDFN=$P($G(^LRO(68,LRAA,1,LRYR,1,LRAN,0)),"^",1)
  1. I LRDFN="" S MAGRY(0)="0^0^LAB DATA Patient Index Not Found" Q ""
  1. I '$D(^LR(LRDFN)) S MAGRY(0)="0^0^LAB DATA Patient Record Not Found" Q ""
  1. S LRI=$P($G(^LRO(68,LRAA,1,LRYR,1,LRAN,3)),"^",5)
  1. I LRI="" S MAGRY(0)="0^0^LAB DATA Order Index Not Found" Q ""
  1. I '$D(^LR(LRDFN,LRSS,LRI)) S MAGRY(0)="0^0^LAB DATA Order Record Not Found" Q ""
  1. S IEN=LRI_","_LRDFN_","
  1. S MAGRY(0)="1^0"
  1. Q LRSF_","_IEN