source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2813.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1DVBA2813 ;SPH - PATCH DRIVER ; 6/23/06
2 ;;2.7;AMIE;**113**;Apr 10, 1995
3 ;
4 ; Make sure to call each exam name being sent in the patch
5 ; This routine will find existing matching entries and will ensure they're disabled.
6 ; Call as a pre-init or else it'll disable the exams just loaded.
7PRE ;
8 N DVBVERSS,DVBVERSN
9 S DVBVERSS="113F" ; What the version will be in the incoming file
10 S DVBVERSN="113" ; What the final version should be named
11 W !!!,"**** PRE-PROCESSING ****",!!
12 D DISABLE("ARRHYTHMIAS")
13 D DISABLE("ARTERIES, VEINS AND MISCELLANEOUS")
14 D DISABLE("CRANIAL NERVES")
15 D DISABLE("DIGESTIVE CONDITIONS, MISCELLANEOUS")
16 D DISABLE("EAR DISEASE")
17 D DISABLE("GYNECOLOGICAL CONDITIONS AND DISORDERS OF THE BREAST")
18 D DISABLE("INTESTINES (LARGE AND SMALL)")
19 D DISABLE("LIVER, GALL BLADDER, AND PANCREAS")
20 D DISABLE("NOSE, SINUS, LARYNX, AND PHARYNX")
21 D DISABLE("RECTUM AND ANUS")
22 D DISABLE("STOMACH, DUODENUM AND PERITONEAL ADHESIONS")
23 D DISABLE("AID AND ATTENDANCE OR HOUSEBOUND EXAMINATION")
24 D DISABLE("BONES (FRACTURES AND BONE DISEASE)")
25 D DISABLE("BRAIN AND SPINAL CORD")
26 D DISABLE("CHRONIC FATIGUE SYNDROME")
27 D DISABLE("FIBROMYALGIA")
28 D DISABLE("GENITOURINARY EXAMINATION")
29 Q
30POST ;
31 N DVBVERSS,DVBVERSN
32 S DVBVERSS="113F" ; What the version will be in the incoming file
33 S DVBVERSN="113" ; What the final version should be named
34 W !!!,"**** POST-PROCESSING ****",!!
35 D POSTP("ARRHYTHMIAS")
36 D POSTP("ARTERIES, VEINS AND MISCELLANEOUS")
37 D POSTP("CRANIAL NERVES")
38 D POSTP("DIGESTIVE CONDITIONS, MISCELLANEOUS")
39 D POSTP("EAR DISEASE")
40 D POSTP("GYNECOLOGICAL CONDITIONS AND DISORDERS OF THE BREAST")
41 D POSTP("INTESTINES (LARGE AND SMALL)")
42 D POSTP("LIVER, GALL BLADDER, AND PANCREAS")
43 D POSTP("NOSE, SINUS, LARYNX, AND PHARYNX")
44 D POSTP("RECTUM AND ANUS")
45 D POSTP("STOMACH, DUODENUM AND PERITONEAL ADHESIONS")
46 D POSTP("AID AND ATTENDANCE OR HOUSEBOUND EXAMINATION")
47 D POSTP("BONES (FRACTURES AND BONE DISEASE)")
48 D POSTP("BRAIN AND SPINAL CORD")
49 D POSTP("CHRONIC FATIGUE SYNDROME")
50 D POSTP("FIBROMYALGIA")
51 D POSTP("GENITOURINARY EXAMINATION")
52 D RBXREF
53 Q
54POSTP(NM) ;
55 ; Rename XXXXXXX~imported version to XXXXXXX~new version
56 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
57 N DVBABCN2,DVBABIE2,DVBABS2
58 S DVBABCNT=0,DVBABIEN=0
59 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
60 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
61 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
62 ..;Check and be sure the new version isn't in the file yet
63 ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
64 ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
65 ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
66 ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
67 ..;If new version is found, delete the import version and don't import
68 ..I DVBACH=1 D
69 ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
70 ...K ^DVB(396.18,DVBABIEN)
71 ..;If existing version isn't found, go ahead and rename imported entry to new version name
72 ..I DVBACH=0 D
73 ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
74 ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
75 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
76 Q
77RBXREF ;
78 ; Rebuild cross-references
79 ; XRef: B
80 W !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
81 W !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
82 N DA,DIK,REGIEN,ROOT
83 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
84 S REGIEN=0
85 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
86 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
87 . S DA(1)=REGIEN D ENALL^DIK
88 ;
89 ; XRef: AV
90 W !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
91 N DA,DIK,REGIEN,ROOT
92 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
93 S REGIEN=0
94 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
95 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
96 . S DA(1)=REGIEN D ENALL^DIK
97 K DA,DIK,REGIEN,ROOT
98 Q
99DISABLE(NM) ;
100 ; First look for matches and turn off the "selectable by user field"
101 ; This will keep the entry from showing in the list
102 ; Next, look at disabled date. If there's no date, set it to today.
103 ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
104 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
105 S DVBABCNT=0,DVBABIEN=0
106 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
107 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
108 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
109 ..S DVBACH=0
110 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
111 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
112 ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
113 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
114 Q
Note: See TracBrowser for help on using the repository browser.