- 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 Jan 18, 2025@03:04:43 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