source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAPRE.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1DVBAPRE ;ALB ISC/JLU-PREINIT ROUTINE ;02/02/91
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4EN S CNT=1
5 D REMD
6 D CORSPEL
7 Q
8 ;
9REMD ;this entry point is to remove the 'D' cross reference in file 396.3
10 D BUMPBLK^DVBAPOST,BUMPBLK^DVBAPOST,BUMPBLK^DVBAPOST
11 S VAR="Removing the 'D' cross reference from file 396.3"
12 D BUMP^DVBAPOST(VAR)
13 W !,VAR
14REMD1 ;gets you around the displays
15 N JL
16 S JL=0
17 F S JL=$O(^DD(396.3,17,1,JL)) Q:'JL I $D(^(JL,0)),^(0)="396.3^D^MUMPS" DO Q
18 .S DIK="^DD(396.3,17,1,",DA(2)=396.3,DA(1)=17,DA=JL
19 .D ^DIK
20 .K ^DVB(396.3,"D")
21 .S VAR="Cross reference and data for 'D' in 396.3 deleted!"
22 .D BUMP^DVBAPOST(VAR)
23 .D BUMPBLK^DVBAPOST
24 .D BUMPBLK^DVBAPOST
25 .W !,VAR
26 .K DIK,DA
27 .Q
28 ;
29REMC ;to remove the 'C' cross reference
30 S VAR="Removing the 'C' cross reference from 396"
31 D BUMP^DVBAPOST(VAR)
32 W !!,VAR
33REMC1 ;around the displays
34 N JL
35 S JL=0
36 F S JL=$O(^DD(396,6.82,1,JL)) Q:'JL I $D(^(JL,0)),^(0)="396^C^MUMPS" DO Q
37 .S DIK="^DD(396,6.82,1,",DA(2)=396,DA(1)=6.82,DA=JL
38 .D ^DIK
39 .K ^DVB(396,"C")
40 .S VAR="Cross reference and data for 'C' in 396 deleted!"
41 .D BUMP^DVBAPOST(VAR)
42 .W !,VAR
43 .K DI,DA
44 .Q
45 D BUMPBLK^DVBAPOST
46 D BUMPBLK^DVBAPOST
47 Q
48 ;
49CORSPEL ;this subroutine is to correct the spelling of an entry in 396.6
50 ;It should be removed for future versions of AMIE.
51 ;
52 N DVBAPRE
53 S DVBAPRE=$O(^DVB(396.6,"B","EPILEPESY AND NARCOLEPSY",""))
54 I DVBAPRE DO
55 .S DIE="^DVB(396.6,",DA=DVBAPRE,DR=".01///EPILEPSY AND NARCOLEPSY"
56 .D ^DIE
57 .K DIE,DA,DR
58 .S VAR="Renaming of ""EPILEPESY AND NARCOLEPSY"" to ""EPILEPSY AND NARCOLEPSY"" is complete!"
59 .D BUMPBLK^DVBAPOST
60 .D BUMPBLK^DVBAPOST
61 .W !!,VAR,!!
62 .D BUMP^DVBAPOST(VAR)
63 .D BUMPBLK^DVBAPOST
64 .D BUMPBLK^DVBAPOST
65 .K VAR
66 .Q
67 Q
Note: See TracBrowser for help on using the repository browser.