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 Dec 13, 2024@01:59:16 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
