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