DVBA2829 ;ALB/KCL - PATCH DVBA*2.7*129 INSTALL UTILITIES ; 1/25/08
;;2.7;AMIE;**129**;Apr 10, 1995;Build 31
;
; Pre/Post install routine for patch DVBA*2.7*129.
;
; Make sure to call each exam name being exported in the patch.
; This routine will find existing matching entries and ensure
; they are disabled. Call as a pre-init or else it will disable
; the exams just loaded.
;
PRE ;Main entry point for Pre-init items.
N DVBVERSS,DVBVERSN
S DVBVERSS="129F" ;what the version will be in the incoming file
S DVBVERSN="129" ;what the final version should be named
W !!!,"**** PRE-INSTALL PROCESSING ****",!!
D DISABLE("TRAUMATIC BRAIN INJURY")
Q
;
POST ;Main entry point for Post-init items.
N DVBVERSS,DVBVERSN
S DVBVERSS="129F" ;what the version will be in the incoming file
S DVBVERSN="129" ;what the final version should be named
W !!!,"**** POST-INSTALL PROCESSING ****",!!
D POSTP("TRAUMATIC BRAIN INJURY")
D RBXREF
Q
;
POSTP(NM) ;Rename XXXXXXX~imported version to XXXXXXX~new version.
N DVBABCNT,DVBABIEN,DVBABST,DVBACH,DVBABCN2,DVBABIE2,DVBABS2
S DVBABCNT=0,DVBABIEN=0
F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
.S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
.I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
..;Check and be sure the new version isn't in the file yet
..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
..;If new version is found, delete the import version and don't import
..I DVBACH=1 D
...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
...K ^DVB(396.18,DVBABIEN)
..;If existing version isn't found, go ahead and rename imported entry to new version name
..I DVBACH=0 D
...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
K DVBABCNT,DVBABIEN,DVBABST,DVBACH
Q
;
RBXREF ;Rebuild cross-references.
;
;XRef: B
W !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
W !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
N DA,DIK,REGIEN,ROOT
S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
S REGIEN=0
F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
. S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
. S DA(1)=REGIEN D ENALL^DIK
;
;XRef: AV
W !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
N DA,DIK,REGIEN,ROOT
S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
S REGIEN=0
F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
. S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
. S DA(1)=REGIEN D ENALL^DIK
K DA,DIK,REGIEN,ROOT
Q
;
DISABLE(NM) ;Disable matching templates in CAPRI TEMPLATE DEFINITIONS (#396.18) file.
;First look for matches and turn off SELECTABLE BY USER? field. This will
;keep the entry from showing in the list. Next, look at DE-ACTIVATION DATE field.
;If there's no date, set it to today.
;
N DVBABCNT,DVBABIEN,DVBABST,DVBACH
S DVBABCNT=0,DVBABIEN=0
;look for template matches
F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
.S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
.I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
..S DVBACH=0
..;Selectable by user field
..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
..;Deactivation date field
..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1
..;output modified templates
..I DVBACH=1 W "MODIFIED: "_DVBABST,!
;
K DVBABCNT,DVBABIEN,DVBABST,DVBACH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA2829 3744 printed Dec 13, 2024@01:39:55 Page 2
DVBA2829 ;ALB/KCL - PATCH DVBA*2.7*129 INSTALL UTILITIES ; 1/25/08
+1 ;;2.7;AMIE;**129**;Apr 10, 1995;Build 31
+2 ;
+3 ; Pre/Post install routine for patch DVBA*2.7*129.
+4 ;
+5 ; Make sure to call each exam name being exported in the patch.
+6 ; This routine will find existing matching entries and ensure
+7 ; they are disabled. Call as a pre-init or else it will disable
+8 ; the exams just loaded.
+9 ;
PRE ;Main entry point for Pre-init items.
+1 NEW DVBVERSS,DVBVERSN
+2 ;what the version will be in the incoming file
SET DVBVERSS="129F"
+3 ;what the final version should be named
SET DVBVERSN="129"
+4 WRITE !!!,"**** PRE-INSTALL PROCESSING ****",!!
+5 DO DISABLE("TRAUMATIC BRAIN INJURY")
+6 QUIT
+7 ;
POST ;Main entry point for Post-init items.
+1 NEW DVBVERSS,DVBVERSN
+2 ;what the version will be in the incoming file
SET DVBVERSS="129F"
+3 ;what the final version should be named
SET DVBVERSN="129"
+4 WRITE !!!,"**** POST-INSTALL PROCESSING ****",!!
+5 DO POSTP("TRAUMATIC BRAIN INJURY")
+6 DO RBXREF
+7 QUIT
+8 ;
POSTP(NM) ;Rename XXXXXXX~imported version to XXXXXXX~new version.
+1 NEW DVBABCNT,DVBABIEN,DVBABST,DVBACH,DVBABCN2,DVBABIE2,DVBABS2
+2 SET DVBABCNT=0
SET DVBABIEN=0
+3 FOR
SET DVBABIEN=$ORDER(^DVB(396.18,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+4 SET DVBABST=$PIECE($GET(^DVB(396.18,DVBABIEN,0)),"^",1)
+5 IF $PIECE(DVBABST,"~",1)=NM
IF $PIECE(DVBABST,"~",2)=DVBVERSS
Begin DoDot:2
+6 ;Check and be sure the new version isn't in the file yet
+7 SET DVBABCN2=0
SET DVBABIE2=0
SET DVBACH=0
+8 FOR
SET DVBABIE2=$ORDER(^DVB(396.18,DVBABIE2))
if 'DVBABIE2
QUIT
Begin DoDot:3
+9 SET DVBABS2=$PIECE($GET(^DVB(396.18,DVBABIE2,0)),"^",1)
+10 IF $PIECE(DVBABS2,"~",1)=NM
IF $PIECE(DVBABS2,"~",2)=DVBVERSN
SET DVBACH=1
End DoDot:3
+11 ;If new version is found, delete the import version and don't import
+12 IF DVBACH=1
Begin DoDot:3
+13 WRITE "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
+14 KILL ^DVB(396.18,DVBABIEN)
End DoDot:3
+15 ;If existing version isn't found, go ahead and rename imported entry to new version name
+16 IF DVBACH=0
Begin DoDot:3
+17 SET $PIECE(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
+18 WRITE "ACTIVATED: "_$PIECE($GET(^DVB(396.18,DVBABIEN,0)),"^",1),!
End DoDot:3
End DoDot:2
End DoDot:1
+19 KILL DVBABCNT,DVBABIEN,DVBABST,DVBACH
+20 QUIT
+21 ;
RBXREF ;Rebuild cross-references.
+1 ;
+2 ;XRef: B
+3 WRITE !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
+4 WRITE !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
+5 NEW DA,DIK,REGIEN,ROOT
+6 SET ROOT=$$ROOT^DILFD(396.18,,1)
KILL @ROOT@("B")
+7 SET REGIEN=0
+8 FOR
SET REGIEN=$ORDER(@ROOT@(REGIEN))
if 'REGIEN
QUIT
Begin DoDot:1
+9 SET DIK=$$ROOT^DILFD(396.18,","_REGIEN_",")
SET DIK(1)=".01^B"
+10 SET DA(1)=REGIEN
DO ENALL^DIK
End DoDot:1
+11 ;
+12 ;XRef: AV
+13 WRITE !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
+14 NEW DA,DIK,REGIEN,ROOT
+15 SET ROOT=$$ROOT^DILFD(396.18,,1)
KILL @ROOT@("AV")
+16 SET REGIEN=0
+17 FOR
SET REGIEN=$ORDER(@ROOT@(REGIEN))
if 'REGIEN
QUIT
Begin DoDot:1
+18 SET DIK=$$ROOT^DILFD(396.18,","_REGIEN_",")
SET DIK(1)=".01^AV"
+19 SET DA(1)=REGIEN
DO ENALL^DIK
End DoDot:1
+20 KILL DA,DIK,REGIEN,ROOT
+21 QUIT
+22 ;
DISABLE(NM) ;Disable matching templates in CAPRI TEMPLATE DEFINITIONS (#396.18) file.
+1 ;First look for matches and turn off SELECTABLE BY USER? field. This will
+2 ;keep the entry from showing in the list. Next, look at DE-ACTIVATION DATE field.
+3 ;If there's no date, set it to today.
+4 ;
+5 NEW DVBABCNT,DVBABIEN,DVBABST,DVBACH
+6 SET DVBABCNT=0
SET DVBABIEN=0
+7 ;look for template matches
+8 FOR
SET DVBABIEN=$ORDER(^DVB(396.18,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+9 SET DVBABST=$PIECE($GET(^DVB(396.18,DVBABIEN,0)),"^",1)
+10 IF $PIECE(DVBABST,"~",1)=NM
IF $PIECE(DVBABST,"~",2)'=DVBVERSN
Begin DoDot:2
+11 SET DVBACH=0
+12 ;Selectable by user field
+13 IF $PIECE(^DVB(396.18,DVBABIEN,6),"^",1)'="0"
SET $PIECE(^DVB(396.18,DVBABIEN,6),"^",1)="0"
SET DVBACH=1
+14 ;Deactivation date field
+15 IF $PIECE(^DVB(396.18,DVBABIEN,2),"^",2)=""
SET $PIECE(^DVB(396.18,DVBABIEN,2),"^",2)=DT
SET DVBACH=1
+16 ;output modified templates
+17 IF DVBACH=1
WRITE "MODIFIED: "_DVBABST,!
End DoDot:2
End DoDot:1
+18 ;
+19 KILL DVBABCNT,DVBABIEN,DVBABST,DVBACH
+20 QUIT
