MAGKIDS1 ;WOIFO/SG - INSTALLATION UTILITIES ; 21 Nov 2011 2:48pm
;;3.0;IMAGING;**93,118**;Mar 19, 2002;Build 4525;May 01, 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. |
;; +---------------------------------------------------------------+
;;
; This routine uses the following ICRs:
;
; #3232 Read access to file #9.7 (private)
; #4389 Read access to file #9.7 (private)
; #10075 R/W access to subfile #19.05 (supported)
; #4011 Read access to file #8994 (controlled)
;
; ??? - #4389 has to be updated to include fields 9, 11,
; and 17 of the file #9.7!
Q
;
;##### ADDS RPC NAME(S) TO THE RPC MULTIPLE OF THE OPTION
;
; [.]RPCNAMES Names of the remote procedures:
;
; * Single name can be passed by value;
;
; * One or more names can be passed as subscripts of
; a local array passed by reference;
;
; * A reference to the list of RPC names in the
; source code of an routine can be passed as
; the TAG^ROUTINE value of the RPCNAMES. The
; routine must be in the MAG namespace.
;
; OPTNAME Name of the option (RPC Broker context)
;
; [FLAGS] Flags that control the execution (can be combined):
;
; S If this flag is provided, the procedure will
; work in "silent" mode. Nothing will be
; displayed on the console or stored into the
; INSTALLATION file (#9.7).
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Success
;
ADDRPCS(RPCNAMES,OPTNAME,FLAGS) ;
N IENS,MAGFDA,MAGMSG,MAGRC,NAME,OPTIEN,RPCIEN,SILENT
;
;=== Validate and prepare parameters
S FLAGS=$G(FLAGS),SILENT=(FLAGS["S")
;--- Single RPC name or a list?
I $D(RPCNAMES)<10 Q:$G(RPCNAMES)?." " $$IPVE^MAGUERR("RPCNAMES") D
. N I,GET
. ;--- TAG^ROUTINE or single RPC name?
. I RPCNAMES'?1.8UN1"^MAG"1.5UN S RPCNAMES(RPCNAMES)="" Q
. ;--- Get the list from the source code
. S GET=$P(RPCNAMES,"^")_"+I^"_$P(RPCNAMES,"^",2)
. S GET="S NAME=$$TRIM^XLFSTR($P($T("_GET_"),"";;"",2))"
. F I=1:1 X GET Q:NAME="" S RPCNAMES(NAME)=""
. Q
;--- Name of the menu option (RPC Broker context)
S OPTIEN=$$LKOPT^XPDMENU(OPTNAME)
Q:OPTIEN'>0 $$ERROR^MAGUERR(-44,,OPTNAME)
;
;=== Add the names to the multiple
D:'SILENT BMES^MAGKIDS("Attaching RPCs to the '"_OPTNAME_"' option...")
S NAME="",MAGRC=0
F S NAME=$O(RPCNAMES(NAME)) Q:NAME="" D Q:MAGRC<0
. D:'SILENT MES^MAGKIDS(NAME)
. ;--- Check if the remote procedure exists
. S RPCIEN=$$FIND1^DIC(8994,,"X",NAME,"B",,"MAGMSG")
. I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",8994) Q
. I RPCIEN'>0 S MAGRC=$$ERROR^MAGUERR(-45,,NAME) Q
. ;--- Add the remote procedure to the multiple
. S IENS="?+1,"_OPTIEN_","
. S MAGFDA(19.05,IENS,.01)=RPCIEN
. D UPDATE^DIE(,"MAGFDA",,"MAGMSG")
. I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",19.05,IENS) Q
. ;---
. Q
I MAGRC<0 D:'SILENT MES^MAGKIDS("ABORTED!") Q MAGRC
;
;=== Success
D:'SILENT MES^MAGKIDS("RPCs have been successfully attached.")
Q 0
;
;##### SENDS THE PATCH INSTALLATION E-MAIL
;
; [MAGDUZ] IEN of the user who will get the e-mail in
; addition to the G.MAG SERVER mail group.
;
; Input variables
; ===============
; XPDA, XPDNM
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Success
; Notes
; =====
;
; This entry point should be called ONLY from the KIDS post-install
; code.
;
; This entry point can also be called as a procedure:
; D NOTIFY^MAGKIDS1() if you do not need its return value.
;
NOTIFY() ;
N CNT,CT,IENS,MAGBUF,MAGERR,MAGMSG,MAGRC,ST,Y
S MAGRC=0,IENS=XPDA_","
;
;--- Load the build properties from the BUILD file (#9.7)
D GETS^DIQ(9.7,IENS,".01;6;9;11;17;51","EI","MAGBUF","MAGERR")
D:$G(DIERR) DBS^MAGUERR("MAGERR",9.7,IENS)
;
;--- Compile the message text
S CNT=0
S CNT=CNT+1,MAGMSG(CNT)="PACKAGE INSTALL"
S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_XPDNM
S CNT=CNT+1,MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
S ST=$G(MAGBUF(9.7,IENS,11,"I"))
S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
S CT=$G(MAGBUF(9.7,IENS,17,"I")) S:+CT'=CT CT=$$NOW^XLFDT()
S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
D GETENV^%ZOSV
S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
S CNT=CNT+1,MAGMSG(CNT)="FILE COMMENT: "_$G(MAGBUF(9.7,IENS,6,"I"))
S CNT=CNT+1,MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$G(MAGBUF(9.7,IENS,9,"E"))
S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_$G(MAGBUF(9.7,IENS,.01,"E"))
S Y=$G(MAGBUF(9.7,IENS,51,"E"))
S CNT=CNT+1,MAGMSG(CNT)="Distribution Date: "_Y
;
;--- Send the e-mail notification
D
. N DIFROM,XMERR,XMID,XMSUB,XMY,XMZ
. S XMSUB=$E(XPDNM_" INSTALLATION",1,63)
. S XMID=$G(DUZ) S:XMID'>0 XMID=.5
. S (XMY(XMID),XMY("G.MAG SERVER"))=""
. D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ)
. Q:'$G(XMERR)
. K MAGERR M MAGERR=^TMP("XMERR",$J)
. S MAGRC=$$ERROR^MAGUERR(-46,.MAGERR)
. Q
;
;---
Q:$QUIT MAGRC Q
;
;##### TURNS THE VERSION CHECKING ON FOR CLINICAL CLIENTS
;
; [FLAGS] Flags that control the execution (can be combined):
;
; S If this flag is provided, the procedure will
; work in "silent" mode. Nothing will be
; displayed on the console or stored into the
; INSTALLATION file (#9.7).
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Success
; Notes
; =====
;
; This entry point can also be called as a procedure:
; D VERCHKON^MAGKIDS1() if you do not need its return value.
;
VERCHKON(FLAGS) ;
N MAGIEN,MAGMSG,MAGRC,MSG1,MSG2,SILENT,TMP
S FLAGS=$G(FLAGS),SILENT=(FLAGS["S")
D:'SILENT
. S TMP=+$P($G(XPDNM),"*",3) ; Patch number
. S MSG1=$S(TMP:"Patch "_TMP_" is turning",1:"Turning")
. S MSG1=MSG1_" Version Checking ON..."
. D MES^MAGKIDS("")
. Q
S MAGRC=0
;===
S MAGIEN=0
F S MAGIEN=$O(^MAG(2006.1,MAGIEN)) Q:'MAGIEN D Q:MAGRC<0
. S MSG2="is already ON, no action taken"
. ;--- Turn the version checking ON for the site
. I '$P($G(^MAG(2006.1,MAGIEN,"KEYS")),U,5) D Q:MAGRC<0
. . N MAGFDA
. . S MAGFDA(2006.1,MAGIEN_",",130)=1
. . D FILE^DIE(,"MAGFDA","MAGMSG")
. . I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",2006.1,MAGIEN_",") Q
. . S MSG2="has been turned ON"
. . Q
. Q:SILENT
. ;--- Display the status message
. S TMP=$P($G(^MAG(2006.1,MAGIEN,0)),U) ; Institution IEN
. D MES^MAGKIDS(MSG1)
. D MES^MAGKIDS("Version Checking "_MSG2_" for Site: "_TMP)
. Q
;===
Q:$QUIT MAGRC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGKIDS1 7952 printed Dec 13, 2024@02:07:07 Page 2
MAGKIDS1 ;WOIFO/SG - INSTALLATION UTILITIES ; 21 Nov 2011 2:48pm
+1 ;;3.0;IMAGING;**93,118**;Mar 19, 2002;Build 4525;May 01, 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 ; This routine uses the following ICRs:
+18 ;
+19 ; #3232 Read access to file #9.7 (private)
+20 ; #4389 Read access to file #9.7 (private)
+21 ; #10075 R/W access to subfile #19.05 (supported)
+22 ; #4011 Read access to file #8994 (controlled)
+23 ;
+24 ; ??? - #4389 has to be updated to include fields 9, 11,
+25 ; and 17 of the file #9.7!
+26 QUIT
+27 ;
+28 ;##### ADDS RPC NAME(S) TO THE RPC MULTIPLE OF THE OPTION
+29 ;
+30 ; [.]RPCNAMES Names of the remote procedures:
+31 ;
+32 ; * Single name can be passed by value;
+33 ;
+34 ; * One or more names can be passed as subscripts of
+35 ; a local array passed by reference;
+36 ;
+37 ; * A reference to the list of RPC names in the
+38 ; source code of an routine can be passed as
+39 ; the TAG^ROUTINE value of the RPCNAMES. The
+40 ; routine must be in the MAG namespace.
+41 ;
+42 ; OPTNAME Name of the option (RPC Broker context)
+43 ;
+44 ; [FLAGS] Flags that control the execution (can be combined):
+45 ;
+46 ; S If this flag is provided, the procedure will
+47 ; work in "silent" mode. Nothing will be
+48 ; displayed on the console or stored into the
+49 ; INSTALLATION file (#9.7).
+50 ;
+51 ; Return Values
+52 ; =============
+53 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+54 ; 0 Success
+55 ;
ADDRPCS(RPCNAMES,OPTNAME,FLAGS) ;
+1 NEW IENS,MAGFDA,MAGMSG,MAGRC,NAME,OPTIEN,RPCIEN,SILENT
+2 ;
+3 ;=== Validate and prepare parameters
+4 SET FLAGS=$GET(FLAGS)
SET SILENT=(FLAGS["S")
+5 ;--- Single RPC name or a list?
+6 IF $DATA(RPCNAMES)<10
if $GET(RPCNAMES)?." "
QUIT $$IPVE^MAGUERR("RPCNAMES")
Begin DoDot:1
+7 NEW I,GET
+8 ;--- TAG^ROUTINE or single RPC name?
+9 IF RPCNAMES'?1.8UN1"^MAG"1.5UN
SET RPCNAMES(RPCNAMES)=""
QUIT
+10 ;--- Get the list from the source code
+11 SET GET=$PIECE(RPCNAMES,"^")_"+I^"_$PIECE(RPCNAMES,"^",2)
+12 SET GET="S NAME=$$TRIM^XLFSTR($P($T("_GET_"),"";;"",2))"
+13 FOR I=1:1
XECUTE GET
if NAME=""
QUIT
SET RPCNAMES(NAME)=""
+14 QUIT
End DoDot:1
+15 ;--- Name of the menu option (RPC Broker context)
+16 SET OPTIEN=$$LKOPT^XPDMENU(OPTNAME)
+17 if OPTIEN'>0
QUIT $$ERROR^MAGUERR(-44,,OPTNAME)
+18 ;
+19 ;=== Add the names to the multiple
+20 if 'SILENT
DO BMES^MAGKIDS("Attaching RPCs to the '"_OPTNAME_"' option...")
+21 SET NAME=""
SET MAGRC=0
+22 FOR
SET NAME=$ORDER(RPCNAMES(NAME))
if NAME=""
QUIT
Begin DoDot:1
+23 if 'SILENT
DO MES^MAGKIDS(NAME)
+24 ;--- Check if the remote procedure exists
+25 SET RPCIEN=$$FIND1^DIC(8994,,"X",NAME,"B",,"MAGMSG")
+26 IF $GET(DIERR)
SET MAGRC=$$DBS^MAGUERR("MAGMSG",8994)
QUIT
+27 IF RPCIEN'>0
SET MAGRC=$$ERROR^MAGUERR(-45,,NAME)
QUIT
+28 ;--- Add the remote procedure to the multiple
+29 SET IENS="?+1,"_OPTIEN_","
+30 SET MAGFDA(19.05,IENS,.01)=RPCIEN
+31 DO UPDATE^DIE(,"MAGFDA",,"MAGMSG")
+32 IF $GET(DIERR)
SET MAGRC=$$DBS^MAGUERR("MAGMSG",19.05,IENS)
QUIT
+33 ;---
+34 QUIT
End DoDot:1
if MAGRC<0
QUIT
+35 IF MAGRC<0
if 'SILENT
DO MES^MAGKIDS("ABORTED!")
QUIT MAGRC
+36 ;
+37 ;=== Success
+38 if 'SILENT
DO MES^MAGKIDS("RPCs have been successfully attached.")
+39 QUIT 0
+40 ;
+41 ;##### SENDS THE PATCH INSTALLATION E-MAIL
+42 ;
+43 ; [MAGDUZ] IEN of the user who will get the e-mail in
+44 ; addition to the G.MAG SERVER mail group.
+45 ;
+46 ; Input variables
+47 ; ===============
+48 ; XPDA, XPDNM
+49 ;
+50 ; Return Values
+51 ; =============
+52 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+53 ; 0 Success
+54 ; Notes
+55 ; =====
+56 ;
+57 ; This entry point should be called ONLY from the KIDS post-install
+58 ; code.
+59 ;
+60 ; This entry point can also be called as a procedure:
+61 ; D NOTIFY^MAGKIDS1() if you do not need its return value.
+62 ;
NOTIFY() ;
+1 NEW CNT,CT,IENS,MAGBUF,MAGERR,MAGMSG,MAGRC,ST,Y
+2 SET MAGRC=0
SET IENS=XPDA_","
+3 ;
+4 ;--- Load the build properties from the BUILD file (#9.7)
+5 DO GETS^DIQ(9.7,IENS,".01;6;9;11;17;51","EI","MAGBUF","MAGERR")
+6 if $GET(DIERR)
DO DBS^MAGUERR("MAGERR",9.7,IENS)
+7 ;
+8 ;--- Compile the message text
+9 SET CNT=0
+10 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE INSTALL"
+11 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+12 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_XPDNM
+13 SET CNT=CNT+1
SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
+14 SET ST=$GET(MAGBUF(9.7,IENS,11,"I"))
+15 SET CNT=CNT+1
SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
+16 SET CT=$GET(MAGBUF(9.7,IENS,17,"I"))
if +CT'=CT
SET CT=$$NOW^XLFDT()
+17 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+18 SET CNT=CNT+1
SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
+19 DO GETENV^%ZOSV
+20 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+21 SET CNT=CNT+1
SET MAGMSG(CNT)="FILE COMMENT: "_$GET(MAGBUF(9.7,IENS,6,"I"))
+22 SET CNT=CNT+1
SET MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
+23 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$GET(MAGBUF(9.7,IENS,9,"E"))
+24 SET CNT=CNT+1
SET MAGMSG(CNT)="Install Name: "_$GET(MAGBUF(9.7,IENS,.01,"E"))
+25 SET Y=$GET(MAGBUF(9.7,IENS,51,"E"))
+26 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution Date: "_Y
+27 ;
+28 ;--- Send the e-mail notification
+29 Begin DoDot:1
+30 NEW DIFROM,XMERR,XMID,XMSUB,XMY,XMZ
+31 SET XMSUB=$EXTRACT(XPDNM_" INSTALLATION",1,63)
+32 SET XMID=$GET(DUZ)
if XMID'>0
SET XMID=.5
+33 SET (XMY(XMID),XMY("G.MAG SERVER"))=""
+34 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ)
+35 if '$GET(XMERR)
QUIT
+36 KILL MAGERR
MERGE MAGERR=^TMP("XMERR",$JOB)
+37 SET MAGRC=$$ERROR^MAGUERR(-46,.MAGERR)
+38 QUIT
End DoDot:1
+39 ;
+40 ;---
+41 if $QUIT
QUIT MAGRC
QUIT
+42 ;
+43 ;##### TURNS THE VERSION CHECKING ON FOR CLINICAL CLIENTS
+44 ;
+45 ; [FLAGS] Flags that control the execution (can be combined):
+46 ;
+47 ; S If this flag is provided, the procedure will
+48 ; work in "silent" mode. Nothing will be
+49 ; displayed on the console or stored into the
+50 ; INSTALLATION file (#9.7).
+51 ;
+52 ; Return Values
+53 ; =============
+54 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+55 ; 0 Success
+56 ; Notes
+57 ; =====
+58 ;
+59 ; This entry point can also be called as a procedure:
+60 ; D VERCHKON^MAGKIDS1() if you do not need its return value.
+61 ;
VERCHKON(FLAGS) ;
+1 NEW MAGIEN,MAGMSG,MAGRC,MSG1,MSG2,SILENT,TMP
+2 SET FLAGS=$GET(FLAGS)
SET SILENT=(FLAGS["S")
+3 if 'SILENT
Begin DoDot:1
+4 ; Patch number
SET TMP=+$PIECE($GET(XPDNM),"*",3)
+5 SET MSG1=$SELECT(TMP:"Patch "_TMP_" is turning",1:"Turning")
+6 SET MSG1=MSG1_" Version Checking ON..."
+7 DO MES^MAGKIDS("")
+8 QUIT
End DoDot:1
+9 SET MAGRC=0
+10 ;===
+11 SET MAGIEN=0
+12 FOR
SET MAGIEN=$ORDER(^MAG(2006.1,MAGIEN))
if 'MAGIEN
QUIT
Begin DoDot:1
+13 SET MSG2="is already ON, no action taken"
+14 ;--- Turn the version checking ON for the site
+15 IF '$PIECE($GET(^MAG(2006.1,MAGIEN,"KEYS")),U,5)
Begin DoDot:2
+16 NEW MAGFDA
+17 SET MAGFDA(2006.1,MAGIEN_",",130)=1
+18 DO FILE^DIE(,"MAGFDA","MAGMSG")
+19 IF $GET(DIERR)
SET MAGRC=$$DBS^MAGUERR("MAGMSG",2006.1,MAGIEN_",")
QUIT
+20 SET MSG2="has been turned ON"
+21 QUIT
End DoDot:2
if MAGRC<0
QUIT
+22 if SILENT
QUIT
+23 ;--- Display the status message
+24 ; Institution IEN
SET TMP=$PIECE($GET(^MAG(2006.1,MAGIEN,0)),U)
+25 DO MES^MAGKIDS(MSG1)
+26 DO MES^MAGKIDS("Version Checking "_MSG2_" for Site: "_TMP)
+27 QUIT
End DoDot:1
if MAGRC<0
QUIT
+28 ;===
+29 if $QUIT
QUIT MAGRC
QUIT
