| [613] | 1 | DVBAPADD ;ALB/JLU;adds new disability codes to file 31
 | 
|---|
 | 2 |  ;;2.7;AMIE;;Apr 10, 1995
 | 
|---|
 | 3 | EN ;start of routine
 | 
|---|
 | 4 |  I +$$VERSION^DVBAPST1>2.59 DO  Q
 | 
|---|
 | 5 |  .S VAR=" - Version 2.6 of AMIE has already been loaded."
 | 
|---|
 | 6 |  .D BUMPBLK^DVBAPOST
 | 
|---|
 | 7 |  .D BUMPBLK^DVBAPOST
 | 
|---|
 | 8 |  .D BUMP^DVBAPOST(VAR)
 | 
|---|
 | 9 |  .W !!,VAR
 | 
|---|
 | 10 |  .S VAR="There is no need to update the Disability Condition file."
 | 
|---|
 | 11 |  .D BUMP^DVBAPOST(VAR)
 | 
|---|
 | 12 |  .W !,VAR,!
 | 
|---|
 | 13 |  .D BUMPBLK^DVBAPOST
 | 
|---|
 | 14 |  .Q
 | 
|---|
 | 15 |  S JCNT=0
 | 
|---|
 | 16 |  N LP,LP1
 | 
|---|
 | 17 |  S VAR="Adding to the Disability Condition file."
 | 
|---|
 | 18 |  W !!,VAR,!
 | 
|---|
 | 19 |  D BUMPBLK^DVBAPOST
 | 
|---|
 | 20 |  D BUMPBLK^DVBAPOST
 | 
|---|
 | 21 |  D BUMP^DVBAPOST(VAR)
 | 
|---|
 | 22 |  D BUMPBLK^DVBAPOST
 | 
|---|
 | 23 |  F LP=1:1 S LP1=$T(TXT+LP) Q:LP1=""  DO
 | 
|---|
 | 24 |  .S DCODE=$P(LP1,";;",2)
 | 
|---|
 | 25 |  .S DTEXT=$P(DCODE,";",2)
 | 
|---|
 | 26 |  .S DCODE=$P(DCODE,";",1)
 | 
|---|
 | 27 |  .I $L(DTEXT)>45 S DTEXT=$E(DTEXT,1,45)
 | 
|---|
 | 28 |  .K JSTOP
 | 
|---|
 | 29 |  .D CHK
 | 
|---|
 | 30 |  .I $D(JSTOP) Q
 | 
|---|
 | 31 |  .S DIC="^DIC(31,",DIC("DR")="2///"_DCODE,X=DTEXT,DLAYGO=31,DIC(0)="L"
 | 
|---|
 | 32 |  .K DD,DO
 | 
|---|
 | 33 |  .D FILE^DICN
 | 
|---|
 | 34 |  .K DO,DD,DLAYGO
 | 
|---|
 | 35 |  .I +Y>0 S JCNT=JCNT+1 W "."
 | 
|---|
 | 36 |  .I +Y<0 D ERR
 | 
|---|
 | 37 |  .Q
 | 
|---|
 | 38 |  S VAR="Additions to the Disability Condition file (31) has finished.  "_JCNT_" were added."
 | 
|---|
 | 39 |  W !!,VAR
 | 
|---|
 | 40 |  D BUMPBLK^DVBAPOST
 | 
|---|
 | 41 |  D BUMPBLK^DVBAPOST
 | 
|---|
 | 42 |  D BUMP^DVBAPOST(VAR)
 | 
|---|
 | 43 |  K DIC,JSTOP,JCNT,DLAYGO,X,DCODE,DTEXT
 | 
|---|
 | 44 |  Q
 | 
|---|
 | 45 |  ;
 | 
|---|
 | 46 | CHK ;checks for the existance of the codes in the c cross ref.
 | 
|---|
 | 47 |  I $D(^DIC(31,"C",DCODE)) S JSTOP=1
 | 
|---|
 | 48 |  I $D(^DIC(31,"B",$E(DTEXT,1,30))) S JSTOP=1
 | 
|---|
 | 49 |  I $D(JSTOP) DO
 | 
|---|
 | 50 |  .S VAR="Disability Condition "_DCODE_" was not added.  Entry already exists."
 | 
|---|
 | 51 |  .W !,VAR
 | 
|---|
 | 52 |  .D BUMPBLK^DVBAPOST
 | 
|---|
 | 53 |  .D BUMP^DVBAPOST(VAR)
 | 
|---|
 | 54 |  .Q
 | 
|---|
 | 55 |  Q
 | 
|---|
 | 56 |  ;
 | 
|---|
 | 57 | ERR ;not added
 | 
|---|
 | 58 |  S VAR="Not able to add Disability Condition "_DCODE_".  Consult the Install Guide."
 | 
|---|
 | 59 |  W !,VAR
 | 
|---|
 | 60 |  D BUMPBLK^DVBAPOST
 | 
|---|
 | 61 |  D BUMP^DVBAPOST(VAR)
 | 
|---|
 | 62 |  Q
 | 
|---|
 | 63 |  ;
 | 
|---|
 | 64 | TXT ;new exams to be added.
 | 
|---|
 | 65 |  ;;7532;RENAL TUBULAR DISORDERS
 | 
|---|
 | 66 |  ;;7533;CYSTIC DISEASES OF THE KIDNEYS
 | 
|---|
 | 67 |  ;;7534;ATHEROSCLEROTIC RENAL DISEASE
 | 
|---|
 | 68 |  ;;7535;TOXIC NEUROPATHY
 | 
|---|
 | 69 |  ;;7536;GLOMERULONEPHRITIS
 | 
|---|
 | 70 |  ;;7537;INTERSTITIAL NEPHRITIS
 | 
|---|
 | 71 |  ;;7538;PAPILLARY NECROSIS
 | 
|---|
 | 72 |  ;;7539;RENAL AMYLOID DISEASE
 | 
|---|
 | 73 |  ;;7540;DISSEMINATED INTRAVASCULAR COAGULATION WITH RENAL CORTICAL NECROSIS
 | 
|---|
 | 74 |  ;;7541;RENAL INVOLVEMENT IN DIABETES, SICKLE CELL ANEMIA, SYSTEMIC LUPUS ERYTHEMATOSUS, VASCULITIS OR OTHER SYSTEMIC DISEASE PROCESES
 | 
|---|
 | 75 |  ;;7542;NEUROGENIC BLADDER
 | 
|---|
 | 76 |  ;;9914;MAXILLA, LOSS OF MORE THAN HALF
 | 
|---|
 | 77 |  ;;9915;MAXILLA, LOSS OF HALF OR LESS
 | 
|---|
 | 78 |  ;;9916;MAXILLA, MALUNION OR NONUNION
 | 
|---|