DG1062P.m

DG1062P ;ALB/FSB - ICD-10 POST-INIT ; 7/16/21@17:22

 ;;5.3;Registration;**1062**;Aug 13, 1993;Build 6

 ;

 Q

ADD ;

 N DIC,DGY,DGX,DGDT,DGDTR,DIE,DR

 D BMES^XPDUTL("Adding Dialysis Procedure Codes")

 S DIC="^DIC(45.89,",DGDTR=$O(^DIC(45.88,"B","DIALYSIS TYPE",0)) I DGDTR="" D BMES^XPDUTL("No pointer to Dialysis Type record.") Q

 S DGDT=$P(^DIC(45.88,DGDTR,0),"^",1) ;"Dialysis Type"

 F DGY=1:1 S DGX=$P($T(CHNG+DGY),";;",2) Q:DGX=""  D

 .I $O(^DIC(45.89,"ACODE",DGX,0))'="" D BMES^XPDUTL("Procedure code "_DGX_" already exists.") Q

 .K DO,DA S X=DGDTR,DIC(0)="" D FILE^DICN

 .I Y=-1 D BMES^XPDUTL(DGDT_" record was not added to the file #45.89") Q

 .S DIE="^DIC(45.89,",DA=$P(Y,"^",1),DR=".02///"_DGX D ^DIE

 .D BMES^XPDUTL(DGX_" procedure code was added to the "_DGDT_" record.")

 D BMES^XPDUTL("Update of PTF EXPANDED CODE complete.")

 Q

CHNG ; Codes to add

 ;;5A1D70Z

 ;;5A1D80Z

 ;;5A1D90Z

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG1062P   914     printed  Apr 09, 2024@21:45:39                                                                                                                                                                                                      Page 2

DG1062P   ;ALB/FSB - ICD-10 POST-INIT ; 7/16/21@17:22

 +1       ;;5.3;Registration;**1062**;Aug 13, 1993;Build 6

 +2       ;

 +3        QUIT 

ADD       ;

 +1        NEW DIC,DGY,DGX,DGDT,DGDTR,DIE,DR

 +2        DO BMES^XPDUTL("Adding Dialysis Procedure Codes")

 +3        SET DIC="^DIC(45.89,"

           SET DGDTR=$ORDER(^DIC(45.88,"B","DIALYSIS TYPE",0))

           IF DGDTR=""

               DO BMES^XPDUTL("No pointer to Dialysis Type record.")

               QUIT 

 +4       ;"Dialysis Type"

           SET DGDT=$PIECE(^DIC(45.88,DGDTR,0),"^",1)

 +5        FOR DGY=1:1

               SET DGX=$PIECE($TEXT(CHNG+DGY),";;",2)

               if DGX=""

                   QUIT 

               Begin DoDot:1

 +6                IF $ORDER(^DIC(45.89,"ACODE",DGX,0))'=""

                       DO BMES^XPDUTL("Procedure code "_DGX_" already exists.")

                       QUIT 

 +7                KILL DO,DA

                   SET X=DGDTR

                   SET DIC(0)=""

                   DO FILE^DICN

 +8                IF Y=-1

                       DO BMES^XPDUTL(DGDT_" record was not added to the file #45.89")

                       QUIT 

 +9                SET DIE="^DIC(45.89,"

                   SET DA=$PIECE(Y,"^",1)

                   SET DR=".02///"_DGX

                   DO ^DIE

 +10               DO BMES^XPDUTL(DGX_" procedure code was added to the "_DGDT_" record.")

               End DoDot:1

 +11       DO BMES^XPDUTL("Update of PTF EXPANDED CODE complete.")

 +12       QUIT 

CHNG      ; Codes to add

 +1       ;;5A1D70Z

 +2       ;;5A1D80Z

 +3       ;;5A1D90Z