source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAPADD.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1DVBAPADD ;ALB/JLU;adds new disability codes to file 31
2 ;;2.7;AMIE;;Apr 10, 1995
3EN ;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 ;
46CHK ;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 ;
57ERR ;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 ;
64TXT ;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
Note: See TracBrowser for help on using the repository browser.