- 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 Feb 18, 2025@23:07:56 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