source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2811.m@ 1710

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DVBA2811 ;SPH - PATCH DRIVER ; 5/19/06
2 ;;2.7;AMIE;**111**;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="111F" ; What the version will be in the incoming file
10 S DVBVERSN="111" ; What the final version should be named
11 W !!!,"**** PRE-PROCESSING ****",!!
12 D DISABLE("EPILEPSY AND NARCOLEPSY")
13 D DISABLE("ESOPHAGUS AND HIATAL HERNIA")
14 D DISABLE("FEET")
15 D DISABLE("HAND, THUMB, AND FINGERS")
16 D DISABLE("MUSCLES")
17 D DISABLE("SKIN DISEASES (OTHER THAN SCARS)")
18 D DISABLE("SPINE")
19 D DISABLE("GENERAL MEDICAL EXAMINATION")
20 Q
21POST ;
22 N DVBVERSS,DVBVERSN
23 S DVBVERSS="111F" ; What the version will be in the incoming file
24 S DVBVERSN="111" ; What the final version should be named
25 W !!!,"**** POST-PROCESSING ****",!!
26 D POSTP("EPILEPSY AND NARCOLEPSY")
27 D POSTP("ESOPHAGUS AND HIATAL HERNIA")
28 D POSTP("FEET")
29 D POSTP("HAND, THUMB, AND FINGERS")
30 D POSTP("MUSCLES")
31 D POSTP("SKIN DISEASES (OTHER THAN SCARS)")
32 D POSTP("SPINE")
33 D POSTP("GENERAL MEDICAL EXAMINATION")
34 D RBXREF
35 Q
36POSTP(NM) ;
37 ; Rename XXXXXXX~imported version to XXXXXXX~new version
38 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
39 N DVBABCN2,DVBABIE2,DVBABS2
40 S DVBABCNT=0,DVBABIEN=0
41 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
42 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
43 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
44 ..;Check and be sure the new version isn't in the file yet
45 ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
46 ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
47 ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
48 ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
49 ..;If new version is found, delete the import version and don't import
50 ..I DVBACH=1 D
51 ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
52 ...K ^DVB(396.18,DVBABIEN)
53 ..;If existing version isn't found, go ahead and rename imported entry to new version name
54 ..I DVBACH=0 D
55 ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
56 ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
57 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
58 Q
59RBXREF ;
60 ; Rebuild cross-references
61 ; XRef: B
62 W !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
63 W !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
64 N DA,DIK,REGIEN,ROOT
65 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
66 S REGIEN=0
67 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
68 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
69 . S DA(1)=REGIEN D ENALL^DIK
70 ;
71 ; XRef: AV
72 W !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
73 N DA,DIK,REGIEN,ROOT
74 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
75 S REGIEN=0
76 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
77 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
78 . S DA(1)=REGIEN D ENALL^DIK
79 K DA,DIK,REGIEN,ROOT
80 Q
81DISABLE(NM) ;
82 ; First look for matches and turn off the "selectable by user field"
83 ; This will keep the entry from showing in the list
84 ; Next, look at disabled date. If there's no date, set it to today.
85 ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
86 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
87 S DVBABCNT=0,DVBABIEN=0
88 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
89 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
90 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
91 ..S DVBACH=0
92 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
93 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
94 ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
95 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
96 Q
Note: See TracBrowser for help on using the repository browser.