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

DVBA2814.m

Go to the documentation of this file.
  1. DVBA2814 ;ALB/SPH - PATCH DRIVER ; 2/12/07
  1. ;;2.7;AMIE;**114**;Apr 10, 1995;Build 10
  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
  1. ; they are disabled.
  1. ; Call as a pre-init or else it'll disable the exams just loaded.
  1. PRE ;
  1. N DVBVERSS,DVBVERSN
  1. ;
  1. ;rename 114 to 114T1 for test sites to allow final build to load
  1. D RENAME("114","114T1")
  1. ;
  1. S DVBVERSS="114F" ; What the version will be in the incoming file
  1. S DVBVERSN="114" ; What the final version should be named
  1. W !!!,"**** PRE-PROCESSING ****",!!
  1. D DISABLE("DIABETES MELLITUS")
  1. D DISABLE("EATING DISORDERS")
  1. D DISABLE("FEET")
  1. D DISABLE("GENERAL MEDICAL EXAMINATION")
  1. D DISABLE("GENITOURINARY EXAMINATION")
  1. D DISABLE("GULF WAR GUIDELINES")
  1. D DISABLE("HIV-RELATED ILLNESS")
  1. D DISABLE("HYPERTENSION")
  1. D DISABLE("INFECTIOUS, IMMUNE, AND NUTRITIONAL DISABILITIES")
  1. D DISABLE("PERIPHERAL NERVES")
  1. D DISABLE("PRISONER OF WAR PROTOCOL EXAMINATION")
  1. D DISABLE("RECTUM AND ANUS")
  1. D DISABLE("RESPIRATORY DISEASES, MISCELLANEOUS")
  1. D DISABLE("SKIN DISEASES (OTHER THAN SCARS)")
  1. D DISABLE("SPINE")
  1. Q
  1. POST ;
  1. N DVBVERSS,DVBVERSN
  1. S DVBVERSS="114F" ; What the version will be in the incoming file
  1. S DVBVERSN="114" ; What the final version should be named
  1. W !!!,"**** POST-PROCESSING ****",!!
  1. D POSTP("DIABETES MELLITUS")
  1. D POSTP("EATING DISORDERS")
  1. D POSTP("FEET")
  1. D POSTP("GENERAL MEDICAL EXAMINATION")
  1. D POSTP("GENITOURINARY EXAMINATION")
  1. D POSTP("GULF WAR GUIDELINES")
  1. D POSTP("HIV-RELATED ILLNESS")
  1. D POSTP("HYPERTENSION")
  1. D POSTP("INFECTIOUS, IMMUNE, AND NUTRITIONAL DISABILITIES")
  1. D POSTP("PERIPHERAL NERVES")
  1. D POSTP("PRISONER OF WAR PROTOCOL EXAMINATION")
  1. D POSTP("RECTUM AND ANUS")
  1. D POSTP("RESPIRATORY DISEASES, MISCELLANEOUS")
  1. D POSTP("SKIN DISEASES (OTHER THAN SCARS)")
  1. D POSTP("SPINE")
  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
  1. ;
  1. RENAME(DVBOLD,DVBNEW) ;rename templates
  1. ;This procedure searches for any version DVBOLD template definitions
  1. ;that have a non-zero deactivation date and renames them to DVBNEW.
  1. ;No action is taken when any of the following conditions exist:
  1. ; * Deactivation date is not defined
  1. ; * A version DVBNEW template already exists.
  1. ;
  1. ; Input:
  1. ; DVBOLD - old version name
  1. ; DVBNEW - new version name
  1. ;
  1. ; Output: none
  1. ;
  1. N DVBERR ;DBS error message array
  1. N DVBI ;generic index
  1. N DVBIEN ;pointer to #396.18
  1. N DVBTNAM ;template name
  1. ;
  1. F DVBI=1:1 S DVBTNAM=$P($T(TLIST+DVBI),";",3) Q:DVBTNAM="**END**" D
  1. . S DVBIEN=$$FIND1^DIC(396.18,"","X",DVBTNAM_"~"_DVBOLD,"B","","DVBERR")
  1. . I DVBIEN,+$$GET1^DIQ(396.18,DVBIEN_",",3,"I","","DVBERR")>0 D
  1. . . N DVBFDA ;filer FDA array
  1. . . ;
  1. . . ;short-circuit when new version exists
  1. . . Q:$$FIND1^DIC(396.18,"","X",DVBTNAM_"~"_DVBNEW,"B","","DVBERR")
  1. . . ;
  1. . . ;rename it
  1. . . S DVBFDA(396.18,DVBIEN_",",.01)=DVBTNAM_"~"_DVBNEW
  1. . . D FILE^DIE("E","DVBFDA","DVBERR")
  1. ;
  1. Q
  1. ;
  1. TLIST ;;TEMPLATE LIST
  1. ;;DIABETES MELLITUS
  1. ;;EATING DISORDERS
  1. ;;FEET
  1. ;;GENERAL MEDICAL EXAMINATION
  1. ;;GENITOURINARY EXAMINATION
  1. ;;GULF WAR GUIDELINES
  1. ;;HIV-RELATED ILLNESS
  1. ;;HYPERTENSION
  1. ;;INFECTIOUS, IMMUNE, AND NUTRITIONAL DISABILITIES
  1. ;;PERIPHERAL NERVES
  1. ;;PRISONER OF WAR PROTOCOL EXAMINATION
  1. ;;RECTUM AND ANUS
  1. ;;RESPIRATORY DISEASES, MISCELLANEOUS
  1. ;;SKIN DISEASES (OTHER THAN SCARS)
  1. ;;SPINE
  1. ;;**END**