MAGUSIT ;WOIFO/SRR/RMP - IMAGE SITE PARAMETERS COMPANION [ 06/29/2001 18:28 ]
;;3.0;IMAGING;**3,8,20**;Apr 12, 2006
;; +---------------------------------------------------------------+
;; | 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. |
;; +---------------------------------------------------------------+
;;
INI ;
N NAME,D0,MAGDA,CNMSP,PLACE
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
I $D(^MAG(2006.1,PLACE,0)),$L($P(^(0),U,2))=3 Q
S NAME=$$KSP^XUPARAM("WHERE")
I NAME[".MED" S NAME=$P(NAME,".MED",1)_$P(NAME,".MED",2)
S MAGDA=$O(^MAG(2006.19,"B",NAME,""))
S FN=$S('MAGDA:$$UNDEF(NAME),1:$P($G(^MAG(2006.19,MAGDA,0)),U,4))
I FN="" D LNOIS Q
D PNMSP(PLACE,FN)
Q
PNMSP(PLACE,FN) ;
S CNMSP=$P(^MAG(2006.1,PLACE,0),U,2)
I $L(CNMSP)>0 D ;UPDATE MULTI NAMESPACE
. K DIE,DINUM,FDA,DIERR
. S FDA(2006.11,"+1,"_PLACE_",",.01)=CNMSP
. D UPDATE^DIE("U","FDA")
. K FDA Q
I $D(DIERR) D LNOIS Q
D BMES^XPDUTL("Imaging SITE is: "_NAME_" Namespace: "_FN)
K FDA,DIE,DINUM,DIERR
S FDA(2006.1,PLACE_",",.02)=FN
D UPDATE^DIE("U","FDA")
K FDA
I $D(DIERR) D LNOIS
Q
LNOIS ;
D BMES^XPDUTL(" Contact the National Help desk to update a namespace!") Q
UNDEF(NAME) ;The domain is undefined in the Image site file (2006.19)
N ASK,Y,FN
S DIR("A")="Enter the type of account"
S DIR("?")="Enter either T for a test account or P for a production account",DIR("B")="T"
S DIR(0)="S0^T:Test;P:PRODUCTION"
D ^DIR S ASK=Y
K DIR
I ASK="T" S FN="ZZT"
I ASK="P" D
. S FN=$$ONE^MAGQAI(NAME)
. D UI(NAME,FN) ;MAIL MESSAGE TO LAVC-SERVER/IMAGE DEVELOPERS
Q FN
EXIT ;EXIT
K DIC,DIE,DA,DR,MAM,NET,WORK
Q
UI(DOMAIN,INIT) ;UPDATE IMAGING DISTRIBUTION
N Y,LOC
D NOW^%DTC S Y=% D DD^%DT
S LOC=$$KSP^XUPARAM("WHERE")
S ^TMP($J,"MAGQ",1)=" SITE: "_LOC
S ^TMP($J,"MAGQ",2)=" DATE: "_Y_" "_$G(^XMB("TIMEZONE"))
S ^TMP($J,"MAGQ",3)=" DOMAIN: "_DOMAIN
S ^TMP($J,"MAGQ",4)=" INITIALS: "_INIT
D MAILIT
K ^TMP($J,"MAGQ")
Q
MAILIT ;Send the report to the Clinical Application Time
N XMSUB
S XMSUB="Update Site file from "_LOC
MAILSHR ;Shared Mail server code
;If droping in...must manage XMSUB
N XMY,XMTEXT,D,D0,D1,D2,DG,DIC,DICR,DIW,INDX
S XMTEXT="^TMP($J,""MAGQ"")"
I $G(DUZ) S XMY(DUZ)="",XMDUZ=DUZ
E S XMY(.5)="",XMDUZ=.5
S XMY("G.MAG SERVER")=""
S:$G(MAGDUZ) XMY(MAGDUZ)=""
S XMSUBJ=XMSUB
S XMBODY=XMTEXT
S INDX=""
F S INDX=$O(XMY(INDX)) Q:INDX="" S XMTO(INDX)=""
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ,)
K XMBODY,XMSUBJ,XMTO,XMZ
Q
ISN(RESULT,FILENAME,NETSIZE,JBSIZE) ; Image File Size variance Notice
N Y,LOC,XMSUB,DIS,CAP,CNT,I,VR,DM,INST
K ^TMP($J,"MAGQ")
D NOW^%DTC S Y=% D DD^%DT
S INST=$S($$CONSOLID^MAGBAPI():$$GET1^DIQ(2006.1,$$PLACE^MAGBAPI(+$G(DUZ(2))),.01),1:$$KSP^XUPARAM("INST"))
S XMSUB="Image File Size Variance: "_$$GET1^DIQ(4,INST,.01)
S ^TMP($J,"MAGQ",1)=" SITE: "_$$GET1^DIQ(4,INST,.01)_"^"_INST
S ^TMP($J,"MAGQ",2)=" DATE: "_Y_" "_$G(^XMB("TIMEZONE"))
S ^TMP($J,"MAGQ",3)=" DOMAIN: "_$$KSP^XUPARAM("WHERE")
S ^TMP($J,"MAGQ",4)=" Filename: "_FILENAME
S ^TMP($J,"MAGQ",5)="Vista Cache Size: "_NETSIZE
S ^TMP($J,"MAGQ",6)=" Jukebox Size: "_JBSIZE
D MAILSHR
S RESULT="1"
K ^TMP($J,"MAGQ")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUSIT 4122 printed Oct 16, 2024@18:09:43 Page 2
MAGUSIT ;WOIFO/SRR/RMP - IMAGE SITE PARAMETERS COMPANION [ 06/29/2001 18:28 ]
+1 ;;3.0;IMAGING;**3,8,20**;Apr 12, 2006
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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 ;;
INI ;
+1 NEW NAME,D0,MAGDA,CNMSP,PLACE
+2 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+3 IF $DATA(^MAG(2006.1,PLACE,0))
IF $LENGTH($PIECE(^(0),U,2))=3
QUIT
+4 SET NAME=$$KSP^XUPARAM("WHERE")
+5 IF NAME[".MED"
SET NAME=$PIECE(NAME,".MED",1)_$PIECE(NAME,".MED",2)
+6 SET MAGDA=$ORDER(^MAG(2006.19,"B",NAME,""))
+7 SET FN=$SELECT('MAGDA:$$UNDEF(NAME),1:$PIECE($GET(^MAG(2006.19,MAGDA,0)),U,4))
+8 IF FN=""
DO LNOIS
QUIT
+9 DO PNMSP(PLACE,FN)
+10 QUIT
PNMSP(PLACE,FN) ;
+1 SET CNMSP=$PIECE(^MAG(2006.1,PLACE,0),U,2)
+2 ;UPDATE MULTI NAMESPACE
IF $LENGTH(CNMSP)>0
Begin DoDot:1
+3 KILL DIE,DINUM,FDA,DIERR
+4 SET FDA(2006.11,"+1,"_PLACE_",",.01)=CNMSP
+5 DO UPDATE^DIE("U","FDA")
+6 KILL FDA
QUIT
End DoDot:1
+7 IF $DATA(DIERR)
DO LNOIS
QUIT
+8 DO BMES^XPDUTL("Imaging SITE is: "_NAME_" Namespace: "_FN)
+9 KILL FDA,DIE,DINUM,DIERR
+10 SET FDA(2006.1,PLACE_",",.02)=FN
+11 DO UPDATE^DIE("U","FDA")
+12 KILL FDA
+13 IF $DATA(DIERR)
DO LNOIS
+14 QUIT
LNOIS ;
+1 DO BMES^XPDUTL(" Contact the National Help desk to update a namespace!")
QUIT
UNDEF(NAME) ;The domain is undefined in the Image site file (2006.19)
+1 NEW ASK,Y,FN
+2 SET DIR("A")="Enter the type of account"
+3 SET DIR("?")="Enter either T for a test account or P for a production account"
SET DIR("B")="T"
+4 SET DIR(0)="S0^T:Test;P:PRODUCTION"
+5 DO ^DIR
SET ASK=Y
+6 KILL DIR
+7 IF ASK="T"
SET FN="ZZT"
+8 IF ASK="P"
Begin DoDot:1
+9 SET FN=$$ONE^MAGQAI(NAME)
+10 ;MAIL MESSAGE TO LAVC-SERVER/IMAGE DEVELOPERS
DO UI(NAME,FN)
End DoDot:1
+11 QUIT FN
EXIT ;EXIT
+1 KILL DIC,DIE,DA,DR,MAM,NET,WORK
+2 QUIT
UI(DOMAIN,INIT) ;UPDATE IMAGING DISTRIBUTION
+1 NEW Y,LOC
+2 DO NOW^%DTC
SET Y=%
DO DD^%DT
+3 SET LOC=$$KSP^XUPARAM("WHERE")
+4 SET ^TMP($JOB,"MAGQ",1)=" SITE: "_LOC
+5 SET ^TMP($JOB,"MAGQ",2)=" DATE: "_Y_" "_$GET(^XMB("TIMEZONE"))
+6 SET ^TMP($JOB,"MAGQ",3)=" DOMAIN: "_DOMAIN
+7 SET ^TMP($JOB,"MAGQ",4)=" INITIALS: "_INIT
+8 DO MAILIT
+9 KILL ^TMP($JOB,"MAGQ")
+10 QUIT
MAILIT ;Send the report to the Clinical Application Time
+1 NEW XMSUB
+2 SET XMSUB="Update Site file from "_LOC
MAILSHR ;Shared Mail server code
+1 ;If droping in...must manage XMSUB
+2 NEW XMY,XMTEXT,D,D0,D1,D2,DG,DIC,DICR,DIW,INDX
+3 SET XMTEXT="^TMP($J,""MAGQ"")"
+4 IF $GET(DUZ)
SET XMY(DUZ)=""
SET XMDUZ=DUZ
+5 IF '$TEST
SET XMY(.5)=""
SET XMDUZ=.5
+6 SET XMY("G.MAG SERVER")=""
+7 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+8 SET XMSUBJ=XMSUB
+9 SET XMBODY=XMTEXT
+10 SET INDX=""
+11 FOR
SET INDX=$ORDER(XMY(INDX))
if INDX=""
QUIT
SET XMTO(INDX)=""
+12 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ,)
+13 KILL XMBODY,XMSUBJ,XMTO,XMZ
+14 QUIT
ISN(RESULT,FILENAME,NETSIZE,JBSIZE) ; Image File Size variance Notice
+1 NEW Y,LOC,XMSUB,DIS,CAP,CNT,I,VR,DM,INST
+2 KILL ^TMP($JOB,"MAGQ")
+3 DO NOW^%DTC
SET Y=%
DO DD^%DT
+4 SET INST=$SELECT($$CONSOLID^MAGBAPI():$$GET1^DIQ(2006.1,$$PLACE^MAGBAPI(+$GET(DUZ(2))),.01),1:$$KSP^XUPARAM("INST"))
+5 SET XMSUB="Image File Size Variance: "_$$GET1^DIQ(4,INST,.01)
+6 SET ^TMP($JOB,"MAGQ",1)=" SITE: "_$$GET1^DIQ(4,INST,.01)_"^"_INST
+7 SET ^TMP($JOB,"MAGQ",2)=" DATE: "_Y_" "_$GET(^XMB("TIMEZONE"))
+8 SET ^TMP($JOB,"MAGQ",3)=" DOMAIN: "_$$KSP^XUPARAM("WHERE")
+9 SET ^TMP($JOB,"MAGQ",4)=" Filename: "_FILENAME
+10 SET ^TMP($JOB,"MAGQ",5)="Vista Cache Size: "_NETSIZE
+11 SET ^TMP($JOB,"MAGQ",6)=" Jukebox Size: "_JBSIZE
+12 DO MAILSHR
+13 SET RESULT="1"
+14 KILL ^TMP($JOB,"MAGQ")
+15 QUIT
+16 ;
