source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2815.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: 4.5 KB
RevLine 
[613]1DVBA2815 ;SPH - PATCH DRIVER ; 9/27/06
2 ;;2.7;AMIE;**115**;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="115F" ; What the version will be in the incoming file
10 S DVBVERSN="115" ; What the final version should be named
11 W !!!,"**** PRE-PROCESSING ****",!!
12 D DISABLE("ACROMEGALY")
13 D DISABLE("AMPUTATION")
14 D DISABLE("RESIDUALS OF AMPUTATIONS")
15 D DISABLE("COLD INJURY PROTOCOL EXAMINATION")
16 D DISABLE("CUSHINGS SYNDROME")
17 D DISABLE("DENTAL AND ORAL")
18 D DISABLE("ENDOCRINE, MISCELLANEOUS")
19 D DISABLE("MISCELLANEOUS ENDOCRINE DISEASES")
20 D DISABLE("HEMIC DISORDERS")
21 D DISABLE("LYMPHATIC DISORDERS")
22 D DISABLE("MOUTH, LIPS AND TONGUE")
23 D DISABLE("MUSCLES")
24 D DISABLE("PULMONARY TUBERCULOSIS AND MYCOBACTERIAL DISEASES")
25 D DISABLE("RESPIRATORY DISEASES, MISCELLANEOUS")
26 D DISABLE("SENSE OF SMELL AND TASTE")
27 D DISABLE("SOCIAL WORK AND INDUSTRIAL SURVEY")
28 D DISABLE("SOCIAL AND INDUSTRIAL SURVEY")
29 D DISABLE("SPINE")
30 D DISABLE("THYROID AND PARATHYROID DISEASES")
31 Q
32POST ;
33 N DVBVERSS,DVBVERSN
34 S DVBVERSS="115F" ; What the version will be in the incoming file
35 S DVBVERSN="115" ; What the final version should be named
36 W !!!,"**** POST-PROCESSING ****",!!
37 D POSTP("ACROMEGALY")
38 D POSTP("AMPUTATION")
39 D POSTP("COLD INJURY PROTOCOL EXAMINATION")
40 D POSTP("CUSHINGS SYNDROME")
41 D POSTP("DENTAL AND ORAL")
42 D POSTP("ENDOCRINE, MISCELLANEOUS")
43 D POSTP("HEMIC DISORDERS")
44 D POSTP("LYMPHATIC DISORDERS")
45 D POSTP("MOUTH, LIPS AND TONGUE")
46 D POSTP("MUSCLES")
47 D POSTP("PULMONARY TUBERCULOSIS AND MYCOBACTERIAL DISEASES")
48 D POSTP("RESPIRATORY DISEASES, MISCELLANEOUS")
49 D POSTP("SENSE OF SMELL AND TASTE")
50 D POSTP("SOCIAL AND INDUSTRIAL SURVEY")
51 D POSTP("SPINE")
52 D POSTP("THYROID AND PARATHYROID DISEASES")
53 D RBXREF
54 Q
55POSTP(NM) ;
56 ; Rename XXXXXXX~imported version to XXXXXXX~new version
57 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
58 N DVBABCN2,DVBABIE2,DVBABS2
59 S DVBABCNT=0,DVBABIEN=0
60 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
61 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
62 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
63 ..;Check and be sure the new version isn't in the file yet
64 ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
65 ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
66 ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
67 ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
68 ..;If new version is found, delete the import version and don't import
69 ..I DVBACH=1 D
70 ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
71 ...K ^DVB(396.18,DVBABIEN)
72 ..;If existing version isn't found, go ahead and rename imported entry to new version name
73 ..I DVBACH=0 D
74 ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
75 ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
76 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
77 Q
78RBXREF ;
79 ; Rebuild cross-references
80 ; XRef: B
81 W !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
82 W !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
83 N DA,DIK,REGIEN,ROOT
84 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
85 S REGIEN=0
86 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
87 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
88 . S DA(1)=REGIEN D ENALL^DIK
89 ;
90 ; XRef: AV
91 W !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
92 N DA,DIK,REGIEN,ROOT
93 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
94 S REGIEN=0
95 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
96 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
97 . S DA(1)=REGIEN D ENALL^DIK
98 K DA,DIK,REGIEN,ROOT
99 Q
100DISABLE(NM) ;
101 ; First look for matches and turn off the "selectable by user field"
102 ; This will keep the entry from showing in the list
103 ; Next, look at disabled date. If there's no date, set it to today.
104 ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
105 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
106 S DVBABCNT=0,DVBABIEN=0
107 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
108 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
109 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
110 ..S DVBACH=0
111 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
112 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
113 ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
114 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
115 Q
Note: See TracBrowser for help on using the repository browser.