- 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 Feb 18, 2025@23:06:19 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