| 1 | DVBYPGD2 ;ALB/CMM; New Disability Codes file 31 ;9/25/95
|
|---|
| 2 | ;;V4.0;HINQ;**27**;03/25/92
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;start of routine
|
|---|
| 5 | N LP,LP1,JCNT,CODE,TEXT
|
|---|
| 6 | S JCNT=0
|
|---|
| 7 | W !!,"Adding to the Disability Condition file.",!!
|
|---|
| 8 | F LP=1:1 S LP1=$T(TXT+LP) Q:LP1="" DO
|
|---|
| 9 | .S CODE=$P(LP1,";;",2)
|
|---|
| 10 | .S TEXT=$P(CODE,";",2)
|
|---|
| 11 | .S CODE=$P(CODE,";",1)
|
|---|
| 12 | .I $L(TEXT)>45 S TEXT=$E(TEXT,1,45)
|
|---|
| 13 | .K JSTOP
|
|---|
| 14 | .D CHK
|
|---|
| 15 | .I $D(JSTOP) Q
|
|---|
| 16 | .S DIC="^DIC(31,",DIC("DR")="2///"_CODE,X=TEXT,DLAYGO=31,DIC(0)="L"
|
|---|
| 17 | .K DD,DO
|
|---|
| 18 | .D FILE^DICN
|
|---|
| 19 | .K DO,DD,DLAYGO
|
|---|
| 20 | .I +Y>0 S JCNT=JCNT+1 W "."
|
|---|
| 21 | .I +Y<0 W !,"Not able to add Disability Condition "_CODE_"."
|
|---|
| 22 | W !!!,"The Disability Condition file (31) update has finished. ",!," "_JCNT_" disability codes were added."
|
|---|
| 23 | K DIC,JSTOP,DLAYGO,X,Y,DIE,DR,DA
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | CHK ;checks for the existance of the codes in the c cross ref.
|
|---|
| 27 | I $D(^DIC(31,"C",CODE)) S JSTOP=1
|
|---|
| 28 | I $D(^DIC(31,"B",$E(TEXT,1,30))) S JSTOP=1
|
|---|
| 29 | I $D(JSTOP) W !,"Disability Condition "_CODE_" was not added. Entry already exists."
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | TXT ;new exams to be added.
|
|---|
| 33 | ;;6354;CHRONIC FATIGUE SYNDROME (CFS)
|
|---|
| 34 | ;;7628;BENIGN NEOPLASMS OF THE GYNECOLOGICAL SYSTEM OR BREAST
|
|---|
| 35 | ;;7629;ENDOMETRIOSIS
|
|---|
