source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2803.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1DVBA2803 ;SPH - PATCH DRIVER ; 11/17/05
2 ;;2.7;AMIE;**103**;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="103F" ; What the version will be in the incoming file
10 S DVBVERSN="103T1" ; What the final version should be named
11 W !!!,"**** PRE-PROCESSING ****",!!
12 D DISABLE("ACROMEGALY")
13 D DISABLE("ARRHYTHMIAS")
14 D DISABLE("ARTERIES, VEINS AND MISCELLANEOUS")
15 D DISABLE("BRAIN AND SPINAL CORD")
16 D DISABLE("COLD INJURY PROTOCOL EXAMINATION")
17 D DISABLE("CRANIAL NERVES")
18 D DISABLE("CUSHINGS SYNDROME")
19 D DISABLE("DENTAL AND ORAL")
20 D DISABLE("DIGESTIVE CONDITIONS, MISCELLANEOUS")
21 D DISABLE("EATING DISORDERS")
22 D DISABLE("EPILEPSY AND NARCOLEPSY")
23 D DISABLE("ESOPHAGUS AND HIATAL HERNIA")
24 D DISABLE("FIBROMYALGIA")
25 D DISABLE("GULF WAR GUIDELINES")
26 D DISABLE("GYNECOLOGICAL CONDITIONS AND DISORDERS OF THE BREAST")
27 D DISABLE("HIV-RELATED ILLNESS")
28 D DISABLE("INFECTIOUS, IMMUNE, AND NUTRITIONAL DISABILITIES")
29 D DISABLE("INTESTINES (LARGE AND SMALL)")
30 D DISABLE("LIVER, GALL BLADDER, AND PANCREAS")
31 D DISABLE("LYMPHATIC DISORDERS")
32 D DISABLE("MISCELLANEOUS ENDOCRINE DISEASES")
33 D DISABLE("MOUTH, LIPS AND TONGUE")
34 D DISABLE("PRISONER OF WAR PROTOCOL EXAMINATION")
35 D DISABLE("PULMONARY TUBERCULOSIS AND MYCOBACTERIAL DISEASES")
36 D DISABLE("RECTUM AND ANUS")
37 D DISABLE("RESIDUALS OF AMPUTATIONS")
38 D DISABLE("SENSE OF SMELL AND TASTE")
39 D DISABLE("SOCIAL WORK AND INDUSTRIAL SURVEY")
40 D DISABLE("THYROID AND PARATHYROID DISEASES")
41 Q
42POST ;
43 N DVBVERSS,DVBVERSN
44 S DVBVERSS="103F" ; What the version will be in the incoming file
45 S DVBVERSN="103T1" ; What the final version should be named
46 W !!!,"**** POST-PROCESSING ****",!!
47 D POSTP("ACROMEGALY")
48 D POSTP("ARRHYTHMIAS")
49 D POSTP("ARTERIES, VEINS AND MISCELLANEOUS")
50 D POSTP("BRAIN AND SPINAL CORD")
51 D POSTP("COLD INJURY PROTOCOL EXAMINATION")
52 D POSTP("CRANIAL NERVES")
53 D POSTP("CUSHINGS SYNDROME")
54 D POSTP("DENTAL AND ORAL")
55 D POSTP("DIGESTIVE CONDITIONS, MISCELLANEOUS")
56 D POSTP("EATING DISORDERS")
57 D POSTP("EPILEPSY AND NARCOLEPSY")
58 D POSTP("ESOPHAGUS AND HIATAL HERNIA")
59 D POSTP("FIBROMYALGIA")
60 D POSTP("GULF WAR GUIDELINES")
61 D POSTP("GYNECOLOGICAL CONDITIONS AND DISORDERS OF THE BREAST")
62 D POSTP("HIV-RELATED ILLNESS")
63 D POSTP("INFECTIOUS, IMMUNE, AND NUTRITIONAL DISABILITIES")
64 D POSTP("INTESTINES (LARGE AND SMALL)")
65 D POSTP("LIVER, GALL BLADDER, AND PANCREAS")
66 D POSTP("LYMPHATIC DISORDERS")
67 D POSTP("MISCELLANEOUS ENDOCRINE DISEASES")
68 D POSTP("MOUTH, LIPS AND TONGUE")
69 D POSTP("PRISONER OF WAR PROTOCOL EXAMINATION")
70 D POSTP("PULMONARY TUBERCULOSIS AND MYCOBACTERIAL DISEASES")
71 D POSTP("RECTUM AND ANUS")
72 D POSTP("RESIDUALS OF AMPUTATIONS")
73 D POSTP("SENSE OF SMELL AND TASTE")
74 D POSTP("SOCIAL WORK AND INDUSTRIAL SURVEY")
75 D POSTP("THYROID AND PARATHYROID DISEASES")
76 D RBXREF
77 Q
78POSTP(NM) ;
79 ; Rename XXXXXXX~imported version to XXXXXXX~new version
80 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
81 N DVBABCN2,DVBABIE2,DVBABS2
82 S DVBABCNT=0,DVBABIEN=0
83 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
84 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
85 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
86 ..;Check and be sure the new version isn't in the file yet
87 ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
88 ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
89 ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
90 ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
91 ..;If new version is found, delete the import version and don't import
92 ..I DVBACH=1 D
93 ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
94 ...K ^DVB(396.18,DVBABIEN)
95 ..;If existing version isn't found, go ahead and rename imported entry to new version name
96 ..I DVBACH=0 D
97 ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
98 ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
99 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
100 Q
101RBXREF ;
102 ; Rebuild cross-references
103 ; XRef: B
104 W !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
105 W !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
106 N DA,DIK,REGIEN,ROOT
107 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
108 S REGIEN=0
109 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
110 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
111 . S DA(1)=REGIEN D ENALL^DIK
112 ;
113 ; XRef: AV
114 W !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
115 N DA,DIK,REGIEN,ROOT
116 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
117 S REGIEN=0
118 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
119 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
120 . S DA(1)=REGIEN D ENALL^DIK
121 K DA,DIK,REGIEN,ROOT
122 ;
123 ; XRef: C, in 2507 EXAM FILE
124 ;W !!,"REBUILDING 'C' XREF, 2507 EXAM FILE",!
125 ;N DA,DIK,REGIEN,ROOT
126 ;S ROOT=$$ROOT^DILFD(396.4,,1) K @ROOT@("C")
127 ;S REGIEN=0
128 ;F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
129 ;. S DIK=$$ROOT^DILFD(396.4,","_REGIEN_","),DIK(1)=".02^C"
130 ;. S DA(1)=REGIEN D ENALL^DIK
131 ;K DA,DIK,REGIEN,ROOT
132 ;Q
133DISABLE(NM) ;
134 ; First look for matches and turn off the "selectable by user field"
135 ; This will keep the entry from showing in the list
136 ; Next, look at disabled date. If there's no date, set it to today.
137 ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
138 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
139 S DVBABCNT=0,DVBABIEN=0
140 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
141 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
142 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
143 ..S DVBACH=0
144 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
145 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
146 ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
147 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
148 Q
Note: See TracBrowser for help on using the repository browser.