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

MAGTP013.m

Go to the documentation of this file. 
  1. MAGTP013 ;WOIFO/FG,MLH,JSL - TELEPATHOLOGY RPCS ; 25 Jul 2013 5:08 PM
  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.  ;***** GET A LIST OF SELECTED UNRELEASED OR RELEASED REPORTS
  1.  ; RPC: MAGTP GET CASES
  1.  ;
  1.  ; .MAGRY        Reference to a local or global variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; .ENT          Input array. The case numbers must be
  1.  ;               listed one on each line.
  1.  ;
  1.  ; Return Values
  1.  ; =============
  1.  ; 
  1.  ; If @MAGRY@(0) 1st '^'-piece is < 0, then an error
  1.  ; occurred during execution of the procedure: [code]^^[error explanation]
  1.  ;
  1.  ; Otherwise, the output array is as follows:
  1.  ;
  1.  ; @MAGRY@(0)   Description
  1.  ;                ^01: 0   if all case numbers sent in array ENT were found
  1.  ;                     1   if one or more case numbers sent in array ENT were not found
  1.  ;                ^02: Total Number of Lines
  1.  ;
  1.  ; @MAGRY@(i)   Description 
  1.  ;                ^01: Case Number
  1.  ;                     (if case not found, error description will follow
  1.  ;                      and pieces 2-19 will not be populated)
  1.  ;                ^02: Reserved Entry (0/1 for Not Reserved/Reserved) 
  1.  ;                ^03: Initials of who reserved the case in the LAB DATA file (#63)
  1.  ;                ^04: Patient's Name
  1.  ;                ^05: Patient's ID Number
  1.  ;                ^06: Priority
  1.  ;                ^07: Slide(s) Available
  1.  ;                ^08: Date/Time Specimen Taken
  1.  ;                ^09: Case Status
  1.  ;                ^10: Site Initials
  1.  ;                ^11: AP Section
  1.  ;                ^12: Year
  1.  ;                ^13: Accession Number
  1.  ;                ^14: ICN
  1.  ;                ^15: Specimen Count
  1.  ;                ^16: Reading Method
  1.  ;                ^17: Patient's Short ID
  1.  ;                ^18: Is there a Note? (Yes/No) 
  1.  ;                ^19: Employee/Sensitive? (1=Yes/0=No)
  1.  ;
  1. GETCAS(MAGRY,ENT) ; RPC [MAGTP GET CASES]
  1.  K MAGRY
  1.  I $D(ENT)<10 S MAGRY(0)="-2^^No Input" Q
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGUTERR"
  1.  N CT,BDFLG,LINE,LRAC,LRSS,YEAR
  1.  N LRAN,LRSF,LRX,LRDFN,LRI,IEN
  1.  N RDATE,FLAG,PNM,DFN,REC,OUTPUT,LRAA,YR,LRACC
  1.  S (CT,LINE)=""
  1.  S BDFLG=0                                     ; If BDFLG=1 there's a bad entry
  1.  F  S LINE=$O(ENT(LINE)) Q:LINE=""!(BDFLG)  D
  1.  . S LRAC=ENT(LINE)    ;Ex: 'SP 13 12'         ; Read case number
  1.  . S LRSS=$E(LRAC,1,2)
  1.  . S YEAR=$E(LRAC,4,5)
  1.  . S LRAN=$E(LRAC,7,$L(LRAC))
  1.  . S CT=CT+1
  1.  . I LRAN'?1.N S MAGRY(CT)=LRAC_": Invalid Accession Number",BDFLG=1 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(CT)=LRAC_": Invalid AP Section",BDFLG=1 Q
  1.  . S LRX="A"_LRSS_"A"
  1.  . ; Find 3-digit year in index
  1.  . S YR=$S($D(^LR(LRX,200+YEAR)):200+YEAR,$D(^LR(LRX,300+YEAR)):300+YEAR,1:"")
  1.  . I YR="" S MAGRY(CT)=LRAC_": Invalid Year "_YEAR,BDFLG=1 Q
  1.  . I '$D(^LR(LRX,YEAR,LRSS,LRAN)) D        ; Try new style case(s) after LEDI
  1.  . . S LRAA=$O(^LRO(68,"B",LRSS,0)),IEN="" ; Number for #68 Acc - CY EM SP
  1.  . . F YR=(300+YEAR*10000),(200+YEAR*10000) D  Q:IEN'=""    ; YR 2000, 1900
  1.  . . . S LRDFN=+$P($G(^LRO(68,LRAA,1,YR,1,LRAN,0)),"^",1)
  1.  . . . I 'LRDFN S MAGRY(CT)=LRAC_": Record Not Found LRDFN" Q
  1.  . . . S LRI=+$P($G(^LRO(68,LRAA,1,YR,1,LRAN,3)),"^",5)
  1.  . . . I 'LRI S MAGRY(CT)=LRAC_": Record Not Found LRI" Q
  1.  . . . S IEN=LRI_","_LRDFN_","
  1.  . . . S LRACC=$G(^LRO(68,LRAA,1,YR,1,LRAN,.2)) Q:LRACC=""  ; Accession
  1.  . . . S REC=$O(^MAG(2005.42,"B",LRACC,""))_","             ; Record Number worklist
  1.  . . . S PNM=$$GET1^DIQ(63,LRDFN_",",".03")
  1.  . . . S DFN=$$GET1^DIQ(63,LRDFN_",",".03","I"),FLAG=$G(FLAG,0)
  1.  . . . S OUTPUT=$$GETCASE^MAGTP009(LRSS,LRACC,LRSF,IEN,REC,FLAG,PNM,DFN)
  1.  . . . S MAGRY(CT)=LRACC_U_OUTPUT
  1.  . . . Q  ; OUTPUT contains pieces ^02:^17 defined above in the MAGRY(i) description
  1.  . . I IEN=""!(LRACC="") S MAGRY(CT)=LRAC_": Record Not Found In #68",BDFLG=1
  1.  . . Q
  1.  . I $D(^LR(LRX,YR,LRSS,LRAN)) D  ;old style before LEDI
  1.  . . S LRDFN=$O(^LR(LRX,YR,LRSS,LRAN,""))
  1.  . . I LRDFN="" S MAGRY(CT)=LRAC_": Record Not Found LRDFN",BDFLG=1 Q
  1.  . . S LRI=$O(^LR(LRX,YR,LRSS,LRAN,LRDFN,""))
  1.  . . I LRI="" S MAGRY(CT)=LRAC_": Record Not Found LRI",BDFLG=1 Q
  1.  . . S IEN=LRI_","_LRDFN_","
  1.  . . S RDATE=+$$GET1^DIQ(LRSF,IEN,.11,"I")       ; Release date if any
  1.  . . S FLAG=$S(RDATE:1,1:0)
  1.  . . S PNM=$$GET1^DIQ(63,LRDFN_",",".03")
  1.  . . S DFN=$$GET1^DIQ(63,LRDFN_",",".03","I")
  1.  . . S REC=$O(^MAG(2005.42,"B",LRAC,""))_","
  1.  . . ; OUTPUT contains pieces ^02:^17 defined above in the MAGRY(i) description
  1.  . . S OUTPUT=$$GETCASE^MAGTP009(LRSS,LRAC,LRSF,IEN,REC,FLAG,PNM,DFN)
  1.  . . S MAGRY(CT)=LRAC_U_OUTPUT
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ; Header
  1.  ;
  1.  S MAGRY(0)=BDFLG_"^"_CT
  1.  Q  ;