source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2773.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1DVBA2773 ;SPH - PATCH DRIVER ; 9/21/05
2 ;;2.7;AMIE;**73**;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.
7EN ;
8 W !!!,"**** PRE-PROCESSING ****",!!
9 D DISABLE("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
10 Q
11POST ;
12 W !!!,"**** POST-PROCESSING ****",!!
13 D POSTP("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
14 D RBXREF
15 Q
16POSTP(NM) ;
17 ; Rename XXXXXXX~73F to XXXXXXX~95
18 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
19 N DVBABCN2,DVBABIE2,DVBABS2
20 S DVBABCNT=0,DVBABIEN=0
21 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
22 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
23 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)="73F" D
24 ..;Check and be sure a 95 version isn't in the file yet
25 ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
26 ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
27 ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
28 ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)="95" S DVBACH=1
29 ..;If 95 version is found, delete new 73F version and don't import
30 ..I DVBACH=1 D
31 ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
32 ...K ^DVB(396.18,DVBABIEN)
33 ..;If 95 version isn't found, go ahead and rename new 73F to 95
34 ..I DVBACH=0 D
35 ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~95"
36 ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
37 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
38 Q
39RBXREF ;
40 ; Rebuild cross-references
41 ; XRef: B
42 W !!,"REBUILDING 'B' XREF",!
43 N DA,DIK,REGIEN,ROOT
44 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
45 S REGIEN=0
46 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
47 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
48 . S DA(1)=REGIEN D ENALL^DIK
49 ;
50 ; XRef: AV
51 W !!,"REBUILDING 'AV' XREF",!
52 N DA,DIK,REGIEN,ROOT
53 S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
54 S REGIEN=0
55 F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
56 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
57 . S DA(1)=REGIEN D ENALL^DIK
58 K DA,DIK,REGIEN,ROOT
59 Q
60DISABLE(NM) ;
61 ; First look for matches and turn off the "selectable by user field"
62 ; This will keep the entry from showing in the list
63 ; Next, look at disabled date. If there's no date, set it to today.
64 ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
65 ; Ignore 73F entries
66 N DVBABCNT,DVBABIEN,DVBABST,DVBACH
67 S DVBABCNT=0,DVBABIEN=0
68 F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
69 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
70 .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'="95" D
71 ..S DVBACH=0
72 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
73 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
74 ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
75 K DVBABCNT,DVBABIEN,DVBABST,DVBACH
76 Q
Note: See TracBrowser for help on using the repository browser.