DVB67PT.m

DVB67PT ;ALB/JAM - UPDATE DISABILITY CONDITION FILE ; 4/8/14 11:30am

 ;;4.0;HINQ;**67**;03/25/92;Build 8

 ;

 Q

 ;

 ;

EN ;Initialize variables and validate user.

 N DVBI,DVBJ,DVBREF,DIC,DO,X,Y

 I '$D(DUZ) D BMES^XPDUTL("*** PROGRAMMER NOT DEFINED ***") Q

DVBNEW ;Add new codes.

 D BMES^XPDUTL("** Updating DISABILITY CONDITION(#31) file **")

 F DVBI=1:1 S DVBJ=$P($T(NEWCODE+DVBI),";;",2) Q:DVBJ="QUIT"  D

 .S DVBREF=+DVBJ

 .I $D(^DIC(31,"C",DVBREF)) D DVBERR1 Q

 .K DO

 .S DIC="^DIC(31,",DIC(0)="L",DIC("DR")="2///"_DVBREF,X=$P(DVBJ,"^",2)

 .D FILE^DICN

 .I Y=-1 D DVBERR2 Q

 .D BMES^XPDUTL("** "_DVBREF_"    "_X_" has been added **")

 D BMES^XPDUTL("** Done **")

 Q

DVBERR1 ;Message to the user that the file entry already exists.

 D BMES^XPDUTL("*** A FILE ENTRY FOR DISABILITY CODE "_DVBREF_" HAS ALREADY BEEN CREATED ***")

 Q

DVBERR2 ;Message to the user that an error occurred.

 D BMES^XPDUTL("*** AN ERROR OCCURRED WHEN ATTEMPTING TO ADD NEW FILE ENTRIES. PLEASE CONTACT PRODUCT SUPPORT ***")

 Q

NEWCODE ;Code to be added.

 ;;7717^AL AMYLOIDOSIS (PRIMARY AMYLOIDOSIS)

 ;;QUIT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVB67PT   1116     printed  Mar 13, 2025@21:02:37                                                                                                                                                                                                     Page 2

DVB67PT   ;ALB/JAM - UPDATE DISABILITY CONDITION FILE ; 4/8/14 11:30am

 +1       ;;4.0;HINQ;**67**;03/25/92;Build 8

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ;

EN        ;Initialize variables and validate user.

 +1        NEW DVBI,DVBJ,DVBREF,DIC,DO,X,Y

 +2        IF '$DATA(DUZ)

               DO BMES^XPDUTL("*** PROGRAMMER NOT DEFINED ***")

               QUIT 

DVBNEW    ;Add new codes.

 +1        DO BMES^XPDUTL("** Updating DISABILITY CONDITION(#31) file **")

 +2        FOR DVBI=1:1

               SET DVBJ=$PIECE($TEXT(NEWCODE+DVBI),";;",2)

               if DVBJ="QUIT"

                   QUIT 

               Begin DoDot:1

 +3                SET DVBREF=+DVBJ

 +4                IF $DATA(^DIC(31,"C",DVBREF))

                       DO DVBERR1

                       QUIT 

 +5                KILL DO

 +6                SET DIC="^DIC(31,"

                   SET DIC(0)="L"

                   SET DIC("DR")="2///"_DVBREF

                   SET X=$PIECE(DVBJ,"^",2)

 +7                DO FILE^DICN

 +8                IF Y=-1

                       DO DVBERR2

                       QUIT 

 +9                DO BMES^XPDUTL("** "_DVBREF_"    "_X_" has been added **")

               End DoDot:1

 +10       DO BMES^XPDUTL("** Done **")

 +11       QUIT 

DVBERR1   ;Message to the user that the file entry already exists.

 +1        DO BMES^XPDUTL("*** A FILE ENTRY FOR DISABILITY CODE "_DVBREF_" HAS ALREADY BEEN CREATED ***")

 +2        QUIT 

DVBERR2   ;Message to the user that an error occurred.

 +1        DO BMES^XPDUTL("*** AN ERROR OCCURRED WHEN ATTEMPTING TO ADD NEW FILE ENTRIES. PLEASE CONTACT PRODUCT SUPPORT ***")

 +2        QUIT 

NEWCODE   ;Code to be added.

 +1       ;;7717^AL AMYLOIDOSIS (PRIMARY AMYLOIDOSIS)

 +2       ;;QUIT

 +3        QUIT