DVBYPGD2.m

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 ---DVBYPGD2   1157     printed  Mar 13, 2025@21:04:13                                                                                                                                                                                                    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