| [613] | 1 | DVBAPRE ;ALB ISC/JLU-PREINIT ROUTINE ;02/02/91
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN S CNT=1
|
|---|
| 5 | D REMD
|
|---|
| 6 | D CORSPEL
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | REMD ;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
|
|---|
| 14 | REMD1 ;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 | ;
|
|---|
| 29 | REMC ;to remove the 'C' cross reference
|
|---|
| 30 | S VAR="Removing the 'C' cross reference from 396"
|
|---|
| 31 | D BUMP^DVBAPOST(VAR)
|
|---|
| 32 | W !!,VAR
|
|---|
| 33 | REMC1 ;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 | ;
|
|---|
| 49 | CORSPEL ;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
|
|---|
