Routine: DVB428PT

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)

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVB428PT   4153     printed  Apr 23, 2025@18:11:58                                                                                                                                                                                                    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

DVB428PT.m