MAGTP008 ;WOIFO/FG,MLH,JSL - TELEPATHOLOGY TAGS ; 17 Apr 2013 2:52 PM
;;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 ;
;
;***** INITIALIZE SESSION (COLLECT USER INFO)
; SEE USERINF2^MAGJUTL3
; RPC: MAGTP GET USER
;
; .MAGRY Reference to a variable naming the global to store returned data
;
; Input Parameters
; ================
; N/A
;
; 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: DUZ
; ^02: NAME
; ^03: INITIALS
; ^04: SSN
; ^05: UserLocalStationNumber
; ^06: PrimarySiteStationNumber
; ^07: SiteServiceURL
; ^08: SiteCode
; ^09: SiteName
; ^10: Production account? 0:"NO",1:"YES"
;
; MAGRY(1:N) Description
; LAB DATA file (#63) Security Keys
;
USERINF(MAGRY) ; RPC [MAGTP GET USER]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
I +$G(DUZ)=0 S MAGRY(0)="0^0^DUZ Undefined, Null or Zero" Q
I +$G(DUZ(2))=0 S MAGRY(0)="0^0^DUZ(2) Undefined, Null or Zero" Q
N MAGPL,SSUNC,VIXPTR,KEY,CT
;
S MAGRY(0)=DUZ_U_$$GET1^DIQ(200,DUZ_",",.01)_U_$$GET1^DIQ(200,DUZ_",",1) ; IA #10060
;
; Add pieces ^04:^06 for VIX
S MAGRY(0)=MAGRY(0)_U_$$GET1^DIQ(200,DUZ_",",9) ;...SSN ; IA #10060
S MAGRY(0)=MAGRY(0)_U_$$GET1^DIQ(4,DUZ(2),99,"E") ;.UserLocalStationNumber
S MAGRY(0)=MAGRY(0)_U_$P($$SITE^VASITE(),U,3) ;.....PrimarySiteStationNumber
;
; Lookup SiteServiceURL
S MAGPL=$$PLACE^MAGBAPI(+$G(DUZ(2))) ; Get place for DUZ(2)
S VIXPTR=$$GET1^DIQ(2006.1,MAGPL,55,"I") ; Net site service
;
; Return UNC only if OpStatus is 'online'
I VIXPTR,+$$GET1^DIQ(2005.2,VIXPTR,5,"I") D
. S SSUNC=$$GET1^DIQ(2005.2,VIXPTR,1)
S MAGRY(0)=MAGRY(0)_U_$G(SSUNC) ;...................SiteServiceURL
S MAGRY(0)=MAGRY(0)_U_$$GET1^DIQ(2006.1,MAGPL,.09) ;SiteCode
S MAGRY(0)=MAGRY(0)_U_$$GET1^DIQ(2006.1,MAGPL,.01) ;SiteName
S MAGRY(0)=MAGRY(0)_U_$S($L($T(PROD^XUPROD)):+$$PROD^XUPROD,1:0) ; IA #4440
;
; KEYS
S KEY="LR",CT=0 ; Find LAB DATA file keys
F S KEY=$O(^XUSEC(KEY)) Q:$E(KEY,1,2)'="LR" D ; IA #10076
. I $D(^XUSEC(KEY,DUZ)) S CT=CT+1,MAGRY(CT)=KEY ; IA #10076
Q ;
;
;+++++ GET THE ABBREVIATION FOR A SITE IEN FROM FILE (#2006.19)
;
; SITE Site Number (IEN)
;
; Return Value
; ============
;
; ABBR Abbreviation for SITE
;
GETABBR(SITE) ;
Q:'$G(SITE) ""
N MAGREC,ABBR
S MAGREC=$O(^MAG(2006.19,"D",SITE,""))
S ABBR=$S(MAGREC:$P($G(^MAG(2006.19,MAGREC,0)),U,4),1:"")
Q ABBR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGTP008 3891 printed Apr 09, 2024@21:07:52 Page 2
MAGTP008 ;WOIFO/FG,MLH,JSL - TELEPATHOLOGY TAGS ; 17 Apr 2013 2:52 PM
+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 ;***** INITIALIZE SESSION (COLLECT USER INFO)
+20 ; SEE USERINF2^MAGJUTL3
+21 ; RPC: MAGTP GET USER
+22 ;
+23 ; .MAGRY Reference to a variable naming the global to store returned data
+24 ;
+25 ; Input Parameters
+26 ; ================
+27 ; N/A
+28 ;
+29 ; Return Values
+30 ; =============
+31 ;
+32 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+33 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+34 ;
+35 ; Otherwise, the output array is as follows:
+36 ;
+37 ; MAGRY(0) Description
+38 ; ^01: DUZ
+39 ; ^02: NAME
+40 ; ^03: INITIALS
+41 ; ^04: SSN
+42 ; ^05: UserLocalStationNumber
+43 ; ^06: PrimarySiteStationNumber
+44 ; ^07: SiteServiceURL
+45 ; ^08: SiteCode
+46 ; ^09: SiteName
+47 ; ^10: Production account? 0:"NO",1:"YES"
+48 ;
+49 ; MAGRY(1:N) Description
+50 ; LAB DATA file (#63) Security Keys
+51 ;
USERINF(MAGRY) ; RPC [MAGTP GET USER]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 IF +$GET(DUZ)=0
SET MAGRY(0)="0^0^DUZ Undefined, Null or Zero"
QUIT
+4 IF +$GET(DUZ(2))=0
SET MAGRY(0)="0^0^DUZ(2) Undefined, Null or Zero"
QUIT
+5 NEW MAGPL,SSUNC,VIXPTR,KEY,CT
+6 ;
+7 ; IA #10060
SET MAGRY(0)=DUZ_U_$$GET1^DIQ(200,DUZ_",",.01)_U_$$GET1^DIQ(200,DUZ_",",1)
+8 ;
+9 ; Add pieces ^04:^06 for VIX
+10 ;...SSN ; IA #10060
SET MAGRY(0)=MAGRY(0)_U_$$GET1^DIQ(200,DUZ_",",9)
+11 ;.UserLocalStationNumber
SET MAGRY(0)=MAGRY(0)_U_$$GET1^DIQ(4,DUZ(2),99,"E")
+12 ;.....PrimarySiteStationNumber
SET MAGRY(0)=MAGRY(0)_U_$PIECE($$SITE^VASITE(),U,3)
+13 ;
+14 ; Lookup SiteServiceURL
+15 ; Get place for DUZ(2)
SET MAGPL=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+16 ; Net site service
SET VIXPTR=$$GET1^DIQ(2006.1,MAGPL,55,"I")
+17 ;
+18 ; Return UNC only if OpStatus is 'online'
+19 IF VIXPTR
IF +$$GET1^DIQ(2005.2,VIXPTR,5,"I")
Begin DoDot:1
+20 SET SSUNC=$$GET1^DIQ(2005.2,VIXPTR,1)
End DoDot:1
+21 ;...................SiteServiceURL
SET MAGRY(0)=MAGRY(0)_U_$GET(SSUNC)
+22 ;SiteCode
SET MAGRY(0)=MAGRY(0)_U_$$GET1^DIQ(2006.1,MAGPL,.09)
+23 ;SiteName
SET MAGRY(0)=MAGRY(0)_U_$$GET1^DIQ(2006.1,MAGPL,.01)
+24 ; IA #4440
SET MAGRY(0)=MAGRY(0)_U_$SELECT($LENGTH($TEXT(PROD^XUPROD)):+$$PROD^XUPROD,1:0)
+25 ;
+26 ; KEYS
+27 ; Find LAB DATA file keys
SET KEY="LR"
SET CT=0
+28 ; IA #10076
FOR
SET KEY=$ORDER(^XUSEC(KEY))
if $EXTRACT(KEY,1,2)'="LR"
QUIT
Begin DoDot:1
+29 ; IA #10076
IF $DATA(^XUSEC(KEY,DUZ))
SET CT=CT+1
SET MAGRY(CT)=KEY
End DoDot:1
+30 ;
QUIT
+31 ;
+32 ;+++++ GET THE ABBREVIATION FOR A SITE IEN FROM FILE (#2006.19)
+33 ;
+34 ; SITE Site Number (IEN)
+35 ;
+36 ; Return Value
+37 ; ============
+38 ;
+39 ; ABBR Abbreviation for SITE
+40 ;
GETABBR(SITE) ;
+1 if '$GET(SITE)
QUIT ""
+2 NEW MAGREC,ABBR
+3 SET MAGREC=$ORDER(^MAG(2006.19,"D",SITE,""))
+4 SET ABBR=$SELECT(MAGREC:$PIECE($GET(^MAG(2006.19,MAGREC,0)),U,4),1:"")
+5 QUIT ABBR
