source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2796.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1DVBA2796 ;SPH - PATCH DRIVER ; 10/20/05
2 ;;2.7;AMIE;**96**;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="96F" ; What the version will be in the incoming file
10 S DVBVERSN="96" ; What the final version should be named
11 W !!!,"**** PRE-PROCESSING ****",!!
12 D DISABLE("AID AND ATTENDANCE OR HOUSEBOUND EXAMINATION")
13 D DISABLE("AUDIO")
14 D DISABLE("BONES (FRACTURES AND BONE DISEASE)")
15 D DISABLE("CHRONIC FATIGUE SYNDROME")
16 D DISABLE("DIABETES MELLITUS")
17 D DISABLE("EAR DISEASE")
18 D DISABLE("EYE EXAMINATION")
19 D DISABLE("FEET")
20 D DISABLE("GENERAL MEDICAL EXAMINATION")
21 D DISABLE("GENITOURINARY EXAMINATION")
22 D DISABLE("HAND, THUMB, AND FINGERS")
23 D DISABLE("HEART")
24 D DISABLE("HEMIC DISORDERS")
25 D DISABLE("HYPERTENSION")
26 D DISABLE("INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
27 D DISABLE("JOINTS")
28 D DISABLE("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
29 D DISABLE("MUSCLES")
30 D DISABLE("NEUROLOGICAL DISORDERS, MISCELLANEOUS")
31 D DISABLE("NOSE, SINUS, LARYNX, AND PHARYNX")
32 D DISABLE("PERIPHERAL NERVES")
33 D DISABLE("RESPIRATORY (OBSTRUCTIVE, RESTRICTIVE, AND INTERSTITIAL)")
34 D DISABLE("RESPIRATORY DISEASES, MISCELLANEOUS")
35 D DISABLE("REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
36 D DISABLE("SCARS")
37 D DISABLE("SKIN DISEASES (OTHER THAN SCARS)")
38 D DISABLE("SPINE")
39 D DISABLE("STOMACH, DUODENUM AND PERITONEAL ADHESIONS")
40 Q
41POST ;
42 N DVBVERSS,DVBVERSN
43 S DVBVERSS="96F" ; What the version will be in the incoming file
44 S DVBVERSN="96" ; What the final version should be named
45 W !!!,"**** POST-PROCESSING ****",!!
46 D POSTP("AID AND ATTENDANCE OR HOUSEBOUND EXAMINATION")
47 D POSTP("AUDIO")
48 D POSTP("BONES (FRACTURES AND BONE DISEASE)")
49 D POSTP("CHRONIC FATIGUE SYNDROME")
50 D POSTP("DIABETES MELLITUS")
51 D POSTP("EAR DISEASE")
52 D POSTP("EYE EXAMINATION")
53 D POSTP("FEET")
54 D POSTP("GENERAL MEDICAL EXAMINATION")
55 D POSTP("GENITOURINARY EXAMINATION")
56 D POSTP("HAND, THUMB, AND FINGERS")
57 D POSTP("HEART")
58 D POSTP("HEMIC DISORDERS")
59 D POSTP("HYPERTENSION")
60 D POSTP("INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
61 D POSTP("JOINTS")
62 D POSTP("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
63 D POSTP("MUSCLES")
64 D POSTP("NEUROLOGICAL DISORDERS, MISCELLANEOUS")
65 D POSTP("NOSE, SINUS, LARYNX, AND PHARYNX")
66 D POSTP("PERIPHERAL NERVES")
67 D POSTP("RESPIRATORY (OBSTRUCTIVE, RESTRICTIVE, AND INTERSTITIAL)")
68 D POSTP("RESPIRATORY DISEASES, MISCELLANEOUS")
69 D POSTP("REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
70 D POSTP("SCARS")
71 D POSTP("SKIN DISEASES (OTHER THAN SCARS)")
72 D POSTP("SPINE")
73 D POSTP("STOMACH, DUODENUM AND PERITONEAL ADHESIONS")
74 D RBXREF
75 Q
76POSTP(NM) ;
77 ; Rename XXXXXXX~imported version to XXXXXXX~new version
78 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
79 N DVBABCN2,DVBABIE2,DVBABS2
80 S DVBABCNT=0,DVBABIEN=0
81 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
82 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
83 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
84 ..;Check and be sure the new version isn't in the file yet
85 ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
86 ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
87 ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
88 ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
89 ..;If new version is found, delete the import version and don't import
90 ..I DVBACH=1 D
91 ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
92 ...K ^DVB(396.18,DVBABIEN)
93 ..;If existing version isn't found, go ahead and rename imported entry to new version name
94 ..I DVBACH=0 D
95 ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
96 ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
97 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
98 Q
99RBXREF ;
100 ; Rebuild cross-references
101 ; XRef: B
102 W !!,"REBUILDING 'B' XREF",!
103 N DA,DIK,REGIEN,ROOT
104 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
105 S REGIEN=0
106 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
107 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
108 . S DA(1)=REGIEN D ENALL^DIK
109 ;
110 ; XRef: AV
111 W !!,"REBUILDING 'AV' XREF",!
112 N DA,DIK,REGIEN,ROOT
113 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
114 S REGIEN=0
115 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
116 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
117 . S DA(1)=REGIEN D ENALL^DIK
118 K DA,DIK,REGIEN,ROOT
119 Q
120DISABLE(NM) ;
121 ; First look for matches and turn off the "selectable by user field"
122 ; This will keep the entry from showing in the list
123 ; Next, look at disabled date. If there's no date, set it to today.
124 ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
125 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
126 S DVBABCNT=0,DVBABIEN=0
127 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
128 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
129 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
130 ..S DVBACH=0
131 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
132 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
133 ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
134 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
135 Q
Note: See TracBrowser for help on using the repository browser.