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

DVB430PT.m

Go to the documentation of this file.
  1. DVB430PT ;ALB/JAD POST-INSTALL FOR PATCH DVB*4*30 ; 12/29/97
  1. ;;4.0;HINQ;**30**;03/25/92
  1. ;
  1. ;This routine will be run as a post-installation for patch DVB*4*30.
  1. ;This routine will add new disability codes to and modify existing
  1. ;names/descriptions in the DISABILITY CONDITION file (#31).
  1. ;
  1. POST ;entry point for post-install, setting up checkpoints
  1. N %
  1. S %=$$NEWCP^XPDUTL("DVBLINE","EN^DVB430PT",1)
  1. Q
  1. ;
  1. EN ;begin processing
  1. ;
  1. N DVBLINE
  1. ;
  1. D BMES^XPDUTL(" >> *** Updating DISABILITY CONDITION file (#31)")
  1. D MES^XPDUTL(" ")
  1. ;
  1. ;get value from checkpoints, previous run
  1. S DVBLINE=+$$PARCP^XPDUTL("DVBLINE")
  1. ;
  1. DVBNEW ;add new codes or modify name
  1. ;
  1. F DVBI=DVBLINE:1 S DVBJ=$P($T(NEWCODE+DVBI),";;",2) Q:DVBJ["$EXIT" D
  1. .S DVBCODE=+DVBJ,DVBNAME=$E($P(DVBJ,"^",2),1,45),DVBLINE=DVBI
  1. .S DVBDESC=$E($P(DVBJ,"^",3),1,200)
  1. .;
  1. .;add new code
  1. .I '$D(^DIC(31,"C",DVBCODE)) D G UPDATECH
  1. ..K DD,DO
  1. ..S DIC="^DIC(31,",DIC(0)="L",DIC("DR")="2////"_DVBCODE_";10////"_DVBDESC
  1. ..S X=DVBNAME,DLAYGO=31
  1. ..D FILE^DICN
  1. ..D MES^XPDUTL(DVBCODE_": adding "_DVBCODE_" "_X)
  1. ..K DLAYGO,DIC,X
  1. ..Q
  1. .;
  1. .;modify name
  1. .S DVBIEN=+$O(^DIC(31,"C",DVBCODE,0))
  1. .S DVBREC=$G(^DIC(31,DVBIEN,0)),DVBOLDSC=$G(^DIC(31,DVBIEN,1)) I DVBREC']"" D G UPDATECH
  1. ..D MES^XPDUTL(" >>>> error "_DVBCODE_" in C x-reference and not in file 31")
  1. ..Q
  1. .S DVBOLDN=$P(DVBREC,"^") I DVBOLDN=DVBNAME&(DVBOLDSC=DVBDESC) G UPDATECH
  1. .S DA=DVBIEN,DIE="^DIC(31,",DR=".01////"_DVBNAME_";10////"_DVBDESC
  1. .D ^DIE
  1. .K DR,DA,DIE
  1. .I DVBOLDN'=DVBNAME D
  1. ..D MES^XPDUTL(DVBCODE_": changing name from "_DVBOLDN)
  1. ..D MES^XPDUTL(" to "_DVBNAME)
  1. .I DVBOLDSC'=DVBDESC D
  1. ..D MES^XPDUTL(DVBCODE_": changing description...")
  1. ..D MES^XPDUTL(" from: "_DVBOLDSC)
  1. ..D MES^XPDUTL(" to: "_DVBDESC)
  1. .;
  1. UPDATECH .;update checkpoint
  1. .S %=$$UPCP^XPDUTL("DVBLINE",DVBLINE)
  1. .Q
  1. K DVBCODE,DVBI,DVBIEN,DVBJ,DVBNAME,DVBOLDN,DVBREC,DVBDESC,DVBOLDSC
  1. Q
  1. ;
  1. NEWCODE ; codes to be added or changed
  1. ;;7000^VALVULAR HEART DISEASE^VALVULAR HEART DISEASE (INCLUDING RHEUMATIC HEART DISEASE)
  1. ;;7002^PERICARDITIS^PERICARDITIS, BACTERIAL OR RHEUMATIC
  1. ;;7004^HEART DISEASE, SY.^SYPHILITIC HEART DISEASE
  1. ;;7005^ARTERIOSCLEROTIC HEART DISEASE^ARTERIOSCLEROTIC HEART DISEASE (CORONARY ARTERY DISEASE)
  1. ;;7006^MYOCARDIAL INFARCTION^MYOCARDIUM, INFARCTION OF
  1. ;;7010^SUPRAVENTRICULAR ARRHYTHMIAS^SUPRAVENTRICULAR ARRHYTHMIAS - PAROXYSMAL ATRIAL FIBRILLATION OR OTHER SUPRAVENTRICULAR TACHYCARDIA
  1. ;;7011^VENTRICULAR ARRHYTHMIAS (SUSTAINED)^SUSTAINED VENTRICULAR ARRHYTHMIAS
  1. ;;7012^ATRIAL FIBRILLATION^ATRIAL FIBRILLATION, PERMANENT
  1. ;;7013^TACHYCARDIC HEART CONDITION^TACHYCARDIA, PAROXYSMAL
  1. ;;7015^ATRIOVENTRICULAR BLOCK^ATRIOVENTRICULAR BLOCK
  1. ;;7016^HEART VALVE REPLACEMENT^HEART VALVE REPLACEMENT (PROSTHESIS)
  1. ;;7017^CORONARY ARTERY BYPASS^CORONARY ARTERY BYPASS SURGERY
  1. ;;7018^CARDIAC PACEMAKER^IMPLANTABLE CARDIAC PACEMAKER
  1. ;;7019^CARDIAC TRANSPLANT^CARDIAC TRANSPLANTATION
  1. ;;7020^CARDIOMYOPATHY^CARDIOMYOPATHY
  1. ;;7101^HYPERTENSIVE VASCULAR DISEASE^HYPERTENSIVE VASCULAR DISEASE (HYPERTENSION AND ISOLATED SYSTOLIC HYPERTENSION)
  1. ;;7110^AORTIC ANEURYSM^ANEURYSM, AORTIC, FUSIFORM, SACULAR, DISSECTION AND/OR WITH STENOSIS
  1. ;;7111^ANEURYSM, ANY LARGE ARTERY^ANEURYSM OF ANY LARGE ARTERY
  1. ;;7112^ANEURYSM, ANY SMALL ARTERY^ANEURYSM OF ANY SMALL ARTERY
  1. ;;7113^ARTERIOVENOUS FISTULA, TRAUMATIC^ARTERIOVENOUS FISTULA (ANEURYSM), TRAUMATIC
  1. ;;7114^ARTERIOSCLEROSIS^ARTERIOSCLEROSIS OBLITERANS
  1. ;;7115^BUERGER'S DISEASE^THROMBOANGIITIS OBLITERANS (BUERGER'S DISEASE)
  1. ;;7116^CLAUDICATION^CLAUDICATION, INTERMITTENT
  1. ;;7117^REYNAUD'S SYNDROME^REYNAUD'S SYNDROME
  1. ;;7118^ANGIONEUROTIC EDEMA^ANGIONEUROTIC EDEMA
  1. ;;7119^ERYTHROMELALGIA^ERYTHROMELALGIA
  1. ;;7121^POST-PHLEBITIC SYNDROME^POST-PHLEBITIC SYNDROME OF ANY ETIOLOGY
  1. ;;7122^COLD INJURY RESIDUALS^RESIDUAL SYMPTOMS (PAIN, ARTHRALGIA, ETC.) OF COLD INJURY
  1. ;;$EXIT
  1. Q