source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBYPGD2.m@ 1710

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1DVBYPGD2 ;ALB/CMM; New Disability Codes file 31 ;9/25/95
2 ;;V4.0;HINQ;**27**;03/25/92
3 ;
4EN ;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 ;
26CHK ;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 ;
32TXT ;new exams to be added.
33 ;;6354;CHRONIC FATIGUE SYNDROME (CFS)
34 ;;7628;BENIGN NEOPLASMS OF THE GYNECOLOGICAL SYSTEM OR BREAST
35 ;;7629;ENDOMETRIOSIS
Note: See TracBrowser for help on using the repository browser.