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