DVBAPRE ;ALB ISC/JLU-PREINIT ROUTINE ;02/02/91
;;2.7;AMIE;;Apr 10, 1995
;
EN S CNT=1
D REMD
D CORSPEL
Q
;
REMD ;this entry point is to remove the 'D' cross reference in file 396.3
D BUMPBLK^DVBAPOST,BUMPBLK^DVBAPOST,BUMPBLK^DVBAPOST
S VAR="Removing the 'D' cross reference from file 396.3"
D BUMP^DVBAPOST(VAR)
W !,VAR
REMD1 ;gets you around the displays
N JL
S JL=0
F S JL=$O(^DD(396.3,17,1,JL)) Q:'JL I $D(^(JL,0)),^(0)="396.3^D^MUMPS" DO Q
.S DIK="^DD(396.3,17,1,",DA(2)=396.3,DA(1)=17,DA=JL
.D ^DIK
.K ^DVB(396.3,"D")
.S VAR="Cross reference and data for 'D' in 396.3 deleted!"
.D BUMP^DVBAPOST(VAR)
.D BUMPBLK^DVBAPOST
.D BUMPBLK^DVBAPOST
.W !,VAR
.K DIK,DA
.Q
;
REMC ;to remove the 'C' cross reference
S VAR="Removing the 'C' cross reference from 396"
D BUMP^DVBAPOST(VAR)
W !!,VAR
REMC1 ;around the displays
N JL
S JL=0
F S JL=$O(^DD(396,6.82,1,JL)) Q:'JL I $D(^(JL,0)),^(0)="396^C^MUMPS" DO Q
.S DIK="^DD(396,6.82,1,",DA(2)=396,DA(1)=6.82,DA=JL
.D ^DIK
.K ^DVB(396,"C")
.S VAR="Cross reference and data for 'C' in 396 deleted!"
.D BUMP^DVBAPOST(VAR)
.W !,VAR
.K DI,DA
.Q
D BUMPBLK^DVBAPOST
D BUMPBLK^DVBAPOST
Q
;
CORSPEL ;this subroutine is to correct the spelling of an entry in 396.6
;It should be removed for future versions of AMIE.
;
N DVBAPRE
S DVBAPRE=$O(^DVB(396.6,"B","EPILEPESY AND NARCOLEPSY",""))
I DVBAPRE DO
.S DIE="^DVB(396.6,",DA=DVBAPRE,DR=".01///EPILEPSY AND NARCOLEPSY"
.D ^DIE
.K DIE,DA,DR
.S VAR="Renaming of ""EPILEPESY AND NARCOLEPSY"" to ""EPILEPSY AND NARCOLEPSY"" is complete!"
.D BUMPBLK^DVBAPOST
.D BUMPBLK^DVBAPOST
.W !!,VAR,!!
.D BUMP^DVBAPOST(VAR)
.D BUMPBLK^DVBAPOST
.D BUMPBLK^DVBAPOST
.K VAR
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAPRE 1772 printed Dec 13, 2024@01:41:51 Page 2
DVBAPRE ;ALB ISC/JLU-PREINIT ROUTINE ;02/02/91
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
EN SET CNT=1
+1 DO REMD
+2 DO CORSPEL
+3 QUIT
+4 ;
REMD ;this entry point is to remove the 'D' cross reference in file 396.3
+1 DO BUMPBLK^DVBAPOST
DO BUMPBLK^DVBAPOST
DO BUMPBLK^DVBAPOST
+2 SET VAR="Removing the 'D' cross reference from file 396.3"
+3 DO BUMP^DVBAPOST(VAR)
+4 WRITE !,VAR
REMD1 ;gets you around the displays
+1 NEW JL
+2 SET JL=0
+3 FOR
SET JL=$ORDER(^DD(396.3,17,1,JL))
if 'JL
QUIT
IF $DATA(^(JL,0))
IF ^(0)="396.3^D^MUMPS"
Begin DoDot:1
+4 SET DIK="^DD(396.3,17,1,"
SET DA(2)=396.3
SET DA(1)=17
SET DA=JL
+5 DO ^DIK
+6 KILL ^DVB(396.3,"D")
+7 SET VAR="Cross reference and data for 'D' in 396.3 deleted!"
+8 DO BUMP^DVBAPOST(VAR)
+9 DO BUMPBLK^DVBAPOST
+10 DO BUMPBLK^DVBAPOST
+11 WRITE !,VAR
+12 KILL DIK,DA
+13 QUIT
End DoDot:1
QUIT
+14 ;
REMC ;to remove the 'C' cross reference
+1 SET VAR="Removing the 'C' cross reference from 396"
+2 DO BUMP^DVBAPOST(VAR)
+3 WRITE !!,VAR
REMC1 ;around the displays
+1 NEW JL
+2 SET JL=0
+3 FOR
SET JL=$ORDER(^DD(396,6.82,1,JL))
if 'JL
QUIT
IF $DATA(^(JL,0))
IF ^(0)="396^C^MUMPS"
Begin DoDot:1
+4 SET DIK="^DD(396,6.82,1,"
SET DA(2)=396
SET DA(1)=6.82
SET DA=JL
+5 DO ^DIK
+6 KILL ^DVB(396,"C")
+7 SET VAR="Cross reference and data for 'C' in 396 deleted!"
+8 DO BUMP^DVBAPOST(VAR)
+9 WRITE !,VAR
+10 KILL DI,DA
+11 QUIT
End DoDot:1
QUIT
+12 DO BUMPBLK^DVBAPOST
+13 DO BUMPBLK^DVBAPOST
+14 QUIT
+15 ;
CORSPEL ;this subroutine is to correct the spelling of an entry in 396.6
+1 ;It should be removed for future versions of AMIE.
+2 ;
+3 NEW DVBAPRE
+4 SET DVBAPRE=$ORDER(^DVB(396.6,"B","EPILEPESY AND NARCOLEPSY",""))
+5 IF DVBAPRE
Begin DoDot:1
+6 SET DIE="^DVB(396.6,"
SET DA=DVBAPRE
SET DR=".01///EPILEPSY AND NARCOLEPSY"
+7 DO ^DIE
+8 KILL DIE,DA,DR
+9 SET VAR="Renaming of ""EPILEPESY AND NARCOLEPSY"" to ""EPILEPSY AND NARCOLEPSY"" is complete!"
+10 DO BUMPBLK^DVBAPOST
+11 DO BUMPBLK^DVBAPOST
+12 WRITE !!,VAR,!!
+13 DO BUMP^DVBAPOST(VAR)
+14 DO BUMPBLK^DVBAPOST
+15 DO BUMPBLK^DVBAPOST
+16 KILL VAR
+17 QUIT
End DoDot:1
+18 QUIT
