DVB428PT ;ALB/SEK POST-INSTALL FOR PATCH DVB*4*28 ; 9/24/96
;;V4.0;HINQ;**28**;03/25/92
;
;This routine will be run as a post-installation for patch DVB*4*28.
;This routine will add new disability codes to and modify existing
;names in the DISABILITY CONDITION file (#31).
;
POST ;entry point for post-install, setting up checkpoints
N %
S %=$$NEWCP^XPDUTL("DVBLINE","EN^DVB428PT",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
.;
.;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
..S X=DVBNAME,DLAYGO=31
..D FILE^DICN
..D MES^XPDUTL(" >> 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)) 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 G UPDATECH
.S DA=DVBIEN,DIE="^DIC(31,",DR=".01////"_DVBNAME D ^DIE
.K DR,DA,DIE
.D MES^XPDUTL(" >> changing name of "_DVBCODE_" from "_DVBOLDN)
.D MES^XPDUTL(" to "_DVBNAME)
.;
UPDATECH .;update checkpoint
.S %=$$UPCP^XPDUTL("DVBLINE",DVBLINE)
.Q
K DVBCODE,DVBI,DVBIEN,DVBJ,DVBNAME,DVBOLDN,DVBREC
Q
;
NEWCODE ; codes to be addded
;;5025^FIBROMYALGIA
;;6319^LYME DISEASE
;;6320^PARASITIC DISEASES OTHERWISE NOT SPECIFIED
;;6502^SEPTUM, NASAL, DEVIATION OF
;;6518^LARYNGECTOMY
;;6519^APHONIA
;;6520^LARYNX, STENOSIS OF
;;6521^PHARYNX, INJURIES TO
;;6522^ALLERGIC OR VASOMOTOR RHINITIS
;;6523^BACTERIAL RHINITIS
;;6524^GRANULOMATOUS RHINITIS
;;6604^CHRONIC OBSTRUCTIVE PULMONARY DISEASE
;;6817^PULMONARY VASCULAR DISEASE
;;6819^NEOPLASMS, MALIGNANT, RESPIRATORY SYSTEM
;;6820^NEOPLASMS, BENIGN, RESPIRATORY SYSTEM
;;6822^ACTINOMYCOSIS
;;6823^NOCARDIOSIS
;;6824^CHRONIC LUNG ABSCESS
;;6825^DIFFUSE INTERSTITIAL FIBROSIS
;;6826^DESQUAMATIVE INTERSTITIAL PNEUMONITIS
;;6827^PULMONARY ALVEOLAR PROTEINOSIS
;;6828^EOSINOPHILIC GRANULOMA OF LUNG
;;6829^DRUG-INDUCED PNEUMONITIS/FIBROSIS
;;6830^RADIATION-INDUCED PNEUMONITIS/FIBROSIS
;;6831^HYPERSENSITIVITY PNEUMONITIS
;;6832^PNEUMOCONIOSIS
;;6833^ASBESTOSIS
;;6834^HISTOPLASMOSIS OF LUNG
;;6835^COCCIDIOIDOMYCOSIS
;;6836^BLASTOMYCOSIS
;;6837^CRYPTOCOCCOSIS
;;6838^ASPERGILLOSIS
;;6839^MUCORMYCOSIS
;;6840^DIAPHRAGM PARALYSIS OR PARESIS
;;6841^SPINAL CORD INJURY/RESPIRATORY INSUFFICIENCY
;;6842^KYPHOSCOLIOSIS
;;6843^TRAUMATIC CHEST WALL DEFECT
;;6844^POST-SURGICAL/RESPIRATORY SYSTEM
;;6845^CHRONIC PLEURAL EFFUSION OR FIBROSIS
;;6846^SARCOIDOSIS
;;6847^SLEEP APNEA SYNDROMES
;;7916^HYPERPITUITARISM
;;7917^HYPERALDOSTERONISM
;;7918^PHEOCHROMOCYTOMA
;;7919^C-CELL HYPERPLASIA OF THE THYROID
;;6504^NOSE,LOSS OF PART OF,OR SCARS
;;6510^SINUSITIS,PANSINUSITIS,CHRONIC
;;6511^SINUSITIS,ETHMOID,CHRONIC
;;6512^SINUSITIS,FRONTAL,CHRONIC
;;6513^SINUSITIS,MAXILLARY,CHRONIC
;;6514^SINUSITIS,SPHENOID,CHRONIC
;;6515^LARYNGITIS,TUBERCULOUS,ACTIVE OR INACTIVE
;;6516^LARYNGITIS,CHRONIC
;;6600^BRONCHITIS,CHRONIC
;;6602^ASTHMA,BRONCHIAL
;;6603^EMPHYSEMA,PULMONARY
;;6701^TUBERCULOSIS,PULM.,CHRONIC,FAR ADV,ACTIVE
;;6702^TUBERCULOSIS,PULM.,CHRONIC,MOD.ADV,ACTIVE
;;6703^TUBERCULOSIS,PULM.,CHRONIC,MINIMAL,ACTIVE
;;6704^TUBERCULOSIS,PULM.,CHRONIC,ACT.,ADV UNSP
;;6721^TUBERCULOSIS,PULM.,CHRONIC,FAR ADV,INACTIVE
;;6722^TUBERCULOSIS,PULM.,CHRONIC,MOD.ADV,INACTIVE
;;6723^TUBERCULOSIS,PULM.,CHRONIC,MINIMAL,INACTIVE
;;6724^TUBERCULOSIS,PULM.,CHRONIC,INACT.,ADV UNSP
;;6730^TUBERCULOSIS,PULMONARY,CHRONIC,ACTIVE
;;6731^TUBERCULOSIS,PULMONARY,CHRONIC,INACTIVE
;;6732^PLEURISY,TUBERCULOUS,ACTIVE OR INACTIVE
;;$EXIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVB428PT 4153 printed Dec 13, 2024@01:57:31 Page 2
DVB428PT ;ALB/SEK POST-INSTALL FOR PATCH DVB*4*28 ; 9/24/96
+1 ;;V4.0;HINQ;**28**;03/25/92
+2 ;
+3 ;This routine will be run as a post-installation for patch DVB*4*28.
+4 ;This routine will add new disability codes to and modify existing
+5 ;names in the DISABILITY CONDITION file (#31).
+6 ;
POST ;entry point for post-install, setting up checkpoints
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("DVBLINE","EN^DVB428PT",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 ;
+5 ;add new code
+6 IF '$DATA(^DIC(31,"C",DVBCODE))
Begin DoDot:2
+7 KILL DD,DO
+8 SET DIC="^DIC(31,"
SET DIC(0)="L"
SET DIC("DR")="2////"_DVBCODE
+9 SET X=DVBNAME
SET DLAYGO=31
+10 DO FILE^DICN
+11 DO MES^XPDUTL(" >> adding "_DVBCODE_" "_X)
+12 KILL DLAYGO,DIC,X
+13 QUIT
End DoDot:2
GOTO UPDATECH
+14 ;
+15 ;modify name
+16 SET DVBIEN=+$ORDER(^DIC(31,"C",DVBCODE,0))
+17 SET DVBREC=$GET(^DIC(31,DVBIEN,0))
IF DVBREC']""
Begin DoDot:2
+18 DO MES^XPDUTL(" >>>> error "_DVBCODE_" in C x-reference and not in file 31")
+19 QUIT
End DoDot:2
GOTO UPDATECH
+20 SET DVBOLDN=$PIECE(DVBREC,"^")
IF DVBOLDN=DVBNAME
GOTO UPDATECH
+21 SET DA=DVBIEN
SET DIE="^DIC(31,"
SET DR=".01////"_DVBNAME
DO ^DIE
+22 KILL DR,DA,DIE
+23 DO MES^XPDUTL(" >> changing name of "_DVBCODE_" from "_DVBOLDN)
+24 DO MES^XPDUTL(" to "_DVBNAME)
+25 ;
UPDATECH ;update checkpoint
+1 SET %=$$UPCP^XPDUTL("DVBLINE",DVBLINE)
+2 QUIT
End DoDot:1
+3 KILL DVBCODE,DVBI,DVBIEN,DVBJ,DVBNAME,DVBOLDN,DVBREC
+4 QUIT
+5 ;
NEWCODE ; codes to be addded
+1 ;;5025^FIBROMYALGIA
+2 ;;6319^LYME DISEASE
+3 ;;6320^PARASITIC DISEASES OTHERWISE NOT SPECIFIED
+4 ;;6502^SEPTUM, NASAL, DEVIATION OF
+5 ;;6518^LARYNGECTOMY
+6 ;;6519^APHONIA
+7 ;;6520^LARYNX, STENOSIS OF
+8 ;;6521^PHARYNX, INJURIES TO
+9 ;;6522^ALLERGIC OR VASOMOTOR RHINITIS
+10 ;;6523^BACTERIAL RHINITIS
+11 ;;6524^GRANULOMATOUS RHINITIS
+12 ;;6604^CHRONIC OBSTRUCTIVE PULMONARY DISEASE
+13 ;;6817^PULMONARY VASCULAR DISEASE
+14 ;;6819^NEOPLASMS, MALIGNANT, RESPIRATORY SYSTEM
+15 ;;6820^NEOPLASMS, BENIGN, RESPIRATORY SYSTEM
+16 ;;6822^ACTINOMYCOSIS
+17 ;;6823^NOCARDIOSIS
+18 ;;6824^CHRONIC LUNG ABSCESS
+19 ;;6825^DIFFUSE INTERSTITIAL FIBROSIS
+20 ;;6826^DESQUAMATIVE INTERSTITIAL PNEUMONITIS
+21 ;;6827^PULMONARY ALVEOLAR PROTEINOSIS
+22 ;;6828^EOSINOPHILIC GRANULOMA OF LUNG
+23 ;;6829^DRUG-INDUCED PNEUMONITIS/FIBROSIS
+24 ;;6830^RADIATION-INDUCED PNEUMONITIS/FIBROSIS
+25 ;;6831^HYPERSENSITIVITY PNEUMONITIS
+26 ;;6832^PNEUMOCONIOSIS
+27 ;;6833^ASBESTOSIS
+28 ;;6834^HISTOPLASMOSIS OF LUNG
+29 ;;6835^COCCIDIOIDOMYCOSIS
+30 ;;6836^BLASTOMYCOSIS
+31 ;;6837^CRYPTOCOCCOSIS
+32 ;;6838^ASPERGILLOSIS
+33 ;;6839^MUCORMYCOSIS
+34 ;;6840^DIAPHRAGM PARALYSIS OR PARESIS
+35 ;;6841^SPINAL CORD INJURY/RESPIRATORY INSUFFICIENCY
+36 ;;6842^KYPHOSCOLIOSIS
+37 ;;6843^TRAUMATIC CHEST WALL DEFECT
+38 ;;6844^POST-SURGICAL/RESPIRATORY SYSTEM
+39 ;;6845^CHRONIC PLEURAL EFFUSION OR FIBROSIS
+40 ;;6846^SARCOIDOSIS
+41 ;;6847^SLEEP APNEA SYNDROMES
+42 ;;7916^HYPERPITUITARISM
+43 ;;7917^HYPERALDOSTERONISM
+44 ;;7918^PHEOCHROMOCYTOMA
+45 ;;7919^C-CELL HYPERPLASIA OF THE THYROID
+46 ;;6504^NOSE,LOSS OF PART OF,OR SCARS
+47 ;;6510^SINUSITIS,PANSINUSITIS,CHRONIC
+48 ;;6511^SINUSITIS,ETHMOID,CHRONIC
+49 ;;6512^SINUSITIS,FRONTAL,CHRONIC
+50 ;;6513^SINUSITIS,MAXILLARY,CHRONIC
+51 ;;6514^SINUSITIS,SPHENOID,CHRONIC
+52 ;;6515^LARYNGITIS,TUBERCULOUS,ACTIVE OR INACTIVE
+53 ;;6516^LARYNGITIS,CHRONIC
+54 ;;6600^BRONCHITIS,CHRONIC
+55 ;;6602^ASTHMA,BRONCHIAL
+56 ;;6603^EMPHYSEMA,PULMONARY
+57 ;;6701^TUBERCULOSIS,PULM.,CHRONIC,FAR ADV,ACTIVE
+58 ;;6702^TUBERCULOSIS,PULM.,CHRONIC,MOD.ADV,ACTIVE
+59 ;;6703^TUBERCULOSIS,PULM.,CHRONIC,MINIMAL,ACTIVE
+60 ;;6704^TUBERCULOSIS,PULM.,CHRONIC,ACT.,ADV UNSP
+61 ;;6721^TUBERCULOSIS,PULM.,CHRONIC,FAR ADV,INACTIVE
+62 ;;6722^TUBERCULOSIS,PULM.,CHRONIC,MOD.ADV,INACTIVE
+63 ;;6723^TUBERCULOSIS,PULM.,CHRONIC,MINIMAL,INACTIVE
+64 ;;6724^TUBERCULOSIS,PULM.,CHRONIC,INACT.,ADV UNSP
+65 ;;6730^TUBERCULOSIS,PULMONARY,CHRONIC,ACTIVE
+66 ;;6731^TUBERCULOSIS,PULMONARY,CHRONIC,INACTIVE
+67 ;;6732^PLEURISY,TUBERCULOUS,ACTIVE OR INACTIVE
+68 ;;$EXIT
+69 QUIT
