MAGIP39B ;Post init routine to queue site activity at install. ; 14 Oct 2010 4:41 PM
;;3.0;IMAGING;**39**;Mar 19, 2002;Build 2010;Mar 08, 2011
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
POST ;
N I,NLIST,PLACE,FLDAR,PL
K ^MAG(2006.8,"B") ; Remove "B" cross-reference
S PLACE=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),""))
D BMES^XPDUTL("Updating MAG WINDOWS: "_$$FMTE^XLFDT($$NOW^XLFDT))
D ADDRPC^MAGQBUT4("MAGQB QUEDEL","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ JBQUE","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAG FIELD VALIDATE","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAG KEY VALIDATE","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ FTYPE","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ DFNIQ","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ JBSCN","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ FS CHNGE","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ QRNGE","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ FINDC","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ QCNT","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ ALL SERVER","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ ADD RAID GROUP","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ DEL NLOC","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQBP ALL SHARES","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQBP FREF","MAG WINDOWS")
D ADDRPC^MAGQBUT4("MAGQ BP UAT","MAG WINDOWS")
D BMES^XPDUTL("Add Generic Mail Message groups to the Mail Group file: "_$$FMTE^XLFDT($$NOW^XLFDT))
D ADDMG ; Add Generic Mail Message groups to the Mail Group file (XMB(3.8)
D BMES^XPDUTL("Add Message Subjects for Mail Management to Site Parameters - with interval: "_$$FMTE^XLFDT($$NOW^XLFDT))
D ADDMS(6) ; Add Message Subjects for Mail Management to Site Parameters - with interval
D BMES^XPDUTL("Add Generic Mail groups to BP Message subfile: "_$$FMTE^XLFDT($$NOW^XLFDT))
D DLKP ; Add Generic Mail groups to BP Message subfile
D BMES^XPDUTL("Add Raid Groups to the Network Location file: "_$$FMTE^XLFDT($$NOW^XLFDT))
D ADDRG(4) ; Add Raid Groups to the Network Location file
D FAR^MAGQBUT6(.FLDAR) ; Setup File/Node/Piece Table for FieldNumbers
D GETRL^MAGQBU6A(.NLIST) ; Get a list of duplicate shares
D BMES^XPDUTL("Initialize raid groups to group default: "_$$FMTE^XLFDT($$NOW^XLFDT))
D IRG ; Initialize raid groups to group default
D PRIME^MAGQBUT6(.NLIST) D BMES^XPDUTL("Setting Prime entries on line.") ;Set prime entries online
D SPRR^MAGQBUT6(.NLIST) D BMES^XPDUTL("Updating Imaging Site Parameter file with prime entries.") ;Update the Site Parameter file
D BMES^XPDUTL("Add Photo-ID Post Action to the Image Action file: "_$$FMTE^XLFDT($$NOW^XLFDT))
D PID ; Add Photo-ID Post Action to the Image Action file
D BMES^XPDUTL("Set POP/AUTO Purge 'ON' as the default & Purge Factor as '2' & Purge by 'Last Access Date': "_$$FMTE^XLFDT($$NOW^XLFDT))
D DPOP ; Set Express/AUTO Purge 'ON' as the default & Purge Factor as '2' & Purge by 'Last Access Date'
D BMES^XPDUTL("Setup Auto-Verify: "_$$FMTE^XLFDT($$NOW^XLFDT))
D AVSET ; Setup Auto-Verify
D BMES^XPDUTL("Re-index Site Parameters, BP Servers, Network Location file: "_$$FMTE^XLFDT($$NOW^XLFDT))
D INDEX
D RMBPMSG
D BMES^XPDUTL("Setup dummy UAT (Unassigned Tasks) BP Servers: "_$$FMTE^XLFDT($$NOW^XLFDT))
D PURVER ; Add Auto Purge and Scheduled Verify to the BP server that has JUKEBOX assigned.
D SUAT ; Setup dummy UAT (Unassigned Tasks) BP Servers
D RTRS^MAGQBUT6 ;send an email on routers.
D TASKIT("ACXREF^MAGQE7(0,0)","Setting AC X-reference in file 2006.95","Setting AC X-reference in file #2006.95.")
D TASKIT("CONSHR^MAGQBUT6","Consolidate redundant shares utility","Consolidate redundant shares.")
D TASKIT("CAS^MAGQBUT5","Purging queues in file 2006.041","Purging completed import queues in file #2006.041.")
D RD ; Remove data from retired fields 2006.1:2.02,2.03,13,14,15,16,17,18,19,21,24 set photo id default
S PL=0 F S PL=$O(^MAG(2006.1,PL)) Q:'PL S:$P($G(^MAG(2006.1,PL,1)),U,5)="" $P(^MAG(2006.1,PL,1),U,5)="30" ;Restore a value - CR 685
D BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
Q
SUAT ; Setup dummy UAT (Unassigned Tasks) BP Servers
N PL
S PL=0
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. Q:$D(^MAG(2006.8,"C",PL,"Unassigned Tasks")) ; Do not re-configure
. D UAT^MAGQBUT5("",PL)
Q
ADDRG(CNT) ; Add Raid Groups to the Network Location file
N PL,I,J,VALUE,NMSP,DUP,TMP,MAGFDA,RESULT
S PL=0
K ^MAG(2005.2,"AC"),^MAG(2005.2,"B"),^MAG(2005.2,"C"),^MAG(2005.2,"D"),^MAG(2005.2,"G")
S DIK="^MAG(2005.2,"
D IXALL^DIK K DIK
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. Q:$D(^MAG(2005.2,"F",PL,"GRP")) ; Do not reconfigure
. S NMSP=$P($G(^MAG(2006.1,PL,0)),U,2)
. I NMSP="" D Q
. . S TMP=$$GET1^DIQ("4",$P($G(^MAG(2006.1,PL,0)),U,1),".01","","","")
. . D BMES^XPDUTL("No namespace is defined for: "_TMP_" in the Site Parameter file (#2006.1)")
. . Q
. D ADDRG^MAGQBUT5(.RESULT,CNT,PL)
. Q
Q
AVSET ; Setup Auto-Verify - To run at midnight, nightly (no more than 48 hours, limited to the run)
N PL,DIERR,MAGERR,MAGFDA
S PL=0
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. Q:$P($G(^MAG(2006.1,PL,"BPVERIFIER")),U,1)'="" ; Do not re-configure
. S MAGFDA(2006.1,PL_",",62)="1" ; SCHEDULED VERIFY
. S MAGFDA(2006.1,PL_",",62.2)="1" ; SCHEDULED VERIFIER FREQUENCY
. S MAGFDA(2006.1,PL_",",62.4)="2355" ; SCHEDULED VERIFIER TIME
. S MAGFDA(2006.1,PL_",",62.3)=$$DT^XLFDT ; DATE OF NEXT VERIFY
. D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
. I $D(DIERR) D
. . N TMP S TMP=$P(^DIC(4,$O(^DIC(4,"D",$P($G(^MAG(2006.1,PL,0)),U,1),"")),0),U,1)
. . D BMES^XPDUTL("Error adding default Auto-Verify options to "_TMP_" Error text: "_MAGERR("DIERR",1,"TEXT",1))
. . Q
. K MAG,DIERR,MAGFDA,MAGERR
. Q
Q
IRG ; Initialize raid groups to group default
N DA,EN,PC,PL,INDX,ZNODE,GD,MAGIEN,MAGERR,SUBIX
;The following sets all duplicate share as READ ONLY in preparation of adding enties to the Group.
S EN="" S EN=$O(NLIST(EN)) D:EN'=""
. S EN="" F S EN=$O(NLIST(EN)) Q:EN="" D
. . F PC=2:1:$L(NLIST(EN),U) S DA=$P(NLIST(EN),U,PC) Q:'DA D:$D(^MAG(2005.2,DA,0))
. . . I $P(^MAG(2005.2,DA,0),U,7)="MAG",'+$P(^(0),U,9)!($P(^MAG(2005.2,DA,0),U,7)["WORM") D ;Mag type and not router
. . . . S MAGFDA(2005.2,DA_",",5.5)=1 ;Set as READ ONLY
. . . . D FILE^DIE("","MAGFDA","MAGMSG")
. . . . I $D(MSG("DIERR")) D BMES^XPDUTL("Duplicate entry: '"_DA_" failed to be set offline. ")
. . . . K MAGFDA,MAGMSG
. . . . Q
. . . Q
. . Q
. Q
S PL=0
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. Q:$P($G(^MAG(2006.1,PL,0)),U,10)'="" ; Do not Re-configure
. S GD=$O(^MAG(2005.2,"F",PL,"GRP","")) ; first Raid Group
. Q:'GD
. S $P(^MAG(2006.1,PL,0),U,10)=GD ; by default set the sites Current Group to the 1st
. S (INDX,SUBIX)=0
. F S INDX=$O(^MAG(2005.2,INDX)) Q:'INDX D
. . S ZNODE=$G(^MAG(2005.2,INDX,0))
. . Q:$P(ZNODE,U,10)'=PL
. . Q:$P(ZNODE,U,6,7)'["1^MAG"
. . Q:$P(ZNODE,U,9)="1" ;ROUTING SHARE
. . Q:$P(ZNODE,U,8)'="Y" ;not hashed
. . Q:$P($G(^MAG(2005.2,INDX,1)),U,6)="1" ;Read Only
. . Q:+$P($G(^MAG(2005.2,INDX,1)),U,8)>0 ;Already assigned
. . S $P(^MAG(2005.2,INDX,1),U,8)=GD
. . S SUBIX=SUBIX+1
. . S MAGFDA(2005.22,"+"_SUBIX_","_GD_",",.01)=INDX
. . D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
. . I $D(DIERR) D BMES^XPDUTL("Error adding Raid Group subentry: "_MAGERR("DIERR",1,"TEXT",1))
. . K MAGFDA,DIERR,MSGIEN,MAGERR
. . Q
. Q
Q
ADDMS(INTERVAL) ; Add Message Subjects for Mail Management
N I,J,K,MAGFDA,MSG,IEN,MAGERR
S IEN=0
F S IEN=$O(^MAG(2006.1,IEN)) Q:'IEN D
. F J=1:1:19 S K=$P($T(TEXT+J),";",3) D
. . Q:$D(^MAG(2006.1,IEN,6,"B",K)) ; Do not re-configure
. . S MAGFDA(2006.166,"?+1,"_IEN_",",.01)=K
. . S MAGFDA(2006.166,"?+1,"_IEN_",",1)=INTERVAL
. . D UPDATE^DIE("","MAGFDA","","MAGERR")
. . I $D(DIERR) D BMES^XPDUTL("Error updating the BP Mail Message Subfile: "_MAGERR("DIERR",1,"TEXT",1)) K DIERR,MAGERR
. . Q
. Q
Q
ADDMG ; Add Mail Message groups to the Mail Group file (XMB(3.8))
N PL,NMSP
S PL=0
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. S NMSP=$P($G(^MAG(2006.1,PL,0)),U,2)
. Q:NMSP=""
. D ADD(NMSP)
. Q
Q
ADD(NMSP) ;
N J,K,L,MAGFDA,MSG,IEN,MAGIEN,MAGERR
F J=1:1:19 S K=$P($T(TEXT+J),";",3) D
. I '$D(^XMB(3.8,"B","MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(K),1,20))) D
. . S L=$O(^XMB(3.8,"B","MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(K),1,20),""))
. . S MAGFDA(3.8,"?+"_J_",",.01)="MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(K),1,20)
. . D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
. . I $D(DIERR) D BMES^XPDUTL("Error Adding Imaging Mail Groups: "_MAGERR("DIERR",1,"TEXT",1)) K DIERR,MAGERR,MAGFDA Q
. . K MAGFDA,DIERR,MAGERR
. . S MAGFDA(3.8,MAGIEN(J)_",",4)="PU"
. . D FILE^DIE("I","MAGFDA","MAGERR")
. . K MAGFDA,DIERR,MAGERR
. . S MAGFDA(3.81,"?+1,"_MAGIEN(J)_",",.01)=DUZ
. . D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
. . I $D(DIERR) D BMES^XPDUTL("Error Adding Imaging Mail Group member: "_MAGERR("DIERR",1,"TEXT",1))
. . K DIERR,MAGERR,MAGFDA,MAGIEN
. E D
. . S L=$O(^XMB(3.8,"B","MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(K),1,20),""))
. . S MAGFDA(3.81,"?+1,"_L_",",.01)=DUZ
. . D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
. . I $D(DIERR) D BMES^XPDUTL("Error Adding Imaging Mail Group member: "_MAGERR("DIERR",1,"TEXT",1))
. . K DIERR,MAGERR,MAGFDA,MAGIEN
. Q
Q
DLKP ; Add Generic Mail groups to BP Message subfile
N PL,I,J,MAGFDA,MSGROOT,MG,DIERR,MAGIEN,MAGERR,NMSP
S PL=0
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. S I=0,NMSP=$P($G(^MAG(2006.1,PL,0)),U,2)
. Q:NMSP=""
. F S I=$O(^MAG(2006.1,PL,6,I)) Q:'I D
. . S MG=$P($G(^MAG(2006.1,PL,6,I,0)),"^",1)
. . S J=$$FIND1^DIC(3.8,"","","MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(MG),1,20),"","","MSGROOT")
. . Q:$D(^MAG(2006.1,PL,6,I,1,"B",J)) ; Do not re-configure
. . I J D
. . . S MAGFDA(2006.1662,"+1,"_I_","_PL_",",.01)=J
. . . D UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
. . . I $D(DIERR) D BMES^XPDUTL("Error Adding Generic Mail Groups: "_MAGERR("DIERR",1,"TEXT",1)) K DIERR,MAGERR
. . . Q
. . Q
. Q
K MAGFDA,MSGROOT,MAGIEN,MSGROOT
Q
DPOP ; Set the POP Purge value to a default of 'ON' & Purge Factor as '2'
N PL,MAGFDA,DIERR,MAGIEN,MAGERR
S PL=0
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. Q:$P($G(^MAG(2006.1,PL,"BPPURGE")),U,4)'="" ; Do not re-configure
. S MAGFDA(2006.1,PL_",",60.2)="1" ;Express Purge ON
. S MAGFDA(2006.1,PL_",",60)="1" ;Auto Purge ON
. S MAGFDA(2006.1,PL_",",60.1)="DA" ;Purge by: Date Accessed
. S MAGFDA(2006.1,PL_",",60.3)="100000" ; Express Purge Rate 100,000
. S MAGFDA(2006.1,PL_",",60.5)="1" ; Purge Factor
. D UPDATE^DIE("","MAGFDA","","MAGERR")
. I $D(DIERR) D BMES^XPDUTL("Error setting the POP/Auto Purge default as 'ON': "_MAGERR("DIERR",1,"TEXT",1))
. K MAGFDA,MAGERR
. Q
Q
PID ; Add Photo-ID Post Action to the Image Action file
N MAGFDA,MAGERR,IEN,MSGROOT,ACTIVE,EXPLOC
; If already configured, save and restore active and Export Location parameters
S IEN=$O(^MAG(2005.86,"B","PHOTO-ID COPY",""))
I IEN'="" D
. S ACTIVE=+$P($G(^MAG(2005.86,IEN,0)),U,2)
. S EXPLOC=$P($G(^MAG(2005.86,IEN,0)),U,5)
. S DIK="^MAG(2005.86,",DA=IEN D ^DIK
. K DIK,DA
. Q
E S ACTIVE="0",EXPLOC=""
S MAGFDA(2005.86,"?+1,",.01)="PHOTO-ID COPY"
S MAGFDA(2005.86,"?+1,",1)=ACTIVE
S MAGFDA(2005.86,"?+1,",2)="PID"
S MAGFDA(2005.86,"?+1,",3)="MAGQBGCC"
S MAGFDA(2005.86,"?+1,",4)="This will copy photo ID's to an external share with the Patient's Name as the file name."
S MAGFDA(2005.86,"?+1,",6)=EXPLOC
D UPDATE^DIE("","MAGFDA","","MAGERR")
I $D(DIERR) D BMES^XPDUTL("Error Adding PHOTO-ID Post Process Action: "_MAGERR("DIERR",1,"TEXT",1)) K DIERR,MAGERR
S IEN=$$FIND1^DIC(2005.86,"","","PHOTO-ID COPY","","","MSGROOT")
S MAGFDA(2005.865,"?+1,"_IEN_",",.01)="PHOTO ID"
D UPDATE^DIE("E","MAGFDA","","MAGERR")
I $D(DIERR) D BMES^XPDUTL("Error Adding PHOTO ID Action type: "_MAGERR("DIERR",1,"TEXT",1)) K DIERR,MAGERR
K MAGFDA,MAGERR,MSGROOT
Q
TASKIT(RTN,DESC,MSG) ;
N MAGDATE,MAGTIME,MAGHR,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
Q:$G(RTN)=""!($G(DESC)="")
S ZTRTN=$G(RTN),ZTDESC=$G(DESC),ZTIO=""
S MAGDATE=$$NOW^XLFDT(),MAGTIME=$P(MAGDATE,".",2),MAGHR=$E(MAGTIME,1,2)
I MAGHR>5,MAGHR<17 S MAGTIME=180000
S MAGDATE=$P(MAGDATE,".")_"."_MAGTIME
S ZTDTH=MAGDATE
D ^%ZTLOAD
D BMES^XPDUTL($G(MSG)_" TASK#: "_ZTSK)
Q
INDEX ; Kill and Set All indexes for the BP Server file
K ^MAG(2006.8,"C"),^MAG(2006.8,"D")
S DIK="^MAG(2006.8," D IXALL^DIK
K DIK
K ^MAG(2006.1,"B")
S DIK="^MAG(2006.1," D IXALL^DIK
K DIK
K ^MAG(2005.2,"AC"),^MAG(2005.2,"B"),^MAG(2005.2,"C"),^MAG(2005.2,"D"),^MAG(2005.2,"E"),^MAG(2005.2,"F"),^MAG(2005.2,"G")
S DIK="^MAG(2005.2," D IXALL^DIK
K DIK
Q
RD ;Remove data for retired fields 11.5,11.9,13,14,15,16,17,18,19,21,24,60,61,62,63,64,65 set photo id default
N PL,PIECE
S PL=0
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. K ^MAG(2006.1,PL,"JBX") ;2.01,2.02,2.03
. S $P(^MAG(2006.1,PL,1),U,9)="" ;13
. K ^MAG(2006.1,PL,"JBEX") ; 14,15,16,17,18,19
. S $P(^MAG(2006.1,PL,3),U,1)="" ;21
. S $P(^MAG(2006.1,PL,3),U,7)="" ;11.5 CRITICAL LOW MESSAGE INTERVAL - RETIRED
. S $P(^MAG(2006.1,PL,3),U,11)="" ;11.9 ; DATE OF LAST CRITICAL MESSAGE - RETIRED
. S $P(^MAG(2006.1,PL,3),U,4)="99999" ;24 Changed to Photo ID have 99999 set as the default
. S $P(^MAG(2006.1,PL,5),U,1,6)="^^^^^" ;60,61,62,63,64,65
. Q
Q
;
PURVER ;Find the first BP server that has a JUKEBOX assignment and add Auto Purge & Scheduled Verify
N BPNME,BPIEN,SITE,FDA
S SITE=0 F S SITE=$O(^MAG(2006.8,"D",SITE)) Q:'SITE D
. Q:$D(^MAG(2006.8,"C",SITE,"Unassigned Tasks")) ;patch has been installed don't execute
. S BPNME="" F S BPNME=$O(^MAG(2006.8,"D",SITE,BPNME)) Q:BPNME="" D
. . S BPIEN=$O(^MAG(2006.8,"D",SITE,BPNME,0))
. . I +$P($G(^MAG(2006.8,BPIEN,0)),U,14) D ;BP server has JUKEBOX task assigned
. . . S FDA(2006.8,BPIEN_",",3)="1",FDA(2006.8,BPIEN_",",4)="1" D FILE^DIE("","FDA")
. . . Q
. . Q
. Q
Q
RMBPMSG ;The following will remove P39T23's POST_INSTALL_ACQUISITION_SITE message and mail group.
;^MAG(2006.1,2,6,"B","Post_Install_Acquisition_Site",8)=
N DA,DIK,I,L,K,MSG,MSGTXT,NMSP
S MSG="Post_Install_Acquisition_Site"
S PL=0 F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. S I=0,NMSP=$P($G(^MAG(2006.1,PL,0)),U,2)
. Q:NMSP=""
. S MSGTXT="MAG_"_NMSP_"_"_$E($$TRIM^MAGQBUT4(MSG),1,20)
. S K=$$FIND1^DIC(3.8,"","B",MSGTXT) D:+K
. . S DA=K,DIK="^XMB(3.8," D ^DIK K DA,DIK
. . Q
. I $D(^MAG(2006.1,PL,6,"B",MSG)) D
. . S L=$O(^MAG(2006.1,PL,6,"B",MSG,0)) D:+L
. . S DA(1)=PL,DA=L,DIK="^MAG(2006.1,"_DA(1)_",6," D ^DIK K DA,DIK
. . Q
. Q
Q
TEXT ; Message Subjects
;;Imaging_Integrity_Check
;;GCC_Copy_Error
;;Application_process_failure
;;Image_Cache_Critically_Low
;;Monthly_Image_Site_Usage
;;Ad_Hoc_Image_Site_Usage
;;INSTALLATION
;;Image_File_Size_Variance
;;Verifier_Scan_Error_log
;;Imaging_Site_Verification_Issue
;;VI_BP_Queue_Processor_failure
;;Photo_I_D_Action
;;Get_Next_RAID_Group_failure
;;Scheduled_Purge_failure
;;Scheduled_Verifier_failure
;;Site_report_task_was_restarted
;;Auto_RAID_group_purge
;;Scheduled_RAID_Group_Adv
;;VI_BP_Eval_Queue
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIP39B 16223 printed Oct 16, 2024@18:06:49 Page 2
MAGIP39B ;Post init routine to queue site activity at install. ; 14 Oct 2010 4:41 PM
+1 ;;3.0;IMAGING;**39**;Mar 19, 2002;Build 2010;Mar 08, 2011
+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 QUIT
POST ;
+1 NEW I,NLIST,PLACE,FLDAR,PL
+2 ; Remove "B" cross-reference
KILL ^MAG(2006.8,"B")
+3 SET PLACE=$ORDER(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),""))
+4 DO BMES^XPDUTL("Updating MAG WINDOWS: "_$$FMTE^XLFDT($$NOW^XLFDT))
+5 DO ADDRPC^MAGQBUT4("MAGQB QUEDEL","MAG WINDOWS")
+6 DO ADDRPC^MAGQBUT4("MAGQ JBQUE","MAG WINDOWS")
+7 DO ADDRPC^MAGQBUT4("MAG FIELD VALIDATE","MAG WINDOWS")
+8 DO ADDRPC^MAGQBUT4("MAG KEY VALIDATE","MAG WINDOWS")
+9 DO ADDRPC^MAGQBUT4("MAGQ FTYPE","MAG WINDOWS")
+10 DO ADDRPC^MAGQBUT4("MAGQ DFNIQ","MAG WINDOWS")
+11 DO ADDRPC^MAGQBUT4("MAGQ JBSCN","MAG WINDOWS")
+12 DO ADDRPC^MAGQBUT4("MAGQ FS CHNGE","MAG WINDOWS")
+13 DO ADDRPC^MAGQBUT4("MAGQ QRNGE","MAG WINDOWS")
+14 DO ADDRPC^MAGQBUT4("MAGQ FINDC","MAG WINDOWS")
+15 DO ADDRPC^MAGQBUT4("MAGQ QCNT","MAG WINDOWS")
+16 DO ADDRPC^MAGQBUT4("MAGQ ALL SERVER","MAG WINDOWS")
+17 DO ADDRPC^MAGQBUT4("MAGQ ADD RAID GROUP","MAG WINDOWS")
+18 DO ADDRPC^MAGQBUT4("MAGQ DEL NLOC","MAG WINDOWS")
+19 DO ADDRPC^MAGQBUT4("MAGQBP ALL SHARES","MAG WINDOWS")
+20 DO ADDRPC^MAGQBUT4("MAGQBP FREF","MAG WINDOWS")
+21 DO ADDRPC^MAGQBUT4("MAGQ BP UAT","MAG WINDOWS")
+22 DO BMES^XPDUTL("Add Generic Mail Message groups to the Mail Group file: "_$$FMTE^XLFDT($$NOW^XLFDT))
+23 ; Add Generic Mail Message groups to the Mail Group file (XMB(3.8)
DO ADDMG
+24 DO BMES^XPDUTL("Add Message Subjects for Mail Management to Site Parameters - with interval: "_$$FMTE^XLFDT($$NOW^XLFDT))
+25 ; Add Message Subjects for Mail Management to Site Parameters - with interval
DO ADDMS(6)
+26 DO BMES^XPDUTL("Add Generic Mail groups to BP Message subfile: "_$$FMTE^XLFDT($$NOW^XLFDT))
+27 ; Add Generic Mail groups to BP Message subfile
DO DLKP
+28 DO BMES^XPDUTL("Add Raid Groups to the Network Location file: "_$$FMTE^XLFDT($$NOW^XLFDT))
+29 ; Add Raid Groups to the Network Location file
DO ADDRG(4)
+30 ; Setup File/Node/Piece Table for FieldNumbers
DO FAR^MAGQBUT6(.FLDAR)
+31 ; Get a list of duplicate shares
DO GETRL^MAGQBU6A(.NLIST)
+32 DO BMES^XPDUTL("Initialize raid groups to group default: "_$$FMTE^XLFDT($$NOW^XLFDT))
+33 ; Initialize raid groups to group default
DO IRG
+34 ;Set prime entries online
DO PRIME^MAGQBUT6(.NLIST)
DO BMES^XPDUTL("Setting Prime entries on line.")
+35 ;Update the Site Parameter file
DO SPRR^MAGQBUT6(.NLIST)
DO BMES^XPDUTL("Updating Imaging Site Parameter file with prime entries.")
+36 DO BMES^XPDUTL("Add Photo-ID Post Action to the Image Action file: "_$$FMTE^XLFDT($$NOW^XLFDT))
+37 ; Add Photo-ID Post Action to the Image Action file
DO PID
+38 DO BMES^XPDUTL("Set POP/AUTO Purge 'ON' as the default & Purge Factor as '2' & Purge by 'Last Access Date': "_$$FMTE^XLFDT($$NOW^XLFDT))
+39 ; Set Express/AUTO Purge 'ON' as the default & Purge Factor as '2' & Purge by 'Last Access Date'
DO DPOP
+40 DO BMES^XPDUTL("Setup Auto-Verify: "_$$FMTE^XLFDT($$NOW^XLFDT))
+41 ; Setup Auto-Verify
DO AVSET
+42 DO BMES^XPDUTL("Re-index Site Parameters, BP Servers, Network Location file: "_$$FMTE^XLFDT($$NOW^XLFDT))
+43 DO INDEX
+44 DO RMBPMSG
+45 DO BMES^XPDUTL("Setup dummy UAT (Unassigned Tasks) BP Servers: "_$$FMTE^XLFDT($$NOW^XLFDT))
+46 ; Add Auto Purge and Scheduled Verify to the BP server that has JUKEBOX assigned.
DO PURVER
+47 ; Setup dummy UAT (Unassigned Tasks) BP Servers
DO SUAT
+48 ;send an email on routers.
DO RTRS^MAGQBUT6
+49 DO TASKIT("ACXREF^MAGQE7(0,0)","Setting AC X-reference in file 2006.95","Setting AC X-reference in file #2006.95.")
+50 DO TASKIT("CONSHR^MAGQBUT6","Consolidate redundant shares utility","Consolidate redundant shares.")
+51 DO TASKIT("CAS^MAGQBUT5","Purging queues in file 2006.041","Purging completed import queues in file #2006.041.")
+52 ; Remove data from retired fields 2006.1:2.02,2.03,13,14,15,16,17,18,19,21,24 set photo id default
DO RD
+53 ;Restore a value - CR 685
SET PL=0
FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
if $PIECE($GET(^MAG(2006.1,PL,1)),U,5)=""
SET $PIECE(^MAG(2006.1,PL,1),U,5)="30"
+54 DO BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
+55 DO INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
+56 QUIT
SUAT ; Setup dummy UAT (Unassigned Tasks) BP Servers
+1 NEW PL
+2 SET PL=0
+3 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+4 ; Do not re-configure
if $DATA(^MAG(2006.8,"C",PL,"Unassigned Tasks"))
QUIT
+5 DO UAT^MAGQBUT5("",PL)
End DoDot:1
+6 QUIT
ADDRG(CNT) ; Add Raid Groups to the Network Location file
+1 NEW PL,I,J,VALUE,NMSP,DUP,TMP,MAGFDA,RESULT
+2 SET PL=0
+3 KILL ^MAG(2005.2,"AC"),^MAG(2005.2,"B"),^MAG(2005.2,"C"),^MAG(2005.2,"D"),^MAG(2005.2,"G")
+4 SET DIK="^MAG(2005.2,"
+5 DO IXALL^DIK
KILL DIK
+6 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+7 ; Do not reconfigure
if $DATA(^MAG(2005.2,"F",PL,"GRP"))
QUIT
+8 SET NMSP=$PIECE($GET(^MAG(2006.1,PL,0)),U,2)
+9 IF NMSP=""
Begin DoDot:2
+10 SET TMP=$$GET1^DIQ("4",$PIECE($GET(^MAG(2006.1,PL,0)),U,1),".01","","","")
+11 DO BMES^XPDUTL("No namespace is defined for: "_TMP_" in the Site Parameter file (#2006.1)")
+12 QUIT
End DoDot:2
QUIT
+13 DO ADDRG^MAGQBUT5(.RESULT,CNT,PL)
+14 QUIT
End DoDot:1
+15 QUIT
AVSET ; Setup Auto-Verify - To run at midnight, nightly (no more than 48 hours, limited to the run)
+1 NEW PL,DIERR,MAGERR,MAGFDA
+2 SET PL=0
+3 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+4 ; Do not re-configure
if $PIECE($GET(^MAG(2006.1,PL,"BPVERIFIER")),U,1)'=""
QUIT
+5 ; SCHEDULED VERIFY
SET MAGFDA(2006.1,PL_",",62)="1"
+6 ; SCHEDULED VERIFIER FREQUENCY
SET MAGFDA(2006.1,PL_",",62.2)="1"
+7 ; SCHEDULED VERIFIER TIME
SET MAGFDA(2006.1,PL_",",62.4)="2355"
+8 ; DATE OF NEXT VERIFY
SET MAGFDA(2006.1,PL_",",62.3)=$$DT^XLFDT
+9 DO UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
+10 IF $DATA(DIERR)
Begin DoDot:2
+11 NEW TMP
SET TMP=$PIECE(^DIC(4,$ORDER(^DIC(4,"D",$PIECE($GET(^MAG(2006.1,PL,0)),U,1),"")),0),U,1)
+12 DO BMES^XPDUTL("Error adding default Auto-Verify options to "_TMP_" Error text: "_MAGERR("DIERR",1,"TEXT",1))
+13 QUIT
End DoDot:2
+14 KILL MAG,DIERR,MAGFDA,MAGERR
+15 QUIT
End DoDot:1
+16 QUIT
IRG ; Initialize raid groups to group default
+1 NEW DA,EN,PC,PL,INDX,ZNODE,GD,MAGIEN,MAGERR,SUBIX
+2 ;The following sets all duplicate share as READ ONLY in preparation of adding enties to the Group.
+3 SET EN=""
SET EN=$ORDER(NLIST(EN))
if EN'=""
Begin DoDot:1
+4 SET EN=""
FOR
SET EN=$ORDER(NLIST(EN))
if EN=""
QUIT
Begin DoDot:2
+5 FOR PC=2:1:$LENGTH(NLIST(EN),U)
SET DA=$PIECE(NLIST(EN),U,PC)
if 'DA
QUIT
if $DATA(^MAG(2005.2,DA,0))
Begin DoDot:3
+6 ;Mag type and not router
IF $PIECE(^MAG(2005.2,DA,0),U,7)="MAG"
IF '+$PIECE(^(0),U,9)!($PIECE(^MAG(2005.2,DA,0),U,7)["WORM")
Begin DoDot:4
+7 ;Set as READ ONLY
SET MAGFDA(2005.2,DA_",",5.5)=1
+8 DO FILE^DIE("","MAGFDA","MAGMSG")
+9 IF $DATA(MSG("DIERR"))
DO BMES^XPDUTL("Duplicate entry: '"_DA_" failed to be set offline. ")
+10 KILL MAGFDA,MAGMSG
+11 QUIT
End DoDot:4
+12 QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 SET PL=0
+16 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+17 ; Do not Re-configure
if $PIECE($GET(^MAG(2006.1,PL,0)),U,10)'=""
QUIT
+18 ; first Raid Group
SET GD=$ORDER(^MAG(2005.2,"F",PL,"GRP",""))
+19 if 'GD
QUIT
+20 ; by default set the sites Current Group to the 1st
SET $PIECE(^MAG(2006.1,PL,0),U,10)=GD
+21 SET (INDX,SUBIX)=0
+22 FOR
SET INDX=$ORDER(^MAG(2005.2,INDX))
if 'INDX
QUIT
Begin DoDot:2
+23 SET ZNODE=$GET(^MAG(2005.2,INDX,0))
+24 if $PIECE(ZNODE,U,10)'=PL
QUIT
+25 if $PIECE(ZNODE,U,6,7)'["1^MAG"
QUIT
+26 ;ROUTING SHARE
if $PIECE(ZNODE,U,9)="1"
QUIT
+27 ;not hashed
if $PIECE(ZNODE,U,8)'="Y"
QUIT
+28 ;Read Only
if $PIECE($GET(^MAG(2005.2,INDX,1)),U,6)="1"
QUIT
+29 ;Already assigned
if +$PIECE($GET(^MAG(2005.2,INDX,1)),U,8)>0
QUIT
+30 SET $PIECE(^MAG(2005.2,INDX,1),U,8)=GD
+31 SET SUBIX=SUBIX+1
+32 SET MAGFDA(2005.22,"+"_SUBIX_","_GD_",",.01)=INDX
+33 DO UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
+34 IF $DATA(DIERR)
DO BMES^XPDUTL("Error adding Raid Group subentry: "_MAGERR("DIERR",1,"TEXT",1))
+35 KILL MAGFDA,DIERR,MSGIEN,MAGERR
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 QUIT
ADDMS(INTERVAL) ; Add Message Subjects for Mail Management
+1 NEW I,J,K,MAGFDA,MSG,IEN,MAGERR
+2 SET IEN=0
+3 FOR
SET IEN=$ORDER(^MAG(2006.1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 FOR J=1:1:19
SET K=$PIECE($TEXT(TEXT+J),";",3)
Begin DoDot:2
+5 ; Do not re-configure
if $DATA(^MAG(2006.1,IEN,6,"B",K))
QUIT
+6 SET MAGFDA(2006.166,"?+1,"_IEN_",",.01)=K
+7 SET MAGFDA(2006.166,"?+1,"_IEN_",",1)=INTERVAL
+8 DO UPDATE^DIE("","MAGFDA","","MAGERR")
+9 IF $DATA(DIERR)
DO BMES^XPDUTL("Error updating the BP Mail Message Subfile: "_MAGERR("DIERR",1,"TEXT",1))
KILL DIERR,MAGERR
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
ADDMG ; Add Mail Message groups to the Mail Group file (XMB(3.8))
+1 NEW PL,NMSP
+2 SET PL=0
+3 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+4 SET NMSP=$PIECE($GET(^MAG(2006.1,PL,0)),U,2)
+5 if NMSP=""
QUIT
+6 DO ADD(NMSP)
+7 QUIT
End DoDot:1
+8 QUIT
ADD(NMSP) ;
+1 NEW J,K,L,MAGFDA,MSG,IEN,MAGIEN,MAGERR
+2 FOR J=1:1:19
SET K=$PIECE($TEXT(TEXT+J),";",3)
Begin DoDot:1
+3 IF '$DATA(^XMB(3.8,"B","MAG_"_NMSP_"_"_$EXTRACT($$TRIM^MAGQBUT4(K),1,20)))
Begin DoDot:2
+4 SET L=$ORDER(^XMB(3.8,"B","MAG_"_NMSP_"_"_$EXTRACT($$TRIM^MAGQBUT4(K),1,20),""))
+5 SET MAGFDA(3.8,"?+"_J_",",.01)="MAG_"_NMSP_"_"_$EXTRACT($$TRIM^MAGQBUT4(K),1,20)
+6 DO UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
+7 IF $DATA(DIERR)
DO BMES^XPDUTL("Error Adding Imaging Mail Groups: "_MAGERR("DIERR",1,"TEXT",1))
KILL DIERR,MAGERR,MAGFDA
QUIT
+8 KILL MAGFDA,DIERR,MAGERR
+9 SET MAGFDA(3.8,MAGIEN(J)_",",4)="PU"
+10 DO FILE^DIE("I","MAGFDA","MAGERR")
+11 KILL MAGFDA,DIERR,MAGERR
+12 SET MAGFDA(3.81,"?+1,"_MAGIEN(J)_",",.01)=DUZ
+13 DO UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
+14 IF $DATA(DIERR)
DO BMES^XPDUTL("Error Adding Imaging Mail Group member: "_MAGERR("DIERR",1,"TEXT",1))
+15 KILL DIERR,MAGERR,MAGFDA,MAGIEN
End DoDot:2
+16 IF '$TEST
Begin DoDot:2
+17 SET L=$ORDER(^XMB(3.8,"B","MAG_"_NMSP_"_"_$EXTRACT($$TRIM^MAGQBUT4(K),1,20),""))
+18 SET MAGFDA(3.81,"?+1,"_L_",",.01)=DUZ
+19 DO UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
+20 IF $DATA(DIERR)
DO BMES^XPDUTL("Error Adding Imaging Mail Group member: "_MAGERR("DIERR",1,"TEXT",1))
+21 KILL DIERR,MAGERR,MAGFDA,MAGIEN
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
DLKP ; Add Generic Mail groups to BP Message subfile
+1 NEW PL,I,J,MAGFDA,MSGROOT,MG,DIERR,MAGIEN,MAGERR,NMSP
+2 SET PL=0
+3 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+4 SET I=0
SET NMSP=$PIECE($GET(^MAG(2006.1,PL,0)),U,2)
+5 if NMSP=""
QUIT
+6 FOR
SET I=$ORDER(^MAG(2006.1,PL,6,I))
if 'I
QUIT
Begin DoDot:2
+7 SET MG=$PIECE($GET(^MAG(2006.1,PL,6,I,0)),"^",1)
+8 SET J=$$FIND1^DIC(3.8,"","","MAG_"_NMSP_"_"_$EXTRACT($$TRIM^MAGQBUT4(MG),1,20),"","","MSGROOT")
+9 ; Do not re-configure
if $DATA(^MAG(2006.1,PL,6,I,1,"B",J))
QUIT
+10 IF J
Begin DoDot:3
+11 SET MAGFDA(2006.1662,"+1,"_I_","_PL_",",.01)=J
+12 DO UPDATE^DIE("","MAGFDA","MAGIEN","MAGERR")
+13 IF $DATA(DIERR)
DO BMES^XPDUTL("Error Adding Generic Mail Groups: "_MAGERR("DIERR",1,"TEXT",1))
KILL DIERR,MAGERR
+14 QUIT
End DoDot:3
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 KILL MAGFDA,MSGROOT,MAGIEN,MSGROOT
+18 QUIT
DPOP ; Set the POP Purge value to a default of 'ON' & Purge Factor as '2'
+1 NEW PL,MAGFDA,DIERR,MAGIEN,MAGERR
+2 SET PL=0
+3 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+4 ; Do not re-configure
if $PIECE($GET(^MAG(2006.1,PL,"BPPURGE")),U,4)'=""
QUIT
+5 ;Express Purge ON
SET MAGFDA(2006.1,PL_",",60.2)="1"
+6 ;Auto Purge ON
SET MAGFDA(2006.1,PL_",",60)="1"
+7 ;Purge by: Date Accessed
SET MAGFDA(2006.1,PL_",",60.1)="DA"
+8 ; Express Purge Rate 100,000
SET MAGFDA(2006.1,PL_",",60.3)="100000"
+9 ; Purge Factor
SET MAGFDA(2006.1,PL_",",60.5)="1"
+10 DO UPDATE^DIE("","MAGFDA","","MAGERR")
+11 IF $DATA(DIERR)
DO BMES^XPDUTL("Error setting the POP/Auto Purge default as 'ON': "_MAGERR("DIERR",1,"TEXT",1))
+12 KILL MAGFDA,MAGERR
+13 QUIT
End DoDot:1
+14 QUIT
PID ; Add Photo-ID Post Action to the Image Action file
+1 NEW MAGFDA,MAGERR,IEN,MSGROOT,ACTIVE,EXPLOC
+2 ; If already configured, save and restore active and Export Location parameters
+3 SET IEN=$ORDER(^MAG(2005.86,"B","PHOTO-ID COPY",""))
+4 IF IEN'=""
Begin DoDot:1
+5 SET ACTIVE=+$PIECE($GET(^MAG(2005.86,IEN,0)),U,2)
+6 SET EXPLOC=$PIECE($GET(^MAG(2005.86,IEN,0)),U,5)
+7 SET DIK="^MAG(2005.86,"
SET DA=IEN
DO ^DIK
+8 KILL DIK,DA
+9 QUIT
End DoDot:1
+10 IF '$TEST
SET ACTIVE="0"
SET EXPLOC=""
+11 SET MAGFDA(2005.86,"?+1,",.01)="PHOTO-ID COPY"
+12 SET MAGFDA(2005.86,"?+1,",1)=ACTIVE
+13 SET MAGFDA(2005.86,"?+1,",2)="PID"
+14 SET MAGFDA(2005.86,"?+1,",3)="MAGQBGCC"
+15 SET MAGFDA(2005.86,"?+1,",4)="This will copy photo ID's to an external share with the Patient's Name as the file name."
+16 SET MAGFDA(2005.86,"?+1,",6)=EXPLOC
+17 DO UPDATE^DIE("","MAGFDA","","MAGERR")
+18 IF $DATA(DIERR)
DO BMES^XPDUTL("Error Adding PHOTO-ID Post Process Action: "_MAGERR("DIERR",1,"TEXT",1))
KILL DIERR,MAGERR
+19 SET IEN=$$FIND1^DIC(2005.86,"","","PHOTO-ID COPY","","","MSGROOT")
+20 SET MAGFDA(2005.865,"?+1,"_IEN_",",.01)="PHOTO ID"
+21 DO UPDATE^DIE("E","MAGFDA","","MAGERR")
+22 IF $DATA(DIERR)
DO BMES^XPDUTL("Error Adding PHOTO ID Action type: "_MAGERR("DIERR",1,"TEXT",1))
KILL DIERR,MAGERR
+23 KILL MAGFDA,MAGERR,MSGROOT
+24 QUIT
TASKIT(RTN,DESC,MSG) ;
+1 NEW MAGDATE,MAGTIME,MAGHR,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+2 if $GET(RTN)=""!($GET(DESC)="")
QUIT
+3 SET ZTRTN=$GET(RTN)
SET ZTDESC=$GET(DESC)
SET ZTIO=""
+4 SET MAGDATE=$$NOW^XLFDT()
SET MAGTIME=$PIECE(MAGDATE,".",2)
SET MAGHR=$EXTRACT(MAGTIME,1,2)
+5 IF MAGHR>5
IF MAGHR<17
SET MAGTIME=180000
+6 SET MAGDATE=$PIECE(MAGDATE,".")_"."_MAGTIME
+7 SET ZTDTH=MAGDATE
+8 DO ^%ZTLOAD
+9 DO BMES^XPDUTL($GET(MSG)_" TASK#: "_ZTSK)
+10 QUIT
INDEX ; Kill and Set All indexes for the BP Server file
+1 KILL ^MAG(2006.8,"C"),^MAG(2006.8,"D")
+2 SET DIK="^MAG(2006.8,"
DO IXALL^DIK
+3 KILL DIK
+4 KILL ^MAG(2006.1,"B")
+5 SET DIK="^MAG(2006.1,"
DO IXALL^DIK
+6 KILL DIK
+7 KILL ^MAG(2005.2,"AC"),^MAG(2005.2,"B"),^MAG(2005.2,"C"),^MAG(2005.2,"D"),^MAG(2005.2,"E"),^MAG(2005.2,"F"),^MAG(2005.2,"G")
+8 SET DIK="^MAG(2005.2,"
DO IXALL^DIK
+9 KILL DIK
+10 QUIT
RD ;Remove data for retired fields 11.5,11.9,13,14,15,16,17,18,19,21,24,60,61,62,63,64,65 set photo id default
+1 NEW PL,PIECE
+2 SET PL=0
+3 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+4 ;2.01,2.02,2.03
KILL ^MAG(2006.1,PL,"JBX")
+5 ;13
SET $PIECE(^MAG(2006.1,PL,1),U,9)=""
+6 ; 14,15,16,17,18,19
KILL ^MAG(2006.1,PL,"JBEX")
+7 ;21
SET $PIECE(^MAG(2006.1,PL,3),U,1)=""
+8 ;11.5 CRITICAL LOW MESSAGE INTERVAL - RETIRED
SET $PIECE(^MAG(2006.1,PL,3),U,7)=""
+9 ;11.9 ; DATE OF LAST CRITICAL MESSAGE - RETIRED
SET $PIECE(^MAG(2006.1,PL,3),U,11)=""
+10 ;24 Changed to Photo ID have 99999 set as the default
SET $PIECE(^MAG(2006.1,PL,3),U,4)="99999"
+11 ;60,61,62,63,64,65
SET $PIECE(^MAG(2006.1,PL,5),U,1,6)="^^^^^"
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
PURVER ;Find the first BP server that has a JUKEBOX assignment and add Auto Purge & Scheduled Verify
+1 NEW BPNME,BPIEN,SITE,FDA
+2 SET SITE=0
FOR
SET SITE=$ORDER(^MAG(2006.8,"D",SITE))
if 'SITE
QUIT
Begin DoDot:1
+3 ;patch has been installed don't execute
if $DATA(^MAG(2006.8,"C",SITE,"Unassigned Tasks"))
QUIT
+4 SET BPNME=""
FOR
SET BPNME=$ORDER(^MAG(2006.8,"D",SITE,BPNME))
if BPNME=""
QUIT
Begin DoDot:2
+5 SET BPIEN=$ORDER(^MAG(2006.8,"D",SITE,BPNME,0))
+6 ;BP server has JUKEBOX task assigned
IF +$PIECE($GET(^MAG(2006.8,BPIEN,0)),U,14)
Begin DoDot:3
+7 SET FDA(2006.8,BPIEN_",",3)="1"
SET FDA(2006.8,BPIEN_",",4)="1"
DO FILE^DIE("","FDA")
+8 QUIT
End DoDot:3
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
RMBPMSG ;The following will remove P39T23's POST_INSTALL_ACQUISITION_SITE message and mail group.
+1 ;^MAG(2006.1,2,6,"B","Post_Install_Acquisition_Site",8)=
+2 NEW DA,DIK,I,L,K,MSG,MSGTXT,NMSP
+3 SET MSG="Post_Install_Acquisition_Site"
+4 SET PL=0
FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+5 SET I=0
SET NMSP=$PIECE($GET(^MAG(2006.1,PL,0)),U,2)
+6 if NMSP=""
QUIT
+7 SET MSGTXT="MAG_"_NMSP_"_"_$EXTRACT($$TRIM^MAGQBUT4(MSG),1,20)
+8 SET K=$$FIND1^DIC(3.8,"","B",MSGTXT)
if +K
Begin DoDot:2
+9 SET DA=K
SET DIK="^XMB(3.8,"
DO ^DIK
KILL DA,DIK
+10 QUIT
End DoDot:2
+11 IF $DATA(^MAG(2006.1,PL,6,"B",MSG))
Begin DoDot:2
+12 SET L=$ORDER(^MAG(2006.1,PL,6,"B",MSG,0))
if +L
Begin DoDot:3
End DoDot:3
+13 SET DA(1)=PL
SET DA=L
SET DIK="^MAG(2006.1,"_DA(1)_",6,"
DO ^DIK
KILL DA,DIK
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
TEXT ; Message Subjects
+1 ;;Imaging_Integrity_Check
+2 ;;GCC_Copy_Error
+3 ;;Application_process_failure
+4 ;;Image_Cache_Critically_Low
+5 ;;Monthly_Image_Site_Usage
+6 ;;Ad_Hoc_Image_Site_Usage
+7 ;;INSTALLATION
+8 ;;Image_File_Size_Variance
+9 ;;Verifier_Scan_Error_log
+10 ;;Imaging_Site_Verification_Issue
+11 ;;VI_BP_Queue_Processor_failure
+12 ;;Photo_I_D_Action
+13 ;;Get_Next_RAID_Group_failure
+14 ;;Scheduled_Purge_failure
+15 ;;Scheduled_Verifier_failure
+16 ;;Site_report_task_was_restarted
+17 ;;Auto_RAID_group_purge
+18 ;;Scheduled_RAID_Group_Adv
+19 ;;VI_BP_Eval_Queue
+20 ;
