Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBAPRE

DVBAPRE.m

Go to the documentation of this file.
  1. DVBAPRE ;ALB ISC/JLU-PREINIT ROUTINE ;02/02/91
  1. ;;2.7;AMIE;;Apr 10, 1995
  1. ;
  1. EN S CNT=1
  1. D REMD
  1. D CORSPEL
  1. Q
  1. ;
  1. REMD ;this entry point is to remove the 'D' cross reference in file 396.3
  1. D BUMPBLK^DVBAPOST,BUMPBLK^DVBAPOST,BUMPBLK^DVBAPOST
  1. S VAR="Removing the 'D' cross reference from file 396.3"
  1. D BUMP^DVBAPOST(VAR)
  1. W !,VAR
  1. REMD1 ;gets you around the displays
  1. N JL
  1. S JL=0
  1. F S JL=$O(^DD(396.3,17,1,JL)) Q:'JL I $D(^(JL,0)),^(0)="396.3^D^MUMPS" DO Q
  1. .S DIK="^DD(396.3,17,1,",DA(2)=396.3,DA(1)=17,DA=JL
  1. .D ^DIK
  1. .K ^DVB(396.3,"D")
  1. .S VAR="Cross reference and data for 'D' in 396.3 deleted!"
  1. .D BUMP^DVBAPOST(VAR)
  1. .D BUMPBLK^DVBAPOST
  1. .D BUMPBLK^DVBAPOST
  1. .W !,VAR
  1. .K DIK,DA
  1. .Q
  1. ;
  1. REMC ;to remove the 'C' cross reference
  1. S VAR="Removing the 'C' cross reference from 396"
  1. D BUMP^DVBAPOST(VAR)
  1. W !!,VAR
  1. REMC1 ;around the displays
  1. N JL
  1. S JL=0
  1. F S JL=$O(^DD(396,6.82,1,JL)) Q:'JL I $D(^(JL,0)),^(0)="396^C^MUMPS" DO Q
  1. .S DIK="^DD(396,6.82,1,",DA(2)=396,DA(1)=6.82,DA=JL
  1. .D ^DIK
  1. .K ^DVB(396,"C")
  1. .S VAR="Cross reference and data for 'C' in 396 deleted!"
  1. .D BUMP^DVBAPOST(VAR)
  1. .W !,VAR
  1. .K DI,DA
  1. .Q
  1. D BUMPBLK^DVBAPOST
  1. D BUMPBLK^DVBAPOST
  1. Q
  1. ;
  1. CORSPEL ;this subroutine is to correct the spelling of an entry in 396.6
  1. ;It should be removed for future versions of AMIE.
  1. ;
  1. N DVBAPRE
  1. S DVBAPRE=$O(^DVB(396.6,"B","EPILEPESY AND NARCOLEPSY",""))
  1. I DVBAPRE DO
  1. .S DIE="^DVB(396.6,",DA=DVBAPRE,DR=".01///EPILEPSY AND NARCOLEPSY"
  1. .D ^DIE
  1. .K DIE,DA,DR
  1. .S VAR="Renaming of ""EPILEPESY AND NARCOLEPSY"" to ""EPILEPSY AND NARCOLEPSY"" is complete!"
  1. .D BUMPBLK^DVBAPOST
  1. .D BUMPBLK^DVBAPOST
  1. .W !!,VAR,!!
  1. .D BUMP^DVBAPOST(VAR)
  1. .D BUMPBLK^DVBAPOST
  1. .D BUMPBLK^DVBAPOST
  1. .K VAR
  1. .Q
  1. Q