- 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 Jan 18, 2025@03:09:55 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)