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

MAGTP009.m

Go to the documentation of this file.
  1. MAGTP009 ;WOIFO/FG,MLH,JSL - TELEPATHOLOGY TAGS ; 26 Jul 2013 11:24 AM
  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 CASE INFO, SET OUTPUT
  1. ;
  1. ; LRSS AP Section
  1. ;
  1. ; LRAC Accession Code for the case
  1. ;
  1. ; LRSF AP Section Subfield Number
  1. ;
  1. ; IEN Internal Entry Number String in the Subfield
  1. ;
  1. ; REC Record number in file (#2005.42)
  1. ;
  1. ; FLAG Flag to select reports:
  1. ;
  1. ; 0:Unreleased reports
  1. ;
  1. ; 1:Released reports
  1. ;
  1. ; PNM Patient Name
  1. ;
  1. ; DFN Patient ID
  1. ;
  1. ; Return Values
  1. ; =============
  1. ;
  1. ; OUTPUT Description
  1. ; ^01: Reserved Flag
  1. ; ^02: Reserved By (Initials + '-' + DUZ)
  1. ; ^03: Patient's Name
  1. ; ^04: Patients's ID
  1. ; ^05: Priority
  1. ; ^06: Slide Available
  1. ; ^07: Specimen Taken Date/Time
  1. ; ^08: Report Status
  1. ; ^09: Site Location (Abbr.)
  1. ; ^10: AP Section
  1. ; ^11: Year
  1. ; ^12: Accession Number
  1. ; ^13: ICN
  1. ; ^14: Specimen Count
  1. ; ^15: Reading Method
  1. ; ^16: Patient's Short ID
  1. ; ^17: Is there a note? (Yes/No)
  1. ; ^18: Employee/Sensitive (1=Yes/0=No)
  1. ; ^19: Number of image(s) #2005.42 node 0, piece 14th
  1. GETCASE(LRSS,LRAC,LRSF,IEN,REC,FLAG,PNM,DFN) ;
  1. N OUTPUT,LOCK,USER,USERINI,PRI,SLIDE,COMPL,STATUS,LOC,RDATE
  1. N ICN,SUBF,MAGOUT,SPCT,METH,SSN,SHORTID,ISNOTE,EMPSENS,NIMG
  1. S LOCK=+$$GET1^DIQ(2005.42,REC,1,"I") ; Get reservation info
  1. S USER=$$GET1^DIQ(2005.42,REC,1.2,"I") ; User in reservation lock
  1. S USERINI=$$GET1^DIQ(200,USER,1)_"-"_USER ; User's initials & DUZ in lock ; IA #10060
  1. S PRI=$$GET1^DIQ(2005.42,REC,.02) ; Get priority
  1. S SLIDE=$$GET1^DIQ(2005.42,REC,.03) ; Get "Slide Available?" flag
  1. S OUTPUT=LOCK_U_USERINI_U_PNM_U_$G(DFN)_U_PRI_U_SLIDE
  1. S NIMG=$P($G(^MAG(2005.42,REC,0)),U,14) ; Get number of image(s) if any
  1. ; Get Date/Time Specimen Taken (MM/DD/YYYY hh:mm)
  1. ;
  1. S OUTPUT=OUTPUT_U_$TR($$FMTE^XLFDT($$GET1^DIQ(LRSF,IEN,.01,"I"),"5Z"),"@"," ")
  1. ;
  1. ; Get Report Status
  1. ;
  1. S COMPL=$S($$GET1^DIQ(LRSF,IEN,.03,"I"):1,1:0) ; Report completed?
  1. S RDATE=+$$GET1^DIQ(LRSF,IEN,.11,"I") ; Release Date?
  1. S STATUS=$S(('RDATE&'COMPL):"In Progress",('RDATE&COMPL):"Pending Verification",1:"Released")
  1. ;
  1. ; Get Location (Abbr.)
  1. ;
  1. I $G(DUZ(2)) S LOC=$$GETABBR^MAGTP008(DUZ(2))
  1. ;
  1. S OUTPUT=OUTPUT_U_STATUS_U_$G(LOC)
  1. ;
  1. ; Extract ICN
  1. ; Extract YEAR and AN from LRAC
  1. ;
  1. S ICN=$$GETICN^MAGUE006($G(DFN),",") ; delimit return value with commas
  1. S OUTPUT=OUTPUT_U_LRSS_U_$E(LRAC,4,5)_U_$E(LRAC,7,$L(LRAC))_U_ICN
  1. ;
  1. ; Extract specimen count
  1. ;
  1. S SUBF=+$$GET1^DID(LRSF,.012,"","SPECIFIER") ; Subfield for Specimens
  1. D LIST^DIC(SUBF,","_IEN,"@;.01","P","","","","","","","MAGOUT")
  1. S SPCT=+$G(MAGOUT("DILIST",0))
  1. S OUTPUT=OUTPUT_U_SPCT
  1. ;
  1. ; Extract reading Method
  1. ;
  1. S METH=$$GET1^DIQ(2005.42,REC_",",.04)
  1. ;
  1. ; Extract Short ID (Last name's initial plus last four figures of SSN)
  1. ;
  1. S SSN=$$GET1^DIQ(2,$G(DFN)_",",.09) ; Supported IA #10035
  1. S OUTPUT=OUTPUT_U_METH_U_SSN
  1. ;
  1. ; Is there a Note attached to this case?
  1. ;
  1. S REC=$TR(REC,",") ; Strip comma
  1. S:REC ISNOTE=$S($D(^MAG(2005.42,REC,1,1,0)):"YES",1:"NO")
  1. S OUTPUT=OUTPUT_U_$G(ISNOTE,"NO")
  1. ;
  1. ; Is the patient an employee or sensitive?
  1. ;
  1. D EMPSENS^MAGUE007(.EMPSENS,$G(DFN))
  1. S EMPSENS=$P($G(EMPSENS(0)),"^",1)
  1. S OUTPUT=OUTPUT_U_$S(EMPSENS>0:1,1:EMPSENS),OUTPUT=OUTPUT_U_NIMG
  1. Q OUTPUT ;
  1. ;
  1. ;+++++ IF COUNT (CT) IS GETTING LARGE, SWITCH
  1. ; FROM LOCAL ARRAY TO GLOBAL RETURN TYPE
  1. ;
  1. ; Notes
  1. ; =====
  1. ;
  1. ; The ^TMP("MAGTP",$J,"AC") global node is used by this procedure.
  1. ;
  1. ARY2GLB(MAGRY) ;
  1. N X
  1. K ^TMP("MAGTP",$J,"AC")
  1. S MAGRY=""
  1. M ^TMP("MAGTP",$J,"AC")=MAGRY
  1. K MAGRY
  1. S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
  1. S MAGRY=$NA(^TMP("MAGTP",$J,"AC"))
  1. Q ;
  1. ;
  1. ;+++++ IF THE CASE HAS A CONSULTATION AND
  1. ; ITS INTERPRETING SITE MATCHES THE
  1. ; INPUT SITE, RETURN 1, OTHERWISE RETURN 0.
  1. ;
  1. ; LRAC Accession Code for the case
  1. ;
  1. ; SITE Site IEN to filter
  1. ;
  1. ; Return Values
  1. ; =============
  1. ;
  1. ; Description
  1. ; 1 if no input site is present or if a
  1. ; consultation is found for case LRAC
  1. ; with SITE as site IEN
  1. ;
  1. ; 0 otherwise
  1. ;
  1. ISCONSLT(LRAC,SITE) ;
  1. Q:$G(SITE)="" 1 ; If no input site to filter, do not filter
  1. N MAGOUT,FILE,SCREEN
  1. S FILE=2005.43
  1. ; Screen to get only cases with consultations (TYPE=1) and matching SITE
  1. S SCREEN="I $P(^(0),U,1)="""_LRAC_"""" ; Select case
  1. S SCREEN=SCREEN_",($P(^(0),U,2)=1)," ; Select TYPE=1:CONSULTATION
  1. S SCREEN=SCREEN_"($P(^(0),U,4)="""_SITE_""")" ; Select SITE
  1. S SCREEN=SCREEN_",($P(^(0),U,6)<2)" ; Select 0:PENDING or 1:COMPLETED
  1. D LIST^DIC(FILE,"","","","","","","",SCREEN,"","MAGOUT")
  1. Q +MAGOUT("DILIST",0) ; Return result: do not filter out if found positive