Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBA2807

DVBA2807.m

Go to the documentation of this file. 
  1. DVBA2807 ;SPH - PATCH DRIVER ; 3/29/06
  1.  ;;2.7;AMIE;**107**;Apr 10, 1995
  1.  ;
  1.  ; Make sure to call each exam name being sent in the patch
  1.  ; This routine will find existing matching entries and will ensure they're disabled.
  1.  ; Call as a pre-init or else it'll disable the exams just loaded.
  1. PRE ;
  1.  N DVBVERSS,DVBVERSN
  1.  S DVBVERSS="107F" ; What the version will be in the incoming file
  1.  S DVBVERSN="107" ; What the final version should be named
  1.  W !!!,"**** PRE-PROCESSING ****",!!
  1.  D DISABLE("INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
  1.  D DISABLE("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
  1.  Q
  1. POST ;
  1.  N DVBVERSS,DVBVERSN
  1.  S DVBVERSS="107F" ; What the version will be in the incoming file
  1.  S DVBVERSN="107" ; What the final version should be named
  1.  W !!!,"**** POST-PROCESSING ****",!!
  1.  D POSTP("INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
  1.  D POSTP("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
  1.  D RBXREF
  1.  Q
  1. POSTP(NM) ;
  1.  ; Rename XXXXXXX~imported version to XXXXXXX~new version
  1.  N DVBABCNT,DVBABIEN,DVBABST,DVBACH
  1.  N DVBABCN2,DVBABIE2,DVBABS2
  1.  S DVBABCNT=0,DVBABIEN=0
  1.  F  S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN  D
  1.  .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
  1.  .I $P(DVBABST,"~",1)=NM  I $P(DVBABST,"~",2)=DVBVERSS  D
  1.  ..;Check and be sure the new version isn't in the file yet
  1.  ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
  1.  ..F  S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2  D
  1.  ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
  1.  ...I $P(DVBABS2,"~",1)=NM  I $P(DVBABS2,"~",2)=DVBVERSN  S DVBACH=1
  1.  ..;If new version is found, delete the import version and don't import
  1.  ..I DVBACH=1  D
  1.  ...W "FOUND EXISTING "_NM_".  NO MODIFICATIONS MADE.",!
  1.  ...K ^DVB(396.18,DVBABIEN)
  1.  ..;If existing version isn't found, go ahead and rename imported entry to new version name
  1.  ..I DVBACH=0  D
  1.  ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
  1.  ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
  1.  K DVBABCNT,DVBABIEN,DVBABST,DVBACH
  1.  Q
  1. RBXREF ;
  1.  ; Rebuild cross-references
  1.  ; XRef: B
  1.  W !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
  1.  W !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
  1.  N DA,DIK,REGIEN,ROOT
  1.  S ROOT=$$ROOT^DILFD(396.18,,1)  K @ROOT@("B")
  1.  S REGIEN=0
  1.  F  S REGIEN=$O(@ROOT@(REGIEN))  Q:'REGIEN  D
  1.  . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
  1.  . S DA(1)=REGIEN  D ENALL^DIK
  1.  ; 
  1.  ; XRef: AV
  1.  W !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
  1.  N DA,DIK,REGIEN,ROOT
  1.  S ROOT=$$ROOT^DILFD(396.18,,1)  K @ROOT@("AV")
  1.  S REGIEN=0
  1.  F  S REGIEN=$O(@ROOT@(REGIEN))  Q:'REGIEN  D
  1.  . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
  1.  . S DA(1)=REGIEN  D ENALL^DIK
  1.  K DA,DIK,REGIEN,ROOT
  1.  Q 
  1. DISABLE(NM) ;
  1.  ; First look for matches and turn off the "selectable by user field"
  1.  ; This will keep the entry from showing in the list
  1.  ; Next, look at disabled date.  If there's no date, set it to today.
  1.  ; File is 396.18.  Field 3 is de-activation date.  Field 7 is selectable by user (0=no)
  1.  N DVBABCNT,DVBABIEN,DVBABST,DVBACH
  1.  S DVBABCNT=0,DVBABIEN=0
  1.  F  S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN  D
  1.  .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
  1.  .I $P(DVBABST,"~",1)=NM  I $P(DVBABST,"~",2)'=DVBVERSN  D
  1.  ..S DVBACH=0
  1.  ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0"  S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
  1.  ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)=""  S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1  ; This is deactivation date 
  1.  ..I DVBACH=1  W "MODIFIED: "_DVBABST,!
  1.  K DVBABCNT,DVBABIEN,DVBABST,DVBACH
  1.  Q