DVBAPADD ;ALB/JLU;adds new disability codes to file 31
;;2.7;AMIE;;Apr 10, 1995
EN ;start of routine
I +$$VERSION^DVBAPST1>2.59 DO Q
.S VAR=" - Version 2.6 of AMIE has already been loaded."
.D BUMPBLK^DVBAPOST
.D BUMPBLK^DVBAPOST
.D BUMP^DVBAPOST(VAR)
.W !!,VAR
.S VAR="There is no need to update the Disability Condition file."
.D BUMP^DVBAPOST(VAR)
.W !,VAR,!
.D BUMPBLK^DVBAPOST
.Q
S JCNT=0
N LP,LP1
S VAR="Adding to the Disability Condition file."
W !!,VAR,!
D BUMPBLK^DVBAPOST
D BUMPBLK^DVBAPOST
D BUMP^DVBAPOST(VAR)
D BUMPBLK^DVBAPOST
F LP=1:1 S LP1=$T(TXT+LP) Q:LP1="" DO
.S DCODE=$P(LP1,";;",2)
.S DTEXT=$P(DCODE,";",2)
.S DCODE=$P(DCODE,";",1)
.I $L(DTEXT)>45 S DTEXT=$E(DTEXT,1,45)
.K JSTOP
.D CHK
.I $D(JSTOP) Q
.S DIC="^DIC(31,",DIC("DR")="2///"_DCODE,X=DTEXT,DLAYGO=31,DIC(0)="L"
.K DD,DO
.D FILE^DICN
.K DO,DD,DLAYGO
.I +Y>0 S JCNT=JCNT+1 W "."
.I +Y<0 D ERR
.Q
S VAR="Additions to the Disability Condition file (31) has finished. "_JCNT_" were added."
W !!,VAR
D BUMPBLK^DVBAPOST
D BUMPBLK^DVBAPOST
D BUMP^DVBAPOST(VAR)
K DIC,JSTOP,JCNT,DLAYGO,X,DCODE,DTEXT
Q
;
CHK ;checks for the existance of the codes in the c cross ref.
I $D(^DIC(31,"C",DCODE)) S JSTOP=1
I $D(^DIC(31,"B",$E(DTEXT,1,30))) S JSTOP=1
I $D(JSTOP) DO
.S VAR="Disability Condition "_DCODE_" was not added. Entry already exists."
.W !,VAR
.D BUMPBLK^DVBAPOST
.D BUMP^DVBAPOST(VAR)
.Q
Q
;
ERR ;not added
S VAR="Not able to add Disability Condition "_DCODE_". Consult the Install Guide."
W !,VAR
D BUMPBLK^DVBAPOST
D BUMP^DVBAPOST(VAR)
Q
;
TXT ;new exams to be added.
;;7532;RENAL TUBULAR DISORDERS
;;7533;CYSTIC DISEASES OF THE KIDNEYS
;;7534;ATHEROSCLEROTIC RENAL DISEASE
;;7535;TOXIC NEUROPATHY
;;7536;GLOMERULONEPHRITIS
;;7537;INTERSTITIAL NEPHRITIS
;;7538;PAPILLARY NECROSIS
;;7539;RENAL AMYLOID DISEASE
;;7540;DISSEMINATED INTRAVASCULAR COAGULATION WITH RENAL CORTICAL NECROSIS
;;7541;RENAL INVOLVEMENT IN DIABETES, SICKLE CELL ANEMIA, SYSTEMIC LUPUS ERYTHEMATOSUS, VASCULITIS OR OTHER SYSTEMIC DISEASE PROCESES
;;7542;NEUROGENIC BLADDER
;;9914;MAXILLA, LOSS OF MORE THAN HALF
;;9915;MAXILLA, LOSS OF HALF OR LESS
;;9916;MAXILLA, MALUNION OR NONUNION
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAPADD 2292 printed Dec 13, 2024@01:41:33 Page 2
DVBAPADD ;ALB/JLU;adds new disability codes to file 31
+1 ;;2.7;AMIE;;Apr 10, 1995
EN ;start of routine
+1 IF +$$VERSION^DVBAPST1>2.59
Begin DoDot:1
+2 SET VAR=" - Version 2.6 of AMIE has already been loaded."
+3 DO BUMPBLK^DVBAPOST
+4 DO BUMPBLK^DVBAPOST
+5 DO BUMP^DVBAPOST(VAR)
+6 WRITE !!,VAR
+7 SET VAR="There is no need to update the Disability Condition file."
+8 DO BUMP^DVBAPOST(VAR)
+9 WRITE !,VAR,!
+10 DO BUMPBLK^DVBAPOST
+11 QUIT
End DoDot:1
QUIT
+12 SET JCNT=0
+13 NEW LP,LP1
+14 SET VAR="Adding to the Disability Condition file."
+15 WRITE !!,VAR,!
+16 DO BUMPBLK^DVBAPOST
+17 DO BUMPBLK^DVBAPOST
+18 DO BUMP^DVBAPOST(VAR)
+19 DO BUMPBLK^DVBAPOST
+20 FOR LP=1:1
SET LP1=$TEXT(TXT+LP)
if LP1=""
QUIT
Begin DoDot:1
+21 SET DCODE=$PIECE(LP1,";;",2)
+22 SET DTEXT=$PIECE(DCODE,";",2)
+23 SET DCODE=$PIECE(DCODE,";",1)
+24 IF $LENGTH(DTEXT)>45
SET DTEXT=$EXTRACT(DTEXT,1,45)
+25 KILL JSTOP
+26 DO CHK
+27 IF $DATA(JSTOP)
QUIT
+28 SET DIC="^DIC(31,"
SET DIC("DR")="2///"_DCODE
SET X=DTEXT
SET DLAYGO=31
SET DIC(0)="L"
+29 KILL DD,DO
+30 DO FILE^DICN
+31 KILL DO,DD,DLAYGO
+32 IF +Y>0
SET JCNT=JCNT+1
WRITE "."
+33 IF +Y<0
DO ERR
+34 QUIT
End DoDot:1
+35 SET VAR="Additions to the Disability Condition file (31) has finished. "_JCNT_" were added."
+36 WRITE !!,VAR
+37 DO BUMPBLK^DVBAPOST
+38 DO BUMPBLK^DVBAPOST
+39 DO BUMP^DVBAPOST(VAR)
+40 KILL DIC,JSTOP,JCNT,DLAYGO,X,DCODE,DTEXT
+41 QUIT
+42 ;
CHK ;checks for the existance of the codes in the c cross ref.
+1 IF $DATA(^DIC(31,"C",DCODE))
SET JSTOP=1
+2 IF $DATA(^DIC(31,"B",$EXTRACT(DTEXT,1,30)))
SET JSTOP=1
+3 IF $DATA(JSTOP)
Begin DoDot:1
+4 SET VAR="Disability Condition "_DCODE_" was not added. Entry already exists."
+5 WRITE !,VAR
+6 DO BUMPBLK^DVBAPOST
+7 DO BUMP^DVBAPOST(VAR)
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
ERR ;not added
+1 SET VAR="Not able to add Disability Condition "_DCODE_". Consult the Install Guide."
+2 WRITE !,VAR
+3 DO BUMPBLK^DVBAPOST
+4 DO BUMP^DVBAPOST(VAR)
+5 QUIT
+6 ;
TXT ;new exams to be added.
+1 ;;7532;RENAL TUBULAR DISORDERS
+2 ;;7533;CYSTIC DISEASES OF THE KIDNEYS
+3 ;;7534;ATHEROSCLEROTIC RENAL DISEASE
+4 ;;7535;TOXIC NEUROPATHY
+5 ;;7536;GLOMERULONEPHRITIS
+6 ;;7537;INTERSTITIAL NEPHRITIS
+7 ;;7538;PAPILLARY NECROSIS
+8 ;;7539;RENAL AMYLOID DISEASE
+9 ;;7540;DISSEMINATED INTRAVASCULAR COAGULATION WITH RENAL CORTICAL NECROSIS
+10 ;;7541;RENAL INVOLVEMENT IN DIABETES, SICKLE CELL ANEMIA, SYSTEMIC LUPUS ERYTHEMATOSUS, VASCULITIS OR OTHER SYSTEMIC DISEASE PROCESES
+11 ;;7542;NEUROGENIC BLADDER
+12 ;;9914;MAXILLA, LOSS OF MORE THAN HALF
+13 ;;9915;MAXILLA, LOSS OF HALF OR LESS
+14 ;;9916;MAXILLA, MALUNION OR NONUNION
