DVBYPGD2 ;ALB/CMM; New Disability Codes file 31 ;9/25/95
;;V4.0;HINQ;**27**;03/25/92
;
EN ;start of routine
N LP,LP1,JCNT,CODE,TEXT
S JCNT=0
W !!,"Adding to the Disability Condition file.",!!
F LP=1:1 S LP1=$T(TXT+LP) Q:LP1="" DO
.S CODE=$P(LP1,";;",2)
.S TEXT=$P(CODE,";",2)
.S CODE=$P(CODE,";",1)
.I $L(TEXT)>45 S TEXT=$E(TEXT,1,45)
.K JSTOP
.D CHK
.I $D(JSTOP) Q
.S DIC="^DIC(31,",DIC("DR")="2///"_CODE,X=TEXT,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 W !,"Not able to add Disability Condition "_CODE_"."
W !!!,"The Disability Condition file (31) update has finished. ",!," "_JCNT_" disability codes were added."
K DIC,JSTOP,DLAYGO,X,Y,DIE,DR,DA
Q
;
CHK ;checks for the existance of the codes in the c cross ref.
I $D(^DIC(31,"C",CODE)) S JSTOP=1
I $D(^DIC(31,"B",$E(TEXT,1,30))) S JSTOP=1
I $D(JSTOP) W !,"Disability Condition "_CODE_" was not added. Entry already exists."
Q
;
TXT ;new exams to be added.
;;6354;CHRONIC FATIGUE SYNDROME (CFS)
;;7628;BENIGN NEOPLASMS OF THE GYNECOLOGICAL SYSTEM OR BREAST
;;7629;ENDOMETRIOSIS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBYPGD2 1157 printed Dec 13, 2024@01:59:17 Page 2
DVBYPGD2 ;ALB/CMM; New Disability Codes file 31 ;9/25/95
+1 ;;V4.0;HINQ;**27**;03/25/92
+2 ;
EN ;start of routine
+1 NEW LP,LP1,JCNT,CODE,TEXT
+2 SET JCNT=0
+3 WRITE !!,"Adding to the Disability Condition file.",!!
+4 FOR LP=1:1
SET LP1=$TEXT(TXT+LP)
if LP1=""
QUIT
Begin DoDot:1
+5 SET CODE=$PIECE(LP1,";;",2)
+6 SET TEXT=$PIECE(CODE,";",2)
+7 SET CODE=$PIECE(CODE,";",1)
+8 IF $LENGTH(TEXT)>45
SET TEXT=$EXTRACT(TEXT,1,45)
+9 KILL JSTOP
+10 DO CHK
+11 IF $DATA(JSTOP)
QUIT
+12 SET DIC="^DIC(31,"
SET DIC("DR")="2///"_CODE
SET X=TEXT
SET DLAYGO=31
SET DIC(0)="L"
+13 KILL DD,DO
+14 DO FILE^DICN
+15 KILL DO,DD,DLAYGO
+16 IF +Y>0
SET JCNT=JCNT+1
WRITE "."
+17 IF +Y<0
WRITE !,"Not able to add Disability Condition "_CODE_"."
End DoDot:1
+18 WRITE !!!,"The Disability Condition file (31) update has finished. ",!," "_JCNT_" disability codes were added."
+19 KILL DIC,JSTOP,DLAYGO,X,Y,DIE,DR,DA
+20 QUIT
+21 ;
CHK ;checks for the existance of the codes in the c cross ref.
+1 IF $DATA(^DIC(31,"C",CODE))
SET JSTOP=1
+2 IF $DATA(^DIC(31,"B",$EXTRACT(TEXT,1,30)))
SET JSTOP=1
+3 IF $DATA(JSTOP)
WRITE !,"Disability Condition "_CODE_" was not added. Entry already exists."
+4 QUIT
+5 ;
TXT ;new exams to be added.
+1 ;;6354;CHRONIC FATIGUE SYNDROME (CFS)
+2 ;;7628;BENIGN NEOPLASMS OF THE GYNECOLOGICAL SYSTEM OR BREAST
+3 ;;7629;ENDOMETRIOSIS
