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 ---[H[J[2J[HDG1062P 914 printed Dec 13, 2024@02:35:11 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
