- 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 Feb 18, 2025@23:35:09 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