| 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
|
|---|
