MAGTP006 ;WOIFO/FG,JSL - TELEPATHOLOGY TAGS ; 25 Jul 2013 5:07pm
;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q ;
;
;+++++ SET CONTEXT
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; LRSS AP Section
;
; YEAR Accession Year (Two figures)
;
; LRAN Accession Number
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1
; ^02: 0
;
; "LRSF,LRI,LRDFN," if successful
; "" if error
;
; Where:
;
; LRSF Subfield Number in LAB DATA file (#63)
;
; LRI Reverse Date entry in LAB DATA file (#63)
;
; LRDFN DFN from LAB DATA file (#63) for a patient
;
CONTEXT(MAGRY,LRSS,YEAR,LRAN) ;
K MAGRY
N LRX,LRSF,LRDFN,LRI,IEN,LRAA,LRYR
I '$D(LRSS) S MAGRY(0)="0^0^Missing AP Section" Q ""
I '$D(YEAR) S MAGRY(0)="0^0^Missing Year" Q ""
I '$D(LRAN) S MAGRY(0)="0^0^Missing Accession Number" Q ""
; Only these three AP Sections considered
S LRSF=$S(LRSS="CY":63.09,LRSS="EM":63.02,LRSS="SP":63.08,1:"")
I LRSF="" S MAGRY(0)="0^0^Invalid AP Section" Q ""
S LRAA=$O(^LRO(68,"B",LRSS,0))
I LRAA="" S MAGRY(0)="0^0^Accession Area Not Found" Q ""
; Find year in index
S LRYR=YEAR_"0000"
S LRYR=$S($D(^LRO(68,LRAA,1,2E6+LRYR)):2E6+LRYR,$D(^LRO(68,LRAA,1,3E6+LRYR)):3E6+LRYR,1:"")
I LRYR="" S MAGRY(0)="0^0^Invalid Year" Q ""
I +LRAN=0 S MAGRY(0)="0^0^Invalid Accession Number" Q ""
D Q:$D(MAGRY(0)) "" ; look up by accession number; crawl if necessary
. N ACCID
. S ACCID=LRSS_" "_YEAR_" "_LRAN
. I $D(^LRO(68,LRAA,1,LRYR,1,LRAN)),$P($G(^(LRAN,.2)),"^",1)=ACCID Q ; found
. D ; try to crawl, redefine LRAN (accession serial IEN)
. . S LRAN=0 F S LRAN=$O(^LRO(68,LRAA,1,LRYR,1,LRAN)) Q:'LRAN I $P($G(^(LRAN,.2)),"^",1)=ACCID Q
. . S:LRAN="" MAGRY(0)="0^0^Accession Record Not Found"
. . Q
. Q
S LRDFN=$P($G(^LRO(68,LRAA,1,LRYR,1,LRAN,0)),"^",1)
I LRDFN="" S MAGRY(0)="0^0^LAB DATA Patient Index Not Found" Q ""
I '$D(^LR(LRDFN)) S MAGRY(0)="0^0^LAB DATA Patient Record Not Found" Q ""
S LRI=$P($G(^LRO(68,LRAA,1,LRYR,1,LRAN,3)),"^",5)
I LRI="" S MAGRY(0)="0^0^LAB DATA Order Index Not Found" Q ""
I '$D(^LR(LRDFN,LRSS,LRI)) S MAGRY(0)="0^0^LAB DATA Order Record Not Found" Q ""
S IEN=LRI_","_LRDFN_","
S MAGRY(0)="1^0"
Q LRSF_","_IEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGTP006 3610 printed Sep 23, 2025@19:44:58 Page 2
MAGTP006 ;WOIFO/FG,JSL - TELEPATHOLOGY TAGS ; 25 Jul 2013 5:07pm
+1 ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;
QUIT
+18 ;
+19 ;+++++ SET CONTEXT
+20 ;
+21 ; .MAGRY Reference to a local variable where the results
+22 ; are returned to.
+23 ;
+24 ; LRSS AP Section
+25 ;
+26 ; YEAR Accession Year (Two figures)
+27 ;
+28 ; LRAN Accession Number
+29 ;
+30 ; Return Values
+31 ; =============
+32 ;
+33 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+34 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+35 ;
+36 ; Otherwise, the output array is as follows:
+37 ;
+38 ; MAGRY(0) Description
+39 ; ^01: 1
+40 ; ^02: 0
+41 ;
+42 ; "LRSF,LRI,LRDFN," if successful
+43 ; "" if error
+44 ;
+45 ; Where:
+46 ;
+47 ; LRSF Subfield Number in LAB DATA file (#63)
+48 ;
+49 ; LRI Reverse Date entry in LAB DATA file (#63)
+50 ;
+51 ; LRDFN DFN from LAB DATA file (#63) for a patient
+52 ;
CONTEXT(MAGRY,LRSS,YEAR,LRAN) ;
+1 KILL MAGRY
+2 NEW LRX,LRSF,LRDFN,LRI,IEN,LRAA,LRYR
+3 IF '$DATA(LRSS)
SET MAGRY(0)="0^0^Missing AP Section"
QUIT ""
+4 IF '$DATA(YEAR)
SET MAGRY(0)="0^0^Missing Year"
QUIT ""
+5 IF '$DATA(LRAN)
SET MAGRY(0)="0^0^Missing Accession Number"
QUIT ""
+6 ; Only these three AP Sections considered
+7 SET LRSF=$SELECT(LRSS="CY":63.09,LRSS="EM":63.02,LRSS="SP":63.08,1:"")
+8 IF LRSF=""
SET MAGRY(0)="0^0^Invalid AP Section"
QUIT ""
+9 SET LRAA=$ORDER(^LRO(68,"B",LRSS,0))
+10 IF LRAA=""
SET MAGRY(0)="0^0^Accession Area Not Found"
QUIT ""
+11 ; Find year in index
+12 SET LRYR=YEAR_"0000"
+13 SET LRYR=$SELECT($DATA(^LRO(68,LRAA,1,2E6+LRYR)):2E6+LRYR,$DATA(^LRO(68,LRAA,1,3E6+LRYR)):3E6+LRYR,1:"")
+14 IF LRYR=""
SET MAGRY(0)="0^0^Invalid Year"
QUIT ""
+15 IF +LRAN=0
SET MAGRY(0)="0^0^Invalid Accession Number"
QUIT ""
+16 ; look up by accession number; crawl if necessary
Begin DoDot:1
+17 NEW ACCID
+18 SET ACCID=LRSS_" "_YEAR_" "_LRAN
+19 ; found
IF $DATA(^LRO(68,LRAA,1,LRYR,1,LRAN))
IF $PIECE($GET(^(LRAN,.2)),"^",1)=ACCID
QUIT
+20 ; try to crawl, redefine LRAN (accession serial IEN)
Begin DoDot:2
+21 SET LRAN=0
FOR
SET LRAN=$ORDER(^LRO(68,LRAA,1,LRYR,1,LRAN))
if 'LRAN
QUIT
IF $PIECE($GET(^(LRAN,.2)),"^",1)=ACCID
QUIT
+22 if LRAN=""
SET MAGRY(0)="0^0^Accession Record Not Found"
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
if $DATA(MAGRY(0))
QUIT ""
+25 SET LRDFN=$PIECE($GET(^LRO(68,LRAA,1,LRYR,1,LRAN,0)),"^",1)
+26 IF LRDFN=""
SET MAGRY(0)="0^0^LAB DATA Patient Index Not Found"
QUIT ""
+27 IF '$DATA(^LR(LRDFN))
SET MAGRY(0)="0^0^LAB DATA Patient Record Not Found"
QUIT ""
+28 SET LRI=$PIECE($GET(^LRO(68,LRAA,1,LRYR,1,LRAN,3)),"^",5)
+29 IF LRI=""
SET MAGRY(0)="0^0^LAB DATA Order Index Not Found"
QUIT ""
+30 IF '$DATA(^LR(LRDFN,LRSS,LRI))
SET MAGRY(0)="0^0^LAB DATA Order Record Not Found"
QUIT ""
+31 SET IEN=LRI_","_LRDFN_","
+32 SET MAGRY(0)="1^0"
+33 QUIT LRSF_","_IEN
