- 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 Feb 18, 2025@23:23:55 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