- DVBYPGD ;ALB/ABR - UPDATE DISABILITY CONDITION FILE ; APR 4 1995
- ;;V4.0;HINQ;**24**;03/25/92
- ;
- EN ;
- N DVBI,DVBJ,DVBREF,DD,DIC,DO,X
- I '$D(DUZ)!'$D(U) W !!,"<<PROGRAMMER NOT DEFINED>>",! Q
- ;
- DVBNEW ;add new codes
- W !!,"*** Updating DISABILITY CONDITION file (#31)",!?4,"per VA circular 21-95-2, dated Feb. 1, 1995",!
- ;
- F DVBI=1:1 S DVBJ=$P($T(NEWCODE+DVBI),";;",2) Q:DVBJ["$EXIT" D
- .S DVBREF=+DVBJ
- .I '$D(^DIC(31,"C",DVBREF)) D
- ..K DD,DO
- ..S DIC="^DIC(31,",DIC(0)="L",DIC("DR")="2////"_DVBREF,X=$P(DVBJ,"^",2)
- ..D FILE^DICN
- ..W !,DVBREF,?10,X
- W !!," << DONE >>",!
- Q
- NEWCODE ; codes to be addded
- ;;8850^UNDIAG. COND. - MUSCULOSKELETAL DISEASES
- ;;8851^UNDIAG. COND. - AMPUTATIONS
- ;;8852^UNDIAG. COND. - JOINTS, SKULL, AND RIBS
- ;;8853^UNDIAG. COND. - MUSCLE INJURIES
- ;;8860^UNDIAG. COND. - DISEASES OF THE EYE
- ;;8861^UNDIAG. COND. - HEARING LOSS
- ;;8862^UNDIAG. COND. - EAR AND OTHER SENSE ORGANS
- ;;8863^UNDIAG. COND. - SYSTEMIC DISEASES
- ;;8865^UNDIAG. COND. - NOSE AND THROAT
- ;;8866^UNDIAG. COND. - TRACHEA AND BRONCHI
- ;;8867^UNDIAG. COND. - TUBERCULOSIS
- ;;8868^UNDIAG. COND. - LUNGS AND PLEURA
- ;;8870^UNDIAG. COND. - HEART DISEASES
- ;;8871^UNDIAG. COND. - ARTERIES AND VEINS
- ;;8872^UNDIAG. COND. - UPPER DIGESTIVE SYSTEM
- ;;8873^UNDIAG. COND. - LOWER DIGESTIVE SYSTEM
- ;;8875^UNDIAG. COND. - GENITOURINARY SYSTEM
- ;;8876^UNDIAG. COND. - GYNECOLOGICAL SYSTEM
- ;;8877^UNDIAG. COND. - HEMIC AND LYMPHATIC SYSTEM
- ;;8878^UNDIAG. COND. - SKIN
- ;;8879^UNDIAG. COND. - ENDOCRINE SYSTEM
- ;;8880^UNDIAG. COND. - CENTRAL NERVOUS SYSTEM
- ;;8881^UNDIAG. COND. - MISCELLANEOUS NEUROLOGICAL
- ;;8882^UNDIAG. COND. - CRANIAL NERVE PARALYSIS
- ;;8883^UNDIAG. COND. - CRANIAL NERVE NEURITIS
- ;;8884^UNDIAG. COND. - CRANIAL NERVE NEURALGIA
- ;;8885^UNDIAG. COND. - PERIPHERAL NERVE PARALYSIS
- ;;8886^UNDIAG. COND. - PERIPHERAL NERVE NEURITIS
- ;;8887^UNDIAG. COND. - PERIPHERAL NERVE NEURALGIA
- ;;8889^UNDIAG. COND. - EPILEPSIES
- ;;8892^UNDIAG. COND. - PSYCHOTIC DISORDERS
- ;;8893^UNDIAG. COND. - ORGANIC MENTAL
- ;;8894^UNDIAG. COND. - PSYCHONEUROTIC
- ;;8895^UNDIAG. COND. - PSYCHOPHYSIOLOGIC
- ;;8899^UNDIAG. COND. - DENTAL AND ORAL
- ;;$EXIT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBYPGD 2208 printed Feb 18, 2025@23:25:43 Page 2
- DVBYPGD ;ALB/ABR - UPDATE DISABILITY CONDITION FILE ; APR 4 1995
- +1 ;;V4.0;HINQ;**24**;03/25/92
- +2 ;
- EN ;
- +1 NEW DVBI,DVBJ,DVBREF,DD,DIC,DO,X
- +2 IF '$DATA(DUZ)!'$DATA(U)
- WRITE !!,"<<PROGRAMMER NOT DEFINED>>",!
- QUIT
- +3 ;
- DVBNEW ;add new codes
- +1 WRITE !!,"*** Updating DISABILITY CONDITION file (#31)",!?4,"per VA circular 21-95-2, dated Feb. 1, 1995",!
- +2 ;
- +3 FOR DVBI=1:1
- SET DVBJ=$PIECE($TEXT(NEWCODE+DVBI),";;",2)
- if DVBJ["$EXIT"
- QUIT
- Begin DoDot:1
- +4 SET DVBREF=+DVBJ
- +5 IF '$DATA(^DIC(31,"C",DVBREF))
- Begin DoDot:2
- +6 KILL DD,DO
- +7 SET DIC="^DIC(31,"
- SET DIC(0)="L"
- SET DIC("DR")="2////"_DVBREF
- SET X=$PIECE(DVBJ,"^",2)
- +8 DO FILE^DICN
- +9 WRITE !,DVBREF,?10,X
- End DoDot:2
- End DoDot:1
- +10 WRITE !!," << DONE >>",!
- +11 QUIT
- NEWCODE ; codes to be addded
- +1 ;;8850^UNDIAG. COND. - MUSCULOSKELETAL DISEASES
- +2 ;;8851^UNDIAG. COND. - AMPUTATIONS
- +3 ;;8852^UNDIAG. COND. - JOINTS, SKULL, AND RIBS
- +4 ;;8853^UNDIAG. COND. - MUSCLE INJURIES
- +5 ;;8860^UNDIAG. COND. - DISEASES OF THE EYE
- +6 ;;8861^UNDIAG. COND. - HEARING LOSS
- +7 ;;8862^UNDIAG. COND. - EAR AND OTHER SENSE ORGANS
- +8 ;;8863^UNDIAG. COND. - SYSTEMIC DISEASES
- +9 ;;8865^UNDIAG. COND. - NOSE AND THROAT
- +10 ;;8866^UNDIAG. COND. - TRACHEA AND BRONCHI
- +11 ;;8867^UNDIAG. COND. - TUBERCULOSIS
- +12 ;;8868^UNDIAG. COND. - LUNGS AND PLEURA
- +13 ;;8870^UNDIAG. COND. - HEART DISEASES
- +14 ;;8871^UNDIAG. COND. - ARTERIES AND VEINS
- +15 ;;8872^UNDIAG. COND. - UPPER DIGESTIVE SYSTEM
- +16 ;;8873^UNDIAG. COND. - LOWER DIGESTIVE SYSTEM
- +17 ;;8875^UNDIAG. COND. - GENITOURINARY SYSTEM
- +18 ;;8876^UNDIAG. COND. - GYNECOLOGICAL SYSTEM
- +19 ;;8877^UNDIAG. COND. - HEMIC AND LYMPHATIC SYSTEM
- +20 ;;8878^UNDIAG. COND. - SKIN
- +21 ;;8879^UNDIAG. COND. - ENDOCRINE SYSTEM
- +22 ;;8880^UNDIAG. COND. - CENTRAL NERVOUS SYSTEM
- +23 ;;8881^UNDIAG. COND. - MISCELLANEOUS NEUROLOGICAL
- +24 ;;8882^UNDIAG. COND. - CRANIAL NERVE PARALYSIS
- +25 ;;8883^UNDIAG. COND. - CRANIAL NERVE NEURITIS
- +26 ;;8884^UNDIAG. COND. - CRANIAL NERVE NEURALGIA
- +27 ;;8885^UNDIAG. COND. - PERIPHERAL NERVE PARALYSIS
- +28 ;;8886^UNDIAG. COND. - PERIPHERAL NERVE NEURITIS
- +29 ;;8887^UNDIAG. COND. - PERIPHERAL NERVE NEURALGIA
- +30 ;;8889^UNDIAG. COND. - EPILEPSIES
- +31 ;;8892^UNDIAG. COND. - PSYCHOTIC DISORDERS
- +32 ;;8893^UNDIAG. COND. - ORGANIC MENTAL
- +33 ;;8894^UNDIAG. COND. - PSYCHONEUROTIC
- +34 ;;8895^UNDIAG. COND. - PSYCHOPHYSIOLOGIC
- +35 ;;8899^UNDIAG. COND. - DENTAL AND ORAL
- +36 ;;$EXIT
- +37 QUIT