MAGGTU6 ;WOIFO/GEK,MLH,MAT,JSL/MKN - Silent Utilities ; 12/6/2022 12:43 PM
;;3.0;IMAGING;**24,8,48,45,20,46,59,72,93,117,138,334**;Mar 19, 2002;Build 51
;; Per VA Directive 6402, 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
;
LOGACT(MAGRY,DATA) ;RPC [MAGGACTION LOG]
; Call to LogAction from Delphi Window
;
; DATA is input variable it is '^' delimited string
; 'A|B|C|D|E' ^^ MAGIEN ^ 'Copy/Download' ^ DFN ^ '1';
; DUZ is inserted as 2nd piece below.
; I.E. DATA = "C^^103660^Copy To Clipboard^1033^1"
N Y
S MAGRY="0^Logging access..."
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"
; C DUZ MAGIEN ACTION DFN 1 Additional Data
D ENTRY^MAGLOG($P(DATA,U),+$G(DUZ),$P(DATA,U,3),$P(DATA,U,4),$P(DATA,U,5),$P(DATA,U,6),$P(DATA,U,7))
S MAGRY="1^Action was Logged."
Q
;
LINKDT(MAGRY,MAGDA,DTTM) ; This is called when an Image is successfully
; linked (Associated) with a Report/Procedure/Note etc.
; MAGDA = Image IEN
; DTTM = "" No date sent, so use NOW
; DTTM = 1 No Date Sent, but use Image capture Date.
; DTTM = Valid FM Date/Time , Use it.
N MSG
S DTTM=$G(DTTM)
I 'DTTM S DTTM=$$NOW^XLFDT ; Using NOW
I '$D(^MAG(2005,MAGDA)) Q
I DTTM=1 S DTTM=$P(^MAG(2005,MAGDA,2),"^",1) ; Using Date Image Captured.
I '$$VALID^MAGGSIV1(2005,64,.DTTM,.MSG) S MAGRY="0^"_MSG Q
S $P(^MAG(2005,MAGDA,2),"^",11)=DTTM
S MAGRY="1^Okay"
Q
;
TIMEOUT(MAGRY,APP) ;RPC [MAGG GET TIMEOUT]
; Call Returns the timeout for the APP from IMAGING SITE PARAMETERS File
; APP is either 'DISPLAY', 'CAPTURE', 'VISTARAD', 'TELEREADER', 'IMPORTER', or 'TELEPATHOLOGY'
N I,MAGTIMES,MAGPLC
S MAGRY=""
S MAGPLC=$$PLACE^MAGBAPI(DUZ(2)) I 'MAGPLC Q ; DBI - SEB 9/20/2002
S MAGTIMES=$G(^MAG(2006.1,MAGPLC,"KEYS"))
I APP="DISPLAY" S MAGRY=$P(MAGTIMES,U,2) S:MAGRY="" MAGRY=6 ;p334 - default timeout to 6 (MINS) if field #121 is null
I APP="CAPTURE" S MAGRY=$P(MAGTIMES,U,3)
I APP="VISTARAD" S MAGRY=$P(MAGTIMES,U,4)
I APP="TELEREADER" S MAGRY=$P(MAGTIMES,U,6) ; MJK - 2006.01.25 - TeleReader
I APP="IMPORTER" S MAGRY=$P(MAGTIMES,U,8) ; MAT - *136
I APP="TELEPATHOLOGY" S MAGRY=+$P(MAGTIMES,U,9) ; JSL - *138 (field#135) - Telepathology
Q
;
EXIST(EKGPLACE) ;Does an ekg server exist in 2005.2
I $$CONSOLID^MAGBAPI()=0 Q $O(^MAG(2005.2,"E","EKG","")) ; DBI - SEB 9/20/2002
Q $O(^MAG(2005.2,"F",EKGPLACE,"EKG",""))
;
ONLINE(MAGR) ;RPC [MAG EKG ONLINE] EKG network location status
;returns the status of the first EKG network location type
;0 if offline or a network location doesn't exist
;1 if online
;
N EKG1,EKGPLACE
S EKGPLACE=$$PLACE^MAGBAPI(DUZ(2)) ; DBI - SEB 9/20/2002
I EKGPLACE=0 S EKGPLACE=$$PLACE^MAGBAPI(DUZ(2)) ;Convert to extrinsic /gek 8/2003
I $$EXIST(EKGPLACE) D
. I $$CONSOLID^MAGBAPI() S EKG1=$O(^MAG(2005.2,"F",EKGPLACE,"EKG","")) ; DBI - SEB 9/20/2002
. E S EKG1=$O(^MAG(2005.2,"E","EKG",""))
. S MAGR=$P(^MAG(2005.2,+EKG1,0),U,6)
. Q
E S MAGR=0
Q
SHARE(MAGRY,TYPE) ;RPC [MAG GET NETLOC]
; Get list of image shares
;TYPE = One of the STORAGE TYPE codes : MAG, EKG, WORM, URL or ALL
N TMP,I,DATA0,DATA2,DATA3,DATA6,INFO,VALUE,STYP,PHYREF
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
S:TYPE="" TYPE="ALL"
S MAGRY(0)="1^SUCCESS"
S I=0 F S I=$O(^MAG(2005.2,I)) Q:'I D
. Q:$$LOCDRIVE(I)
. S DATA0=$G(^MAG(2005.2,I,0))
. S DATA2=$G(^MAG(2005.2,I,2))
. S DATA3=$G(^MAG(2005.2,I,3))
. S DATA6=$G(^MAG(2005.2,I,6))
. ;
. S PHYREF=$P(DATA0,"^",2) ; PHYSICAL REFERENCE
. S STYP=$P(DATA0,"^",7) ; STORAGE TYPE
. ;
. I TYPE'="ALL" Q:STYP'[TYPE
. Q:$P(DATA0,"^",6)=0 ; Share is offline (don't return offline shares)
. I STYP'="URL" Q:($E(PHYREF,1,2)'="\\") ; pre 45
. ;
. S INFO=$S($E(PHYREF,$L(PHYREF))="\":$E(PHYREF,1,$L(PHYREF)-1),1:PHYREF)
. S $P(INFO,"^",2)=$P(DATA0,"^",7) ; Physical reference (path)
. S $P(INFO,"^",3)=$P(DATA0,"^",6) ; Operational Status 0=OFFLINE 1=ONLINE
. S $P(INFO,"^",4)=$P(DATA2,"^",1) ; Username
. S $P(INFO,"^",5)=$P(DATA2,"^",2) ; Password
. S $P(INFO,"^",6)=$P(DATA6,"^",1) ; MUSE Site #
. S $P(INFO,"^",7)=$P($G(^MAG(2006.17,+$P(DATA6,"^",2),0)),"^",1) ; MUSE version #
. S $P(INFO,"^",8)=$P(DATA3,"^",5) ; Network location SITE
. S $P(INFO,"^",9)=$P(DATA0,"^",10) ; Place
. S:'$D(TMP(INFO)) TMP(INFO)=I
. Q
S INFO="" F S INFO=$O(TMP(INFO)) Q:INFO="" D
. S MAGRY($O(MAGRY(""),-1)+1)=TMP(INFO)_"^"_INFO
. Q
Q
;
LOCDRIVE(I) ; Returns 1 if this is a local drive, else 0
; Local Drive is determined by the DIR not being Type : URL and having a ":"
I $P(^MAG(2005.2,I,0),"^",7)'="URL" I $P(^MAG(2005.2,I,0),"^",2)[":" Q 1
Q 0
;
GETENV(MAGRY) ;RPC [MAG GET ENV]
; Get some environment variables (used by annotation control)
S MAGRY=DUZ(2)_"^"_$$NOW^XLFDT
Q
;
ANNCB(STATARR) ;Status Callback (called by the import API)
;
N I,CDUZ,QINDEX,MAGA,COUNT
N XMDUZ,XMSUB,XMTEXT,XMY
; 0 = error, all others are success.
I $P(STATARR(0),"^",1)'=0 D
. ; Import was successful
E D
. ; Import failed - send mail to MAG SERVER group and person who queued the import
. S XMDUZ=DUZ
. S XMSUB="Import Error Report"
. ; get text of message from status array
. S XMTEXT="MAGA("
. ; XMD needs array to start with 1, not 0
. S COUNT=1,I=""
. F S I=$O(STATARR(I)) Q:I="" D
. . S MAGA(COUNT)=I_") "_STATARR(I)
. . S COUNT=COUNT+1
. . Q
. S MAGA(COUNT+1)=" "
. S MAGA(COUNT+2)=" "
. S MAGA(COUNT+3)=" The errors listed above were generated by"
. S MAGA(COUNT+4)=" the VistA Imaging Annotation Editor while"
. S MAGA(COUNT+5)=" trying to import your diagram. Please"
. S MAGA(COUNT+6)=" report these errors to your VistA Imaging"
. S MAGA(COUNT+7)=" support personnel."
. ;Get person who did the import
. S QINDEX=STATARR(2)
. S I=-1 F S I=$O(^MAG(2006.034,QINDEX,1,I)) Q:I="" D
. . I $P($G(^MAG(2006.034,QINDEX,1,I,0)),"^",1)=8 S CDUZ=$P(^MAG(2006.034,QINDEX,1,I,0),"^",2)
. ;Set recipients of message
. S XMY("G.MAG SERVER")=""
. I $G(CDUZ) S XMY(CDUZ)=""
. D ^XMD
. Q
Q
;
GETCTP(MAGRY,DATA) ;RPC [MAG4 CT PRESETS GET]
; INPUT
; DATA = set of flags to determine which set of CT PRESETS
; to return to client. if $P(DATA,^,1)=2 then the second
; set of CT PRESETS will be returned.
; OUTPUT
; MAGRY = the set of presets from Imaging Site Paramters File
S DATA=$G(DATA)
N MAGPLC
S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
I 'MAGPLC S MAGRY="0^Error resolving Users Division" Q
I $P(DATA,"^",1)=2 S MAGRY=$G(^MAG(2006.1,MAGPLC,"CT2"))
E S MAGRY=$G(^MAG(2006.1,MAGPLC,"CT"))
I MAGRY="" S MAGRY="0^Site doesn't have CT Presets defined." Q
S MAGRY="1^"_MAGRY
Q
;
SAVECTP(MAGRY,VALUE,DATA) ;RPC [MAG4 CT PRESETS SAVE]
; DATA = set of flags to determine which set of CT PRESETS
; are being saved. if $P(DATA,^,1)=2 then VALUE will be saved
; as CT PRESETS 2
S DATA=$G(DATA)
N MAGPLC
S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
I 'MAGPLC S MAGRY="0^Error resolving Users Division" Q
I $P(DATA,"^",1)=2 S ^MAG(2006.1,MAGPLC,"CT2")=VALUE
E S ^MAG(2006.1,MAGPLC,"CT")=VALUE
S MAGRY="1^CT Presets saved."
Q
;
NETPLCS ; Create an array of Place, SiteCodes for all entries of
; Network Location entries.
N I,PLC,PLCODE,CONS
S CONS=$$CONSOLID^MAGBAPI
I 'CONS S PLC=$O(^MAG(2006.1,0)),PLCODE=$P(^MAG(2006.1,PLC,0),"^",9)
;
K MAGJOB("NETPLC")
S I=0 F S I=$O(^MAG(2005.2,I)) Q:'I D
. I 'CONS S MAGJOB("NETPLC",I)=PLC_"^"_PLCODE Q
. ; Here, for consolidated sites we get the real Site IEN, and Site Code.
. I CONS S PLC=$P($G(^MAG(2005.2,I,0)),"^",10),PLCODE=$S(PLC:$P($G(^MAG(2006.1,PLC,0)),"^",9),1:"n/a")
. S MAGJOB("NETPLC",I)=PLC_"^"_PLCODE
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTU6 8767 printed Dec 13, 2024@02:03:30 Page 2
MAGGTU6 ;WOIFO/GEK,MLH,MAT,JSL/MKN - Silent Utilities ; 12/6/2022 12:43 PM
+1 ;;3.0;IMAGING;**24,8,48,45,20,46,59,72,93,117,138,334**;Mar 19, 2002;Build 51
+2 ;; Per VA Directive 6402, 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 ;
LOGACT(MAGRY,DATA) ;RPC [MAGGACTION LOG]
+1 ; Call to LogAction from Delphi Window
+2 ;
+3 ; DATA is input variable it is '^' delimited string
+4 ; 'A|B|C|D|E' ^^ MAGIEN ^ 'Copy/Download' ^ DFN ^ '1';
+5 ; DUZ is inserted as 2nd piece below.
+6 ; I.E. DATA = "C^^103660^Copy To Clipboard^1033^1"
+7 NEW Y
+8 SET MAGRY="0^Logging access..."
+9 ;
+10 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGGTERR"
+11 ; C DUZ MAGIEN ACTION DFN 1 Additional Data
+12 DO ENTRY^MAGLOG($PIECE(DATA,U),+$GET(DUZ),$PIECE(DATA,U,3),$PIECE(DATA,U,4),$PIECE(DATA,U,5),$PIECE(DATA,U,6),$PIECE(DATA,U,7))
+13 SET MAGRY="1^Action was Logged."
+14 QUIT
+15 ;
LINKDT(MAGRY,MAGDA,DTTM) ; This is called when an Image is successfully
+1 ; linked (Associated) with a Report/Procedure/Note etc.
+2 ; MAGDA = Image IEN
+3 ; DTTM = "" No date sent, so use NOW
+4 ; DTTM = 1 No Date Sent, but use Image capture Date.
+5 ; DTTM = Valid FM Date/Time , Use it.
+6 NEW MSG
+7 SET DTTM=$GET(DTTM)
+8 ; Using NOW
IF 'DTTM
SET DTTM=$$NOW^XLFDT
+9 IF '$DATA(^MAG(2005,MAGDA))
QUIT
+10 ; Using Date Image Captured.
IF DTTM=1
SET DTTM=$PIECE(^MAG(2005,MAGDA,2),"^",1)
+11 IF '$$VALID^MAGGSIV1(2005,64,.DTTM,.MSG)
SET MAGRY="0^"_MSG
QUIT
+12 SET $PIECE(^MAG(2005,MAGDA,2),"^",11)=DTTM
+13 SET MAGRY="1^Okay"
+14 QUIT
+15 ;
TIMEOUT(MAGRY,APP) ;RPC [MAGG GET TIMEOUT]
+1 ; Call Returns the timeout for the APP from IMAGING SITE PARAMETERS File
+2 ; APP is either 'DISPLAY', 'CAPTURE', 'VISTARAD', 'TELEREADER', 'IMPORTER', or 'TELEPATHOLOGY'
+3 NEW I,MAGTIMES,MAGPLC
+4 SET MAGRY=""
+5 ; DBI - SEB 9/20/2002
SET MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
IF 'MAGPLC
QUIT
+6 SET MAGTIMES=$GET(^MAG(2006.1,MAGPLC,"KEYS"))
+7 ;p334 - default timeout to 6 (MINS) if field #121 is null
IF APP="DISPLAY"
SET MAGRY=$PIECE(MAGTIMES,U,2)
if MAGRY=""
SET MAGRY=6
+8 IF APP="CAPTURE"
SET MAGRY=$PIECE(MAGTIMES,U,3)
+9 IF APP="VISTARAD"
SET MAGRY=$PIECE(MAGTIMES,U,4)
+10 ; MJK - 2006.01.25 - TeleReader
IF APP="TELEREADER"
SET MAGRY=$PIECE(MAGTIMES,U,6)
+11 ; MAT - *136
IF APP="IMPORTER"
SET MAGRY=$PIECE(MAGTIMES,U,8)
+12 ; JSL - *138 (field#135) - Telepathology
IF APP="TELEPATHOLOGY"
SET MAGRY=+$PIECE(MAGTIMES,U,9)
+13 QUIT
+14 ;
EXIST(EKGPLACE) ;Does an ekg server exist in 2005.2
+1 ; DBI - SEB 9/20/2002
IF $$CONSOLID^MAGBAPI()=0
QUIT $ORDER(^MAG(2005.2,"E","EKG",""))
+2 QUIT $ORDER(^MAG(2005.2,"F",EKGPLACE,"EKG",""))
+3 ;
ONLINE(MAGR) ;RPC [MAG EKG ONLINE] EKG network location status
+1 ;returns the status of the first EKG network location type
+2 ;0 if offline or a network location doesn't exist
+3 ;1 if online
+4 ;
+5 NEW EKG1,EKGPLACE
+6 ; DBI - SEB 9/20/2002
SET EKGPLACE=$$PLACE^MAGBAPI(DUZ(2))
+7 ;Convert to extrinsic /gek 8/2003
IF EKGPLACE=0
SET EKGPLACE=$$PLACE^MAGBAPI(DUZ(2))
+8 IF $$EXIST(EKGPLACE)
Begin DoDot:1
+9 ; DBI - SEB 9/20/2002
IF $$CONSOLID^MAGBAPI()
SET EKG1=$ORDER(^MAG(2005.2,"F",EKGPLACE,"EKG",""))
+10 IF '$TEST
SET EKG1=$ORDER(^MAG(2005.2,"E","EKG",""))
+11 SET MAGR=$PIECE(^MAG(2005.2,+EKG1,0),U,6)
+12 QUIT
End DoDot:1
+13 IF '$TEST
SET MAGR=0
+14 QUIT
SHARE(MAGRY,TYPE) ;RPC [MAG GET NETLOC]
+1 ; Get list of image shares
+2 ;TYPE = One of the STORAGE TYPE codes : MAG, EKG, WORM, URL or ALL
+3 NEW TMP,I,DATA0,DATA2,DATA3,DATA6,INFO,VALUE,STYP,PHYREF
+4 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+5 if TYPE=""
SET TYPE="ALL"
+6 SET MAGRY(0)="1^SUCCESS"
+7 SET I=0
FOR
SET I=$ORDER(^MAG(2005.2,I))
if 'I
QUIT
Begin DoDot:1
+8 if $$LOCDRIVE(I)
QUIT
+9 SET DATA0=$GET(^MAG(2005.2,I,0))
+10 SET DATA2=$GET(^MAG(2005.2,I,2))
+11 SET DATA3=$GET(^MAG(2005.2,I,3))
+12 SET DATA6=$GET(^MAG(2005.2,I,6))
+13 ;
+14 ; PHYSICAL REFERENCE
SET PHYREF=$PIECE(DATA0,"^",2)
+15 ; STORAGE TYPE
SET STYP=$PIECE(DATA0,"^",7)
+16 ;
+17 IF TYPE'="ALL"
if STYP'[TYPE
QUIT
+18 ; Share is offline (don't return offline shares)
if $PIECE(DATA0,"^",6)=0
QUIT
+19 ; pre 45
IF STYP'="URL"
if ($EXTRACT(PHYREF,1,2)'="\\")
QUIT
+20 ;
+21 SET INFO=$SELECT($EXTRACT(PHYREF,$LENGTH(PHYREF))="\":$EXTRACT(PHYREF,1,$LENGTH(PHYREF)-1),1:PHYREF)
+22 ; Physical reference (path)
SET $PIECE(INFO,"^",2)=$PIECE(DATA0,"^",7)
+23 ; Operational Status 0=OFFLINE 1=ONLINE
SET $PIECE(INFO,"^",3)=$PIECE(DATA0,"^",6)
+24 ; Username
SET $PIECE(INFO,"^",4)=$PIECE(DATA2,"^",1)
+25 ; Password
SET $PIECE(INFO,"^",5)=$PIECE(DATA2,"^",2)
+26 ; MUSE Site #
SET $PIECE(INFO,"^",6)=$PIECE(DATA6,"^",1)
+27 ; MUSE version #
SET $PIECE(INFO,"^",7)=$PIECE($GET(^MAG(2006.17,+$PIECE(DATA6,"^",2),0)),"^",1)
+28 ; Network location SITE
SET $PIECE(INFO,"^",8)=$PIECE(DATA3,"^",5)
+29 ; Place
SET $PIECE(INFO,"^",9)=$PIECE(DATA0,"^",10)
+30 if '$DATA(TMP(INFO))
SET TMP(INFO)=I
+31 QUIT
End DoDot:1
+32 SET INFO=""
FOR
SET INFO=$ORDER(TMP(INFO))
if INFO=""
QUIT
Begin DoDot:1
+33 SET MAGRY($ORDER(MAGRY(""),-1)+1)=TMP(INFO)_"^"_INFO
+34 QUIT
End DoDot:1
+35 QUIT
+36 ;
LOCDRIVE(I) ; Returns 1 if this is a local drive, else 0
+1 ; Local Drive is determined by the DIR not being Type : URL and having a ":"
+2 IF $PIECE(^MAG(2005.2,I,0),"^",7)'="URL"
IF $PIECE(^MAG(2005.2,I,0),"^",2)[":"
QUIT 1
+3 QUIT 0
+4 ;
GETENV(MAGRY) ;RPC [MAG GET ENV]
+1 ; Get some environment variables (used by annotation control)
+2 SET MAGRY=DUZ(2)_"^"_$$NOW^XLFDT
+3 QUIT
+4 ;
ANNCB(STATARR) ;Status Callback (called by the import API)
+1 ;
+2 NEW I,CDUZ,QINDEX,MAGA,COUNT
+3 NEW XMDUZ,XMSUB,XMTEXT,XMY
+4 ; 0 = error, all others are success.
+5 IF $PIECE(STATARR(0),"^",1)'=0
Begin DoDot:1
+6 ; Import was successful
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 ; Import failed - send mail to MAG SERVER group and person who queued the import
+9 SET XMDUZ=DUZ
+10 SET XMSUB="Import Error Report"
+11 ; get text of message from status array
+12 SET XMTEXT="MAGA("
+13 ; XMD needs array to start with 1, not 0
+14 SET COUNT=1
SET I=""
+15 FOR
SET I=$ORDER(STATARR(I))
if I=""
QUIT
Begin DoDot:2
+16 SET MAGA(COUNT)=I_") "_STATARR(I)
+17 SET COUNT=COUNT+1
+18 QUIT
End DoDot:2
+19 SET MAGA(COUNT+1)=" "
+20 SET MAGA(COUNT+2)=" "
+21 SET MAGA(COUNT+3)=" The errors listed above were generated by"
+22 SET MAGA(COUNT+4)=" the VistA Imaging Annotation Editor while"
+23 SET MAGA(COUNT+5)=" trying to import your diagram. Please"
+24 SET MAGA(COUNT+6)=" report these errors to your VistA Imaging"
+25 SET MAGA(COUNT+7)=" support personnel."
+26 ;Get person who did the import
+27 SET QINDEX=STATARR(2)
+28 SET I=-1
FOR
SET I=$ORDER(^MAG(2006.034,QINDEX,1,I))
if I=""
QUIT
Begin DoDot:2
+29 IF $PIECE($GET(^MAG(2006.034,QINDEX,1,I,0)),"^",1)=8
SET CDUZ=$PIECE(^MAG(2006.034,QINDEX,1,I,0),"^",2)
End DoDot:2
+30 ;Set recipients of message
+31 SET XMY("G.MAG SERVER")=""
+32 IF $GET(CDUZ)
SET XMY(CDUZ)=""
+33 DO ^XMD
+34 QUIT
End DoDot:1
+35 QUIT
+36 ;
GETCTP(MAGRY,DATA) ;RPC [MAG4 CT PRESETS GET]
+1 ; INPUT
+2 ; DATA = set of flags to determine which set of CT PRESETS
+3 ; to return to client. if $P(DATA,^,1)=2 then the second
+4 ; set of CT PRESETS will be returned.
+5 ; OUTPUT
+6 ; MAGRY = the set of presets from Imaging Site Paramters File
+7 SET DATA=$GET(DATA)
+8 NEW MAGPLC
+9 SET MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
+10 IF 'MAGPLC
SET MAGRY="0^Error resolving Users Division"
QUIT
+11 IF $PIECE(DATA,"^",1)=2
SET MAGRY=$GET(^MAG(2006.1,MAGPLC,"CT2"))
+12 IF '$TEST
SET MAGRY=$GET(^MAG(2006.1,MAGPLC,"CT"))
+13 IF MAGRY=""
SET MAGRY="0^Site doesn't have CT Presets defined."
QUIT
+14 SET MAGRY="1^"_MAGRY
+15 QUIT
+16 ;
SAVECTP(MAGRY,VALUE,DATA) ;RPC [MAG4 CT PRESETS SAVE]
+1 ; DATA = set of flags to determine which set of CT PRESETS
+2 ; are being saved. if $P(DATA,^,1)=2 then VALUE will be saved
+3 ; as CT PRESETS 2
+4 SET DATA=$GET(DATA)
+5 NEW MAGPLC
+6 SET MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
+7 IF 'MAGPLC
SET MAGRY="0^Error resolving Users Division"
QUIT
+8 IF $PIECE(DATA,"^",1)=2
SET ^MAG(2006.1,MAGPLC,"CT2")=VALUE
+9 IF '$TEST
SET ^MAG(2006.1,MAGPLC,"CT")=VALUE
+10 SET MAGRY="1^CT Presets saved."
+11 QUIT
+12 ;
NETPLCS ; Create an array of Place, SiteCodes for all entries of
+1 ; Network Location entries.
+2 NEW I,PLC,PLCODE,CONS
+3 SET CONS=$$CONSOLID^MAGBAPI
+4 IF 'CONS
SET PLC=$ORDER(^MAG(2006.1,0))
SET PLCODE=$PIECE(^MAG(2006.1,PLC,0),"^",9)
+5 ;
+6 KILL MAGJOB("NETPLC")
+7 SET I=0
FOR
SET I=$ORDER(^MAG(2005.2,I))
if 'I
QUIT
Begin DoDot:1
+8 IF 'CONS
SET MAGJOB("NETPLC",I)=PLC_"^"_PLCODE
QUIT
+9 ; Here, for consolidated sites we get the real Site IEN, and Site Code.
+10 IF CONS
SET PLC=$PIECE($GET(^MAG(2005.2,I,0)),"^",10)
SET PLCODE=$SELECT(PLC:$PIECE($GET(^MAG(2006.1,PLC,0)),"^",9),1:"n/a")
+11 SET MAGJOB("NETPLC",I)=PLC_"^"_PLCODE
+12 QUIT
End DoDot:1
+13 QUIT
