MAGIP39 ;PRE init routine to queue site activity at install. ; 14 Oct 2010 4:39 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
PRE ;
 ; If not first P39 install then must convert the Jukebox default from 54 to 2.01
 I $$FLDNUM^DILFD(2006.1,"JUKEBOX DEFAULT") D
 . N JBREF,NLREF,PL
 . S PL=0
 . F  S PL=$O(^MAG(2006.1,PL)) Q:'PL  D
 . . S JBREF=$P($G(^MAG(2006.1,PL,1)),U,6) Q:'JBREF
 . . S NLREF=$P($G(^MAGQUEUE(2006.032,JBREF,0)),U,3)
 . . S $P(^MAG(2006.1,PL,1),U,6)=NLREF
 . . Q
 . Q
 ; Move Pre-Patch 39 data to new location and clear retired fields 11.5,11.9
 N PL,LEGACY
 S PL=0
 F  S PL=$O(^MAG(2006.1,PL)) Q:'PL  D
 . S $P(^MAG(2006.1,PL,3),U,7)="" ; CRITICAL LOW MESSAGE INTERVAL - RETIRED
 . S $P(^MAG(2006.1,PL,3),U,11)="" ; DATE OF LAST CRITICAL MESSAGE - RETIRED
 . Q:$D(^MAG(2006.1,PL,"BPPURGE"))  ; Only for initial conversion
 . S $P(^MAG(2006.1,PL,"BPPURGE"),U,1)=$P($G(^MAG(2006.1,PL,5)),U,1) ; New #60 AutoPurge
 . S $P(^MAG(2006.1,PL,"BPPURGE"),U,6)=$P($G(^MAG(2006.1,PL,5)),U,3) ; New #61 Scheduled Purge
 . S $P(^MAG(2006.1,PL,"BPPURGE"),U,7)=$P($G(^MAG(2006.1,PL,5)),U,6) ; New #61.1 Date of Last Scheduled Purge
 . S $P(^MAG(2006.1,PL,"BPPURGE"),U,9)=$P($G(^MAG(2006.1,PL,5)),U,4) ; New #61.2 Scheduled Purge Frequency
 . S $P(^MAG(2006.1,PL,"BPPURGE"),U,11)=$P($G(^MAG(2006.1,PL,5)),U,5) ; New #61.4 Scheduled Purge Time
 . Q
 ; Change the BP Workstation file ( 2006.8) name to BP SERVERS
 D:$$UPPER^MAGQE4($P($G(^DIC(2006.8,0)),U,1))["BP WORKSTATIONS" CFILEN("2006.8","BP SERVERS")
 ; Remove data dictionary definition so that the new definition installs cleanly
 ; Except we are removing fields 9 PACS Purge, 13 Radiology Holds, 14 JBX ALL, 15 JBX ALL PACS, 16 JBX ALL BIG,
 ; 17 JBX BIG NON-PACS,18 NO JB DELETE ENTRY, 19 JBX PACS BIG VER TGA, 21 PURGE-RETEN DAYS PACS BIG,
 ; 22 PURGE-RETENTION DAYS BIG, 24 PURGE-RETENTION DAYS PACS
 ; 
 N DIK,DA,DIU
 S DIK="^DD(2005.2,",DA=.01,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=.04,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=1,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=2,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=4,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=5.5,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=6,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=8,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=9,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=10,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=11,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=12,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=14,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=15,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=16,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=17,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=18,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=19,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=20,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=21,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=22,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=23,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=24,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=25,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=26,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=27,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=28,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=29,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=30,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.2,",DA=31,DA(1)=2005.2 D ^DIK
 S DIK="^DD(2005.86,",DA=6,DA(1)=2005.86 D ^DIK
 S DIK="^DD(2006.031,",DA=4,DA(1)=2006.031 D ^DIK
 S DIK="^DD(2006.1,",DA=.02,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=.03,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=.031,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=.04,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=.07,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=.08,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=1.02,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=1.03,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=2.01,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=2.02,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=2.03,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=6,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=8,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=9,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=10,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=11,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=11.2,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=11.5,DA(1)=2006.1 D ^DIK ; CRITICAL LOW MESSAGE INTERVAL - RETIRED 
 S DIK="^DD(2006.1,",DA=11.9,DA(1)=2006.1 D ^DIK ; DATE OF LAST CRITICAL MESSAGE - RETIRED
 S DIK="^DD(2006.1,",DA=13,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=14,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=15,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=16,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=17,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=18,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=19,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=21,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=22,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=23,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=24,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=54,DA(1)=2006.1 D ^DIK ; JUKEBOX DEFAULT - RETIRED CHANGED TO 2.01 see above
 S DIK="^DD(2006.1,",DA=60.1,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=60.2,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=60.3,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=60.4,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=60.5,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=60.6,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=61,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=61.1,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=61.2,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=61.3,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=61.4,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=62,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=62.1,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=62.2,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=66.3,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=62.4,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=62.5,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=62.6,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=63,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=63.1,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=63.2,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=63.3,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=63.4,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=63.5,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=64,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=64.5,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=65.5,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=65,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=66,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=67,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=67.1,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=67.2,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=67.3,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=67.4,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=103,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=124,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.1,",DA=125,DA(1)=2006.1 D ^DIK
 S DIK="^DD(2006.11,",DA=.01,DA(1)=2006.11 D ^DIK
 S DIK="^DD(2006.112,",DA=.01,DA(1)=2006.112 D ^DIK
 S DIK="^DD(2006.8,",DA=.01,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=.04,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=3,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=4,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=11,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=12,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=13,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=14,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=15,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=16,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=17,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=20,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=49,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=50,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=51,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=52,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=53,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=54,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.8,",DA=55,DA(1)=2006.8 D ^DIK
 S DIK="^DD(2006.95,",DA=10,DA(1)=2006.95 D ^DIK
 S DIK="^DD(2006.95,",DA=1,DA(1)=2006.95 D ^DIK
 ; Remove the Jukebox file data dictionary and data
 S DIU="^MAGQUEUE(2006.032,",DIU(0)="D" D EN^DIU2
 ;remove file definitions so that the new file definitions will lay down cleanly
 N DIU
 F DIU=2006.1665,2006.1664,2006.1662,2006.166 D
 . S DIU(0)="S" D EN^DIU2
 . Q
 ; Retire option no longer active
 D RMOPT("MAGQ COQ")
 ; Remove options so new ones install cleanly
 D RMOPT("MAGQ BPMONITOR")
 ; Remove RPC so that it installs cleanly
 D RMRPC("MAGQB QUEDEL")
 D RMRPC("MAGQ JBQUE")
 D RMRPC("MAG FIELD VALIDATE")
 D RMRPC("MAG KEY VALIDATE")
 D RMRPC("MAGQ FTYPE")
 D RMRPC("MAGQ DFNIQ")
 D RMRPC("MAGQ ADD RAID GROUP")
 D RMRPC("MAGQ JBSCN")
 D RMRPC("MAGQBP FREF")
 D RMRPC("MAGQ FS CHNGE")
 D RMRPC("MAGQ QRNGE")
 D RMRPC("MAGQ FINDC")
 D RMRPC("MAGQ QCNT")
 D RMRPC("MAGQ ALL SERVER")
 D RMRPC("MAGQ JBPTR")
 D RMRPC("MAGQB PURNUL")
 D RMRPC("MAGQBP ALL SHARES")
 D RMRPC("MAGQBP CHKN")
 D RMRPC("MAGQ JBP")
 D RMRPC("MAGQ IRP GETNEXT")
 D RMRPC("MAGQ REA")
 D RMRPC("MAGQ REA UPDATE")
 D RMRPC("MAGQ SLAD")
 D RMRPC("MAGQ DEL NLOC")
 D RMRPC("MAGQ BP UAT")
 Q
CFILEN(NUM,NAME) ;
 N DIE,DR,DA
 S DIE="^DIC(",DR=".01///"_NAME,DA=NUM
 D ^DIE
 K DIE,DR,DA
 Q
RMRPC(NAME) ; Removing an RPC in order to revise
 N MW,RPC,MWE,DIERR,DA,DIK
 S MW=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","")
 D CLEAN^DILF
 S RPC=$$FIND1^DIC(8994,"","X",NAME,"","","")
 D CLEAN^DILF
 Q:'RPC
 I MW D
 . S MWE=$$FIND1^DIC(19.05,","_MW_",","X",NAME,"","","")
 . D CLEAN^DILF
 . Q:'MWE
 . S DA=MWE,DA(1)=MW,DIK="^DIC(19,"_DA(1)_",""RPC"","
 . D ^DIK
 . K DA,DIK
 . Q
 S DA=RPC,DIK="^XWB(8994,"
 D ^DIK
 K DA,DIK
 Q
RMOPT(NAME) ; Removing an OPTION from the OPTION File (#19)
 N OPT
 S OPT=$$FIND1^DIC(19,"","X",NAME,"","","")
 D CLEAN^DILF
 Q:'OPT
 I NAME="MAGQ BPMONITOR" D MAGSYS(NAME)
 S DA=OPT,DIK="^DIC(19,"
 D ^DIK
 K DA,DIK
 Q
MAGSYS(NAME) ;
 N MENU,ITEM,DA,DIK
 Q:NAME=""
 S MENU=+$$FIND1^DIC(19,"","X","MAG SYS MENU") Q:'+MENU
 S ITEM=$$FIND1^DIC(19.01,","_MENU_",","B",NAME) Q:'+ITEM
 S DA=ITEM,DA(1)=MENU,DIK="^DIC(19,"_DA(1)_",10," D ^DIK K DA,DIK
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIP39   11187     printed  Sep 23, 2025@19:42:24                                                                                                                                                                                                    Page 2
MAGIP39   ;PRE init routine to queue site activity at install. ; 14 Oct 2010 4:39 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 
PRE       ;
 +1       ; If not first P39 install then must convert the Jukebox default from 54 to 2.01
 +2        IF $$FLDNUM^DILFD(2006.1,"JUKEBOX DEFAULT")
               Begin DoDot:1
 +3                NEW JBREF,NLREF,PL
 +4                SET PL=0
 +5                FOR 
                       SET PL=$ORDER(^MAG(2006.1,PL))
                       if 'PL
                           QUIT 
                       Begin DoDot:2
 +6                        SET JBREF=$PIECE($GET(^MAG(2006.1,PL,1)),U,6)
                           if 'JBREF
                               QUIT 
 +7                        SET NLREF=$PIECE($GET(^MAGQUEUE(2006.032,JBREF,0)),U,3)
 +8                        SET $PIECE(^MAG(2006.1,PL,1),U,6)=NLREF
 +9                        QUIT 
                       End DoDot:2
 +10               QUIT 
               End DoDot:1
 +11      ; Move Pre-Patch 39 data to new location and clear retired fields 11.5,11.9
 +12       NEW PL,LEGACY
 +13       SET PL=0
 +14       FOR 
               SET PL=$ORDER(^MAG(2006.1,PL))
               if 'PL
                   QUIT 
               Begin DoDot:1
 +15      ; CRITICAL LOW MESSAGE INTERVAL - RETIRED
                   SET $PIECE(^MAG(2006.1,PL,3),U,7)=""
 +16      ; DATE OF LAST CRITICAL MESSAGE - RETIRED
                   SET $PIECE(^MAG(2006.1,PL,3),U,11)=""
 +17      ; Only for initial conversion
                   if $DATA(^MAG(2006.1,PL,"BPPURGE"))
                       QUIT 
 +18      ; New #60 AutoPurge
                   SET $PIECE(^MAG(2006.1,PL,"BPPURGE"),U,1)=$PIECE($GET(^MAG(2006.1,PL,5)),U,1)
 +19      ; New #61 Scheduled Purge
                   SET $PIECE(^MAG(2006.1,PL,"BPPURGE"),U,6)=$PIECE($GET(^MAG(2006.1,PL,5)),U,3)
 +20      ; New #61.1 Date of Last Scheduled Purge
                   SET $PIECE(^MAG(2006.1,PL,"BPPURGE"),U,7)=$PIECE($GET(^MAG(2006.1,PL,5)),U,6)
 +21      ; New #61.2 Scheduled Purge Frequency
                   SET $PIECE(^MAG(2006.1,PL,"BPPURGE"),U,9)=$PIECE($GET(^MAG(2006.1,PL,5)),U,4)
 +22      ; New #61.4 Scheduled Purge Time
                   SET $PIECE(^MAG(2006.1,PL,"BPPURGE"),U,11)=$PIECE($GET(^MAG(2006.1,PL,5)),U,5)
 +23               QUIT 
               End DoDot:1
 +24      ; Change the BP Workstation file ( 2006.8) name to BP SERVERS
 +25       if $$UPPER^MAGQE4($PIECE($GET(^DIC(2006.8,0)),U,1))["BP WORKSTATIONS"
               DO CFILEN("2006.8","BP SERVERS")
 +26      ; Remove data dictionary definition so that the new definition installs cleanly
 +27      ; Except we are removing fields 9 PACS Purge, 13 Radiology Holds, 14 JBX ALL, 15 JBX ALL PACS, 16 JBX ALL BIG,
 +28      ; 17 JBX BIG NON-PACS,18 NO JB DELETE ENTRY, 19 JBX PACS BIG VER TGA, 21 PURGE-RETEN DAYS PACS BIG,
 +29      ; 22 PURGE-RETENTION DAYS BIG, 24 PURGE-RETENTION DAYS PACS
 +30      ; 
 +31       NEW DIK,DA,DIU
 +32       SET DIK="^DD(2005.2,"
           SET DA=.01
           SET DA(1)=2005.2
           DO ^DIK
 +33       SET DIK="^DD(2005.2,"
           SET DA=.04
           SET DA(1)=2005.2
           DO ^DIK
 +34       SET DIK="^DD(2005.2,"
           SET DA=1
           SET DA(1)=2005.2
           DO ^DIK
 +35       SET DIK="^DD(2005.2,"
           SET DA=2
           SET DA(1)=2005.2
           DO ^DIK
 +36       SET DIK="^DD(2005.2,"
           SET DA=4
           SET DA(1)=2005.2
           DO ^DIK
 +37       SET DIK="^DD(2005.2,"
           SET DA=5.5
           SET DA(1)=2005.2
           DO ^DIK
 +38       SET DIK="^DD(2005.2,"
           SET DA=6
           SET DA(1)=2005.2
           DO ^DIK
 +39       SET DIK="^DD(2005.2,"
           SET DA=8
           SET DA(1)=2005.2
           DO ^DIK
 +40       SET DIK="^DD(2005.2,"
           SET DA=9
           SET DA(1)=2005.2
           DO ^DIK
 +41       SET DIK="^DD(2005.2,"
           SET DA=10
           SET DA(1)=2005.2
           DO ^DIK
 +42       SET DIK="^DD(2005.2,"
           SET DA=11
           SET DA(1)=2005.2
           DO ^DIK
 +43       SET DIK="^DD(2005.2,"
           SET DA=12
           SET DA(1)=2005.2
           DO ^DIK
 +44       SET DIK="^DD(2005.2,"
           SET DA=14
           SET DA(1)=2005.2
           DO ^DIK
 +45       SET DIK="^DD(2005.2,"
           SET DA=15
           SET DA(1)=2005.2
           DO ^DIK
 +46       SET DIK="^DD(2005.2,"
           SET DA=16
           SET DA(1)=2005.2
           DO ^DIK
 +47       SET DIK="^DD(2005.2,"
           SET DA=17
           SET DA(1)=2005.2
           DO ^DIK
 +48       SET DIK="^DD(2005.2,"
           SET DA=18
           SET DA(1)=2005.2
           DO ^DIK
 +49       SET DIK="^DD(2005.2,"
           SET DA=19
           SET DA(1)=2005.2
           DO ^DIK
 +50       SET DIK="^DD(2005.2,"
           SET DA=20
           SET DA(1)=2005.2
           DO ^DIK
 +51       SET DIK="^DD(2005.2,"
           SET DA=21
           SET DA(1)=2005.2
           DO ^DIK
 +52       SET DIK="^DD(2005.2,"
           SET DA=22
           SET DA(1)=2005.2
           DO ^DIK
 +53       SET DIK="^DD(2005.2,"
           SET DA=23
           SET DA(1)=2005.2
           DO ^DIK
 +54       SET DIK="^DD(2005.2,"
           SET DA=24
           SET DA(1)=2005.2
           DO ^DIK
 +55       SET DIK="^DD(2005.2,"
           SET DA=25
           SET DA(1)=2005.2
           DO ^DIK
 +56       SET DIK="^DD(2005.2,"
           SET DA=26
           SET DA(1)=2005.2
           DO ^DIK
 +57       SET DIK="^DD(2005.2,"
           SET DA=27
           SET DA(1)=2005.2
           DO ^DIK
 +58       SET DIK="^DD(2005.2,"
           SET DA=28
           SET DA(1)=2005.2
           DO ^DIK
 +59       SET DIK="^DD(2005.2,"
           SET DA=29
           SET DA(1)=2005.2
           DO ^DIK
 +60       SET DIK="^DD(2005.2,"
           SET DA=30
           SET DA(1)=2005.2
           DO ^DIK
 +61       SET DIK="^DD(2005.2,"
           SET DA=31
           SET DA(1)=2005.2
           DO ^DIK
 +62       SET DIK="^DD(2005.86,"
           SET DA=6
           SET DA(1)=2005.86
           DO ^DIK
 +63       SET DIK="^DD(2006.031,"
           SET DA=4
           SET DA(1)=2006.031
           DO ^DIK
 +64       SET DIK="^DD(2006.1,"
           SET DA=.02
           SET DA(1)=2006.1
           DO ^DIK
 +65       SET DIK="^DD(2006.1,"
           SET DA=.03
           SET DA(1)=2006.1
           DO ^DIK
 +66       SET DIK="^DD(2006.1,"
           SET DA=.031
           SET DA(1)=2006.1
           DO ^DIK
 +67       SET DIK="^DD(2006.1,"
           SET DA=.04
           SET DA(1)=2006.1
           DO ^DIK
 +68       SET DIK="^DD(2006.1,"
           SET DA=.07
           SET DA(1)=2006.1
           DO ^DIK
 +69       SET DIK="^DD(2006.1,"
           SET DA=.08
           SET DA(1)=2006.1
           DO ^DIK
 +70       SET DIK="^DD(2006.1,"
           SET DA=1.02
           SET DA(1)=2006.1
           DO ^DIK
 +71       SET DIK="^DD(2006.1,"
           SET DA=1.03
           SET DA(1)=2006.1
           DO ^DIK
 +72       SET DIK="^DD(2006.1,"
           SET DA=2.01
           SET DA(1)=2006.1
           DO ^DIK
 +73       SET DIK="^DD(2006.1,"
           SET DA=2.02
           SET DA(1)=2006.1
           DO ^DIK
 +74       SET DIK="^DD(2006.1,"
           SET DA=2.03
           SET DA(1)=2006.1
           DO ^DIK
 +75       SET DIK="^DD(2006.1,"
           SET DA=6
           SET DA(1)=2006.1
           DO ^DIK
 +76       SET DIK="^DD(2006.1,"
           SET DA=8
           SET DA(1)=2006.1
           DO ^DIK
 +77       SET DIK="^DD(2006.1,"
           SET DA=9
           SET DA(1)=2006.1
           DO ^DIK
 +78       SET DIK="^DD(2006.1,"
           SET DA=10
           SET DA(1)=2006.1
           DO ^DIK
 +79       SET DIK="^DD(2006.1,"
           SET DA=11
           SET DA(1)=2006.1
           DO ^DIK
 +80       SET DIK="^DD(2006.1,"
           SET DA=11.2
           SET DA(1)=2006.1
           DO ^DIK
 +81      ; CRITICAL LOW MESSAGE INTERVAL - RETIRED 
           SET DIK="^DD(2006.1,"
           SET DA=11.5
           SET DA(1)=2006.1
           DO ^DIK
 +82      ; DATE OF LAST CRITICAL MESSAGE - RETIRED
           SET DIK="^DD(2006.1,"
           SET DA=11.9
           SET DA(1)=2006.1
           DO ^DIK
 +83       SET DIK="^DD(2006.1,"
           SET DA=13
           SET DA(1)=2006.1
           DO ^DIK
 +84       SET DIK="^DD(2006.1,"
           SET DA=14
           SET DA(1)=2006.1
           DO ^DIK
 +85       SET DIK="^DD(2006.1,"
           SET DA=15
           SET DA(1)=2006.1
           DO ^DIK
 +86       SET DIK="^DD(2006.1,"
           SET DA=16
           SET DA(1)=2006.1
           DO ^DIK
 +87       SET DIK="^DD(2006.1,"
           SET DA=17
           SET DA(1)=2006.1
           DO ^DIK
 +88       SET DIK="^DD(2006.1,"
           SET DA=18
           SET DA(1)=2006.1
           DO ^DIK
 +89       SET DIK="^DD(2006.1,"
           SET DA=19
           SET DA(1)=2006.1
           DO ^DIK
 +90       SET DIK="^DD(2006.1,"
           SET DA=21
           SET DA(1)=2006.1
           DO ^DIK
 +91       SET DIK="^DD(2006.1,"
           SET DA=22
           SET DA(1)=2006.1
           DO ^DIK
 +92       SET DIK="^DD(2006.1,"
           SET DA=23
           SET DA(1)=2006.1
           DO ^DIK
 +93       SET DIK="^DD(2006.1,"
           SET DA=24
           SET DA(1)=2006.1
           DO ^DIK
 +94      ; JUKEBOX DEFAULT - RETIRED CHANGED TO 2.01 see above
           SET DIK="^DD(2006.1,"
           SET DA=54
           SET DA(1)=2006.1
           DO ^DIK
 +95       SET DIK="^DD(2006.1,"
           SET DA=60.1
           SET DA(1)=2006.1
           DO ^DIK
 +96       SET DIK="^DD(2006.1,"
           SET DA=60.2
           SET DA(1)=2006.1
           DO ^DIK
 +97       SET DIK="^DD(2006.1,"
           SET DA=60.3
           SET DA(1)=2006.1
           DO ^DIK
 +98       SET DIK="^DD(2006.1,"
           SET DA=60.4
           SET DA(1)=2006.1
           DO ^DIK
 +99       SET DIK="^DD(2006.1,"
           SET DA=60.5
           SET DA(1)=2006.1
           DO ^DIK
 +100      SET DIK="^DD(2006.1,"
           SET DA=60.6
           SET DA(1)=2006.1
           DO ^DIK
 +101      SET DIK="^DD(2006.1,"
           SET DA=61
           SET DA(1)=2006.1
           DO ^DIK
 +102      SET DIK="^DD(2006.1,"
           SET DA=61.1
           SET DA(1)=2006.1
           DO ^DIK
 +103      SET DIK="^DD(2006.1,"
           SET DA=61.2
           SET DA(1)=2006.1
           DO ^DIK
 +104      SET DIK="^DD(2006.1,"
           SET DA=61.3
           SET DA(1)=2006.1
           DO ^DIK
 +105      SET DIK="^DD(2006.1,"
           SET DA=61.4
           SET DA(1)=2006.1
           DO ^DIK
 +106      SET DIK="^DD(2006.1,"
           SET DA=62
           SET DA(1)=2006.1
           DO ^DIK
 +107      SET DIK="^DD(2006.1,"
           SET DA=62.1
           SET DA(1)=2006.1
           DO ^DIK
 +108      SET DIK="^DD(2006.1,"
           SET DA=62.2
           SET DA(1)=2006.1
           DO ^DIK
 +109      SET DIK="^DD(2006.1,"
           SET DA=66.3
           SET DA(1)=2006.1
           DO ^DIK
 +110      SET DIK="^DD(2006.1,"
           SET DA=62.4
           SET DA(1)=2006.1
           DO ^DIK
 +111      SET DIK="^DD(2006.1,"
           SET DA=62.5
           SET DA(1)=2006.1
           DO ^DIK
 +112      SET DIK="^DD(2006.1,"
           SET DA=62.6
           SET DA(1)=2006.1
           DO ^DIK
 +113      SET DIK="^DD(2006.1,"
           SET DA=63
           SET DA(1)=2006.1
           DO ^DIK
 +114      SET DIK="^DD(2006.1,"
           SET DA=63.1
           SET DA(1)=2006.1
           DO ^DIK
 +115      SET DIK="^DD(2006.1,"
           SET DA=63.2
           SET DA(1)=2006.1
           DO ^DIK
 +116      SET DIK="^DD(2006.1,"
           SET DA=63.3
           SET DA(1)=2006.1
           DO ^DIK
 +117      SET DIK="^DD(2006.1,"
           SET DA=63.4
           SET DA(1)=2006.1
           DO ^DIK
 +118      SET DIK="^DD(2006.1,"
           SET DA=63.5
           SET DA(1)=2006.1
           DO ^DIK
 +119      SET DIK="^DD(2006.1,"
           SET DA=64
           SET DA(1)=2006.1
           DO ^DIK
 +120      SET DIK="^DD(2006.1,"
           SET DA=64.5
           SET DA(1)=2006.1
           DO ^DIK
 +121      SET DIK="^DD(2006.1,"
           SET DA=65.5
           SET DA(1)=2006.1
           DO ^DIK
 +122      SET DIK="^DD(2006.1,"
           SET DA=65
           SET DA(1)=2006.1
           DO ^DIK
 +123      SET DIK="^DD(2006.1,"
           SET DA=66
           SET DA(1)=2006.1
           DO ^DIK
 +124      SET DIK="^DD(2006.1,"
           SET DA=67
           SET DA(1)=2006.1
           DO ^DIK
 +125      SET DIK="^DD(2006.1,"
           SET DA=67.1
           SET DA(1)=2006.1
           DO ^DIK
 +126      SET DIK="^DD(2006.1,"
           SET DA=67.2
           SET DA(1)=2006.1
           DO ^DIK
 +127      SET DIK="^DD(2006.1,"
           SET DA=67.3
           SET DA(1)=2006.1
           DO ^DIK
 +128      SET DIK="^DD(2006.1,"
           SET DA=67.4
           SET DA(1)=2006.1
           DO ^DIK
 +129      SET DIK="^DD(2006.1,"
           SET DA=103
           SET DA(1)=2006.1
           DO ^DIK
 +130      SET DIK="^DD(2006.1,"
           SET DA=124
           SET DA(1)=2006.1
           DO ^DIK
 +131      SET DIK="^DD(2006.1,"
           SET DA=125
           SET DA(1)=2006.1
           DO ^DIK
 +132      SET DIK="^DD(2006.11,"
           SET DA=.01
           SET DA(1)=2006.11
           DO ^DIK
 +133      SET DIK="^DD(2006.112,"
           SET DA=.01
           SET DA(1)=2006.112
           DO ^DIK
 +134      SET DIK="^DD(2006.8,"
           SET DA=.01
           SET DA(1)=2006.8
           DO ^DIK
 +135      SET DIK="^DD(2006.8,"
           SET DA=.04
           SET DA(1)=2006.8
           DO ^DIK
 +136      SET DIK="^DD(2006.8,"
           SET DA=3
           SET DA(1)=2006.8
           DO ^DIK
 +137      SET DIK="^DD(2006.8,"
           SET DA=4
           SET DA(1)=2006.8
           DO ^DIK
 +138      SET DIK="^DD(2006.8,"
           SET DA=11
           SET DA(1)=2006.8
           DO ^DIK
 +139      SET DIK="^DD(2006.8,"
           SET DA=12
           SET DA(1)=2006.8
           DO ^DIK
 +140      SET DIK="^DD(2006.8,"
           SET DA=13
           SET DA(1)=2006.8
           DO ^DIK
 +141      SET DIK="^DD(2006.8,"
           SET DA=14
           SET DA(1)=2006.8
           DO ^DIK
 +142      SET DIK="^DD(2006.8,"
           SET DA=15
           SET DA(1)=2006.8
           DO ^DIK
 +143      SET DIK="^DD(2006.8,"
           SET DA=16
           SET DA(1)=2006.8
           DO ^DIK
 +144      SET DIK="^DD(2006.8,"
           SET DA=17
           SET DA(1)=2006.8
           DO ^DIK
 +145      SET DIK="^DD(2006.8,"
           SET DA=20
           SET DA(1)=2006.8
           DO ^DIK
 +146      SET DIK="^DD(2006.8,"
           SET DA=49
           SET DA(1)=2006.8
           DO ^DIK
 +147      SET DIK="^DD(2006.8,"
           SET DA=50
           SET DA(1)=2006.8
           DO ^DIK
 +148      SET DIK="^DD(2006.8,"
           SET DA=51
           SET DA(1)=2006.8
           DO ^DIK
 +149      SET DIK="^DD(2006.8,"
           SET DA=52
           SET DA(1)=2006.8
           DO ^DIK
 +150      SET DIK="^DD(2006.8,"
           SET DA=53
           SET DA(1)=2006.8
           DO ^DIK
 +151      SET DIK="^DD(2006.8,"
           SET DA=54
           SET DA(1)=2006.8
           DO ^DIK
 +152      SET DIK="^DD(2006.8,"
           SET DA=55
           SET DA(1)=2006.8
           DO ^DIK
 +153      SET DIK="^DD(2006.95,"
           SET DA=10
           SET DA(1)=2006.95
           DO ^DIK
 +154      SET DIK="^DD(2006.95,"
           SET DA=1
           SET DA(1)=2006.95
           DO ^DIK
 +155     ; Remove the Jukebox file data dictionary and data
 +156      SET DIU="^MAGQUEUE(2006.032,"
           SET DIU(0)="D"
           DO EN^DIU2
 +157     ;remove file definitions so that the new file definitions will lay down cleanly
 +158      NEW DIU
 +159      FOR DIU=2006.1665,2006.1664,2006.1662,2006.166
               Begin DoDot:1
 +160              SET DIU(0)="S"
                   DO EN^DIU2
 +161              QUIT 
               End DoDot:1
 +162     ; Retire option no longer active
 +163      DO RMOPT("MAGQ COQ")
 +164     ; Remove options so new ones install cleanly
 +165      DO RMOPT("MAGQ BPMONITOR")
 +166     ; Remove RPC so that it installs cleanly
 +167      DO RMRPC("MAGQB QUEDEL")
 +168      DO RMRPC("MAGQ JBQUE")
 +169      DO RMRPC("MAG FIELD VALIDATE")
 +170      DO RMRPC("MAG KEY VALIDATE")
 +171      DO RMRPC("MAGQ FTYPE")
 +172      DO RMRPC("MAGQ DFNIQ")
 +173      DO RMRPC("MAGQ ADD RAID GROUP")
 +174      DO RMRPC("MAGQ JBSCN")
 +175      DO RMRPC("MAGQBP FREF")
 +176      DO RMRPC("MAGQ FS CHNGE")
 +177      DO RMRPC("MAGQ QRNGE")
 +178      DO RMRPC("MAGQ FINDC")
 +179      DO RMRPC("MAGQ QCNT")
 +180      DO RMRPC("MAGQ ALL SERVER")
 +181      DO RMRPC("MAGQ JBPTR")
 +182      DO RMRPC("MAGQB PURNUL")
 +183      DO RMRPC("MAGQBP ALL SHARES")
 +184      DO RMRPC("MAGQBP CHKN")
 +185      DO RMRPC("MAGQ JBP")
 +186      DO RMRPC("MAGQ IRP GETNEXT")
 +187      DO RMRPC("MAGQ REA")
 +188      DO RMRPC("MAGQ REA UPDATE")
 +189      DO RMRPC("MAGQ SLAD")
 +190      DO RMRPC("MAGQ DEL NLOC")
 +191      DO RMRPC("MAGQ BP UAT")
 +192      QUIT 
CFILEN(NUM,NAME) ;
 +1        NEW DIE,DR,DA
 +2        SET DIE="^DIC("
           SET DR=".01///"_NAME
           SET DA=NUM
 +3        DO ^DIE
 +4        KILL DIE,DR,DA
 +5        QUIT 
RMRPC(NAME) ; Removing an RPC in order to revise
 +1        NEW MW,RPC,MWE,DIERR,DA,DIK
 +2        SET MW=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","")
 +3        DO CLEAN^DILF
 +4        SET RPC=$$FIND1^DIC(8994,"","X",NAME,"","","")
 +5        DO CLEAN^DILF
 +6        if 'RPC
               QUIT 
 +7        IF MW
               Begin DoDot:1
 +8                SET MWE=$$FIND1^DIC(19.05,","_MW_",","X",NAME,"","","")
 +9                DO CLEAN^DILF
 +10               if 'MWE
                       QUIT 
 +11               SET DA=MWE
                   SET DA(1)=MW
                   SET DIK="^DIC(19,"_DA(1)_",""RPC"","
 +12               DO ^DIK
 +13               KILL DA,DIK
 +14               QUIT 
               End DoDot:1
 +15       SET DA=RPC
           SET DIK="^XWB(8994,"
 +16       DO ^DIK
 +17       KILL DA,DIK
 +18       QUIT 
RMOPT(NAME) ; Removing an OPTION from the OPTION File (#19)
 +1        NEW OPT
 +2        SET OPT=$$FIND1^DIC(19,"","X",NAME,"","","")
 +3        DO CLEAN^DILF
 +4        if 'OPT
               QUIT 
 +5        IF NAME="MAGQ BPMONITOR"
               DO MAGSYS(NAME)
 +6        SET DA=OPT
           SET DIK="^DIC(19,"
 +7        DO ^DIK
 +8        KILL DA,DIK
 +9        QUIT 
MAGSYS(NAME) ;
 +1        NEW MENU,ITEM,DA,DIK
 +2        if NAME=""
               QUIT 
 +3        SET MENU=+$$FIND1^DIC(19,"","X","MAG SYS MENU")
           if '+MENU
               QUIT 
 +4        SET ITEM=$$FIND1^DIC(19.01,","_MENU_",","B",NAME)
           if '+ITEM
               QUIT 
 +5        SET DA=ITEM
           SET DA(1)=MENU
           SET DIK="^DIC(19,"_DA(1)_",10,"
           DO ^DIK
           KILL DA,DIK
 +6        QUIT