Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGGTU6

MAGGTU6.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VA Directive 6402, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ;
  1. LOGACT(MAGRY,DATA) ;RPC [MAGGACTION LOG]
  1. ; Call to LogAction from Delphi Window
  1. ;
  1. ; DATA is input variable it is '^' delimited string
  1. ; 'A|B|C|D|E' ^^ MAGIEN ^ 'Copy/Download' ^ DFN ^ '1';
  1. ; DUZ is inserted as 2nd piece below.
  1. ; I.E. DATA = "C^^103660^Copy To Clipboard^1033^1"
  1. N Y
  1. S MAGRY="0^Logging access..."
  1. ;
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"
  1. ; C DUZ MAGIEN ACTION DFN 1 Additional Data
  1. 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))
  1. S MAGRY="1^Action was Logged."
  1. Q
  1. ;
  1. LINKDT(MAGRY,MAGDA,DTTM) ; This is called when an Image is successfully
  1. ; linked (Associated) with a Report/Procedure/Note etc.
  1. ; MAGDA = Image IEN
  1. ; DTTM = "" No date sent, so use NOW
  1. ; DTTM = 1 No Date Sent, but use Image capture Date.
  1. ; DTTM = Valid FM Date/Time , Use it.
  1. N MSG
  1. S DTTM=$G(DTTM)
  1. I 'DTTM S DTTM=$$NOW^XLFDT ; Using NOW
  1. I '$D(^MAG(2005,MAGDA)) Q
  1. I DTTM=1 S DTTM=$P(^MAG(2005,MAGDA,2),"^",1) ; Using Date Image Captured.
  1. I '$$VALID^MAGGSIV1(2005,64,.DTTM,.MSG) S MAGRY="0^"_MSG Q
  1. S $P(^MAG(2005,MAGDA,2),"^",11)=DTTM
  1. S MAGRY="1^Okay"
  1. Q
  1. ;
  1. TIMEOUT(MAGRY,APP) ;RPC [MAGG GET TIMEOUT]
  1. ; Call Returns the timeout for the APP from IMAGING SITE PARAMETERS File
  1. ; APP is either 'DISPLAY', 'CAPTURE', 'VISTARAD', 'TELEREADER', 'IMPORTER', or 'TELEPATHOLOGY'
  1. N I,MAGTIMES,MAGPLC
  1. S MAGRY=""
  1. S MAGPLC=$$PLACE^MAGBAPI(DUZ(2)) I 'MAGPLC Q ; DBI - SEB 9/20/2002
  1. S MAGTIMES=$G(^MAG(2006.1,MAGPLC,"KEYS"))
  1. I APP="DISPLAY" S MAGRY=$P(MAGTIMES,U,2) S:MAGRY="" MAGRY=6 ;p334 - default timeout to 6 (MINS) if field #121 is null
  1. I APP="CAPTURE" S MAGRY=$P(MAGTIMES,U,3)
  1. I APP="VISTARAD" S MAGRY=$P(MAGTIMES,U,4)
  1. I APP="TELEREADER" S MAGRY=$P(MAGTIMES,U,6) ; MJK - 2006.01.25 - TeleReader
  1. I APP="IMPORTER" S MAGRY=$P(MAGTIMES,U,8) ; MAT - *136
  1. I APP="TELEPATHOLOGY" S MAGRY=+$P(MAGTIMES,U,9) ; JSL - *138 (field#135) - Telepathology
  1. Q
  1. ;
  1. EXIST(EKGPLACE) ;Does an ekg server exist in 2005.2
  1. I $$CONSOLID^MAGBAPI()=0 Q $O(^MAG(2005.2,"E","EKG","")) ; DBI - SEB 9/20/2002
  1. Q $O(^MAG(2005.2,"F",EKGPLACE,"EKG",""))
  1. ;
  1. ONLINE(MAGR) ;RPC [MAG EKG ONLINE] EKG network location status
  1. ;returns the status of the first EKG network location type
  1. ;0 if offline or a network location doesn't exist
  1. ;1 if online
  1. ;
  1. N EKG1,EKGPLACE
  1. S EKGPLACE=$$PLACE^MAGBAPI(DUZ(2)) ; DBI - SEB 9/20/2002
  1. I EKGPLACE=0 S EKGPLACE=$$PLACE^MAGBAPI(DUZ(2)) ;Convert to extrinsic /gek 8/2003
  1. I $$EXIST(EKGPLACE) D
  1. . I $$CONSOLID^MAGBAPI() S EKG1=$O(^MAG(2005.2,"F",EKGPLACE,"EKG","")) ; DBI - SEB 9/20/2002
  1. . E S EKG1=$O(^MAG(2005.2,"E","EKG",""))
  1. . S MAGR=$P(^MAG(2005.2,+EKG1,0),U,6)
  1. . Q
  1. E S MAGR=0
  1. Q
  1. SHARE(MAGRY,TYPE) ;RPC [MAG GET NETLOC]
  1. ; Get list of image shares
  1. ;TYPE = One of the STORAGE TYPE codes : MAG, EKG, WORM, URL or ALL
  1. N TMP,I,DATA0,DATA2,DATA3,DATA6,INFO,VALUE,STYP,PHYREF
  1. N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
  1. S:TYPE="" TYPE="ALL"
  1. S MAGRY(0)="1^SUCCESS"
  1. S I=0 F S I=$O(^MAG(2005.2,I)) Q:'I D
  1. . Q:$$LOCDRIVE(I)
  1. . S DATA0=$G(^MAG(2005.2,I,0))
  1. . S DATA2=$G(^MAG(2005.2,I,2))
  1. . S DATA3=$G(^MAG(2005.2,I,3))
  1. . S DATA6=$G(^MAG(2005.2,I,6))
  1. . ;
  1. . S PHYREF=$P(DATA0,"^",2) ; PHYSICAL REFERENCE
  1. . S STYP=$P(DATA0,"^",7) ; STORAGE TYPE
  1. . ;
  1. . I TYPE'="ALL" Q:STYP'[TYPE
  1. . Q:$P(DATA0,"^",6)=0 ; Share is offline (don't return offline shares)
  1. . I STYP'="URL" Q:($E(PHYREF,1,2)'="\\") ; pre 45
  1. . ;
  1. . S INFO=$S($E(PHYREF,$L(PHYREF))="\":$E(PHYREF,1,$L(PHYREF)-1),1:PHYREF)
  1. . S $P(INFO,"^",2)=$P(DATA0,"^",7) ; Physical reference (path)
  1. . S $P(INFO,"^",3)=$P(DATA0,"^",6) ; Operational Status 0=OFFLINE 1=ONLINE
  1. . S $P(INFO,"^",4)=$P(DATA2,"^",1) ; Username
  1. . S $P(INFO,"^",5)=$P(DATA2,"^",2) ; Password
  1. . S $P(INFO,"^",6)=$P(DATA6,"^",1) ; MUSE Site #
  1. . S $P(INFO,"^",7)=$P($G(^MAG(2006.17,+$P(DATA6,"^",2),0)),"^",1) ; MUSE version #
  1. . S $P(INFO,"^",8)=$P(DATA3,"^",5) ; Network location SITE
  1. . S $P(INFO,"^",9)=$P(DATA0,"^",10) ; Place
  1. . S:'$D(TMP(INFO)) TMP(INFO)=I
  1. . Q
  1. S INFO="" F S INFO=$O(TMP(INFO)) Q:INFO="" D
  1. . S MAGRY($O(MAGRY(""),-1)+1)=TMP(INFO)_"^"_INFO
  1. . Q
  1. Q
  1. ;
  1. 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 ":"
  1. I $P(^MAG(2005.2,I,0),"^",7)'="URL" I $P(^MAG(2005.2,I,0),"^",2)[":" Q 1
  1. Q 0
  1. ;
  1. GETENV(MAGRY) ;RPC [MAG GET ENV]
  1. ; Get some environment variables (used by annotation control)
  1. S MAGRY=DUZ(2)_"^"_$$NOW^XLFDT
  1. Q
  1. ;
  1. ANNCB(STATARR) ;Status Callback (called by the import API)
  1. ;
  1. N I,CDUZ,QINDEX,MAGA,COUNT
  1. N XMDUZ,XMSUB,XMTEXT,XMY
  1. ; 0 = error, all others are success.
  1. I $P(STATARR(0),"^",1)'=0 D
  1. . ; Import was successful
  1. E D
  1. . ; Import failed - send mail to MAG SERVER group and person who queued the import
  1. . S XMDUZ=DUZ
  1. . S XMSUB="Import Error Report"
  1. . ; get text of message from status array
  1. . S XMTEXT="MAGA("
  1. . ; XMD needs array to start with 1, not 0
  1. . S COUNT=1,I=""
  1. . F S I=$O(STATARR(I)) Q:I="" D
  1. . . S MAGA(COUNT)=I_") "_STATARR(I)
  1. . . S COUNT=COUNT+1
  1. . . Q
  1. . S MAGA(COUNT+1)=" "
  1. . S MAGA(COUNT+2)=" "
  1. . S MAGA(COUNT+3)=" The errors listed above were generated by"
  1. . S MAGA(COUNT+4)=" the VistA Imaging Annotation Editor while"
  1. . S MAGA(COUNT+5)=" trying to import your diagram. Please"
  1. . S MAGA(COUNT+6)=" report these errors to your VistA Imaging"
  1. . S MAGA(COUNT+7)=" support personnel."
  1. . ;Get person who did the import
  1. . S QINDEX=STATARR(2)
  1. . S I=-1 F S I=$O(^MAG(2006.034,QINDEX,1,I)) Q:I="" D
  1. . . I $P($G(^MAG(2006.034,QINDEX,1,I,0)),"^",1)=8 S CDUZ=$P(^MAG(2006.034,QINDEX,1,I,0),"^",2)
  1. . ;Set recipients of message
  1. . S XMY("G.MAG SERVER")=""
  1. . I $G(CDUZ) S XMY(CDUZ)=""
  1. . D ^XMD
  1. . Q
  1. Q
  1. ;
  1. GETCTP(MAGRY,DATA) ;RPC [MAG4 CT PRESETS GET]
  1. ; INPUT
  1. ; DATA = set of flags to determine which set of CT PRESETS
  1. ; to return to client. if $P(DATA,^,1)=2 then the second
  1. ; set of CT PRESETS will be returned.
  1. ; OUTPUT
  1. ; MAGRY = the set of presets from Imaging Site Paramters File
  1. S DATA=$G(DATA)
  1. N MAGPLC
  1. S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
  1. I 'MAGPLC S MAGRY="0^Error resolving Users Division" Q
  1. I $P(DATA,"^",1)=2 S MAGRY=$G(^MAG(2006.1,MAGPLC,"CT2"))
  1. E S MAGRY=$G(^MAG(2006.1,MAGPLC,"CT"))
  1. I MAGRY="" S MAGRY="0^Site doesn't have CT Presets defined." Q
  1. S MAGRY="1^"_MAGRY
  1. Q
  1. ;
  1. SAVECTP(MAGRY,VALUE,DATA) ;RPC [MAG4 CT PRESETS SAVE]
  1. ; DATA = set of flags to determine which set of CT PRESETS
  1. ; are being saved. if $P(DATA,^,1)=2 then VALUE will be saved
  1. ; as CT PRESETS 2
  1. S DATA=$G(DATA)
  1. N MAGPLC
  1. S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
  1. I 'MAGPLC S MAGRY="0^Error resolving Users Division" Q
  1. I $P(DATA,"^",1)=2 S ^MAG(2006.1,MAGPLC,"CT2")=VALUE
  1. E S ^MAG(2006.1,MAGPLC,"CT")=VALUE
  1. S MAGRY="1^CT Presets saved."
  1. Q
  1. ;
  1. NETPLCS ; Create an array of Place, SiteCodes for all entries of
  1. ; Network Location entries.
  1. N I,PLC,PLCODE,CONS
  1. S CONS=$$CONSOLID^MAGBAPI
  1. I 'CONS S PLC=$O(^MAG(2006.1,0)),PLCODE=$P(^MAG(2006.1,PLC,0),"^",9)
  1. ;
  1. K MAGJOB("NETPLC")
  1. S I=0 F S I=$O(^MAG(2005.2,I)) Q:'I D
  1. . I 'CONS S MAGJOB("NETPLC",I)=PLC_"^"_PLCODE Q
  1. . ; Here, for consolidated sites we get the real Site IEN, and Site Code.
  1. . 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")
  1. . S MAGJOB("NETPLC",I)=PLC_"^"_PLCODE
  1. . Q
  1. Q