source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2806.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: 4.4 KB
Line 
1DVBA2806 ;SPH - PATCH DRIVER ; 3/24/06
2 ;;2.7;AMIE;**106**;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="106F" ; What the version will be in the incoming file
10 S DVBVERSN="106" ; What the final version should be named
11 W !!!,"**** PRE-PROCESSING ****",!!
12 D DISABLE("AUDIO")
13 D DISABLE("DIABETES MELLITUS")
14 D DISABLE("EYE EXAMINATION")
15 D DISABLE("GENITOURINARY EXAMINATION")
16 D DISABLE("HEART")
17 D DISABLE("HYPERTENSION")
18 D DISABLE("INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
19 D DISABLE("MEDICAL OPINION")
20 D DISABLE("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
21 D DISABLE("NEUROLOGICAL DISORDERS, MISCELLANEOUS")
22 D DISABLE("PERIPHERAL NERVES")
23 D DISABLE("RESPIRATORY (OBSTRUCTIVE, RESTRICTIVE, AND INTERSTITIAL)")
24 D DISABLE("REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
25 D DISABLE("SCARS")
26 Q
27POST ;
28 N DVBVERSS,DVBVERSN
29 S DVBVERSS="106F" ; What the version will be in the incoming file
30 S DVBVERSN="106" ; What the final version should be named
31 W !!!,"**** POST-PROCESSING ****",!!
32 D POSTP("AUDIO")
33 D POSTP("DIABETES MELLITUS")
34 D POSTP("EYE EXAMINATION")
35 D POSTP("GENITOURINARY EXAMINATION")
36 D POSTP("HEART")
37 D POSTP("HYPERTENSION")
38 D POSTP("INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
39 D POSTP("MEDICAL OPINION")
40 D POSTP("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
41 D POSTP("NEUROLOGICAL DISORDERS, MISCELLANEOUS")
42 D POSTP("PERIPHERAL NERVES")
43 D POSTP("RESPIRATORY (OBSTRUCTIVE, RESTRICTIVE, AND INTERSTITIAL)")
44 D POSTP("REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")
45 D POSTP("SCARS")
46 D RBXREF
47 Q
48POSTP(NM) ;
49 ; Rename XXXXXXX~imported version to XXXXXXX~new version
50 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
51 N DVBABCN2,DVBABIE2,DVBABS2
52 S DVBABCNT=0,DVBABIEN=0
53 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
54 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
55 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
56 ..;Check and be sure the new version isn't in the file yet
57 ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
58 ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
59 ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
60 ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
61 ..;If new version is found, delete the import version and don't import
62 ..I DVBACH=1 D
63 ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
64 ...K ^DVB(396.18,DVBABIEN)
65 ..;If existing version isn't found, go ahead and rename imported entry to new version name
66 ..I DVBACH=0 D
67 ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
68 ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
69 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
70 Q
71RBXREF ;
72 ; Rebuild cross-references
73 ; XRef: B
74 W !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
75 W !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
76 N DA,DIK,REGIEN,ROOT
77 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
78 S REGIEN=0
79 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
80 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
81 . S DA(1)=REGIEN D ENALL^DIK
82 ;
83 ; XRef: AV
84 W !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
85 N DA,DIK,REGIEN,ROOT
86 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
87 S REGIEN=0
88 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
89 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
90 . S DA(1)=REGIEN D ENALL^DIK
91 K DA,DIK,REGIEN,ROOT
92 Q
93DISABLE(NM) ;
94 ; First look for matches and turn off the "selectable by user field"
95 ; This will keep the entry from showing in the list
96 ; Next, look at disabled date. If there's no date, set it to today.
97 ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
98 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
99 S DVBABCNT=0,DVBABIEN=0
100 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
101 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
102 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
103 ..S DVBACH=0
104 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
105 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
106 ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
107 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
108 Q
Note: See TracBrowser for help on using the repository browser.