ACKQ3P21 ;ALB/CLA - IMPORT WIZARD FOR ICD-10 CODES INTO FILE 509850.1;31 Mar 2014 9:55 AM
;;3.0;QUASAR;**21**;Feb 11, 2000;Build 40
;
; Reference/IA
; $$CODEN^ICDEX - 5747
; $$CSI^ICDEX - 5747
;
% ; - Top level entry point
N COUNT,COUNT2
D BMES^XPDUTL("Adding Entries to A&SP DIAGNOSTIC CONDITION FILE")
D SETVER,EN
I COUNT=0 D Q
. D BMES^XPDUTL("ICD-10 Entries Already in File...Install Step to Add Entries Skipped")
D MES^XPDUTL(" Total Diagnosis Entries added to A&SP DIAGNOSTIC CONDITION FILE: "_COUNT)
I COUNT=1150 D BMES^XPDUTL("ALL ENTRIES ADDED FROM SCRATCH SUCCESSFULY")
I COUNT'=1150,COUNT'=0 D BMES^XPDUTL("Entry totals not equal 1150 - Please check all Entries Loaded")
Q
;
SETVER ; Set ICD version on first entries
N IEN,ICDVER
F IEN=0:0 S IEN=$O(^ACK(509850.1,IEN)) Q:'IEN D
. S ICDVER=$$CSI^ICDEX(80,IEN)
. S $P(^ACK(509850.1,IEN,0),"^",7)=ICDVER Q
Q
;
EN ; - Store Diagnosis DATA in file 509850.1
N ACKLAYGO,DGI,TEXT,TYPE,ICDCODE,ICDIEN,DESC,DIC,DA,X,Y,IEN,OKAY,ERR
S Y=1,COUNT=0
N ROU F ROU="ACKQ3P22","ACKQ3P23","ACKQ3P24","ACKQ3P25","ACKQ3P26","ACKQ3P27","ACKQ3P28","ACKQ3P29","ACKQ3P30","ACKQ3P31" F DGI=1:1 S TEXT=$P($T(@("DIAG+"_DGI_"^"_ROU)),";;",2,3) Q:TEXT="" D
. S TYPE=$P(TEXT,"^",1)
. S ICDCODE=$P(TEXT,"^",2)
. S DESC=$P(TEXT,"^",3)
. S ICDIEN=+$$CODEN^ICDEX(ICDCODE,80)
. I ICDIEN<1 W !,ICDCODE Q
. I '$O(^ACK(509850.1,"B",ICDIEN,0)) D
.. K DIC,DA,DR,DD,DO,X,DINUM
.. S DINUM=ICDIEN
.. S DIC=509850.1,DIC(0)="LEFZ",X=ICDIEN,ACKLAYGO=1
.. ;S DIC("DR")="1///"_$E(TYPE,1)_";8////"_ICDCODE_";10////"_DESC_";3///"_ICDCODE_";9////30"
.. S DIC("DR")=".04///SA;.06///1"
.. D FILE^DICN S IEN=+Y
.. I +Y>0 W "." S COUNT=COUNT+1
.. I Y=-1 S ERR=$G(ERR)+1
Q
;
PURG ; -- CLEAN OUT ENTRIES TO TRY AGAIN
; - FOR development and testing only
N CNT,CNT2
S CNT=0
D PURGV,PURGD
W !,"Entries Deleted - Diagnosis=",$G(CNT)
Q
PURGV ; delete version from entries
N IEN,ICDVER
F IEN=0:0 S IEN=$O(^ACK(509850.1,IEN)) Q:'IEN I $G(^ACK(509850.1,IEN,0))'="" S $P(^ACK(509850.1,IEN,0),"^",7)=""
Q
PURGD ; clear out data added to retest
N DIC,DIE,TEXT,ICDCODE,DA,DR,IEN,DIK
;F DGI=1:1 S TEXT=$P($T(DIAG+DGI^ACKQ3P22),";;",2,3) Q:TEXT="" D
N DGI,ROU F ROU="ACKQ3P22","ACKQ3P23","ACKQ3P24","ACKQ3P25","ACKQ3P26","ACKQ3P27","ACKQ3P28","ACKQ3P29","ACKQ3P30","ACKQ3P31" F DGI=1:1 S TEXT=$P($T(@("DIAG+"_DGI_"^"_ROU)),";;",2,3) Q:TEXT="" D
. S ICDCODE=$P(TEXT,"^",2)
. S IEN=+$$CODEN^ICDEX(ICDCODE,80)
. ;S DIC=509850.1,DIC(0)="EMN",X=ICDCODE D ^DIC S IEN=+Y
. ;K DIC(0)
. Q:'$D(^ACK(509850.1,IEN,0))
. S DIK="^ACK(509850.1,",DA=IEN D ^DIK
. S CNT=$G(CNT)+1
. W "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQ3P21 2722 printed Dec 13, 2024@02:31:31 Page 2
ACKQ3P21 ;ALB/CLA - IMPORT WIZARD FOR ICD-10 CODES INTO FILE 509850.1;31 Mar 2014 9:55 AM
+1 ;;3.0;QUASAR;**21**;Feb 11, 2000;Build 40
+2 ;
+3 ; Reference/IA
+4 ; $$CODEN^ICDEX - 5747
+5 ; $$CSI^ICDEX - 5747
+6 ;
% ; - Top level entry point
+1 NEW COUNT,COUNT2
+2 DO BMES^XPDUTL("Adding Entries to A&SP DIAGNOSTIC CONDITION FILE")
+3 DO SETVER
DO EN
+4 IF COUNT=0
Begin DoDot:1
+5 DO BMES^XPDUTL("ICD-10 Entries Already in File...Install Step to Add Entries Skipped")
End DoDot:1
QUIT
+6 DO MES^XPDUTL(" Total Diagnosis Entries added to A&SP DIAGNOSTIC CONDITION FILE: "_COUNT)
+7 IF COUNT=1150
DO BMES^XPDUTL("ALL ENTRIES ADDED FROM SCRATCH SUCCESSFULY")
+8 IF COUNT'=1150
IF COUNT'=0
DO BMES^XPDUTL("Entry totals not equal 1150 - Please check all Entries Loaded")
+9 QUIT
+10 ;
SETVER ; Set ICD version on first entries
+1 NEW IEN,ICDVER
+2 FOR IEN=0:0
SET IEN=$ORDER(^ACK(509850.1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET ICDVER=$$CSI^ICDEX(80,IEN)
+4 SET $PIECE(^ACK(509850.1,IEN,0),"^",7)=ICDVER
QUIT
End DoDot:1
+5 QUIT
+6 ;
EN ; - Store Diagnosis DATA in file 509850.1
+1 NEW ACKLAYGO,DGI,TEXT,TYPE,ICDCODE,ICDIEN,DESC,DIC,DA,X,Y,IEN,OKAY,ERR
+2 SET Y=1
SET COUNT=0
+3 NEW ROU
FOR ROU="ACKQ3P22","ACKQ3P23","ACKQ3P24","ACKQ3P25","ACKQ3P26","ACKQ3P27","ACKQ3P28","ACKQ3P29","ACKQ3P30","ACKQ3P31"
FOR DGI=1:1
SET TEXT=$PIECE($TEXT(@("DIAG+"_DGI_"^"_ROU)),";;",2,3)
if TEXT=""
QUIT
Begin DoDot:1
+4 SET TYPE=$PIECE(TEXT,"^",1)
+5 SET ICDCODE=$PIECE(TEXT,"^",2)
+6 SET DESC=$PIECE(TEXT,"^",3)
+7 SET ICDIEN=+$$CODEN^ICDEX(ICDCODE,80)
+8 IF ICDIEN<1
WRITE !,ICDCODE
QUIT
+9 IF '$ORDER(^ACK(509850.1,"B",ICDIEN,0))
Begin DoDot:2
+10 KILL DIC,DA,DR,DD,DO,X,DINUM
+11 SET DINUM=ICDIEN
+12 SET DIC=509850.1
SET DIC(0)="LEFZ"
SET X=ICDIEN
SET ACKLAYGO=1
+13 ;S DIC("DR")="1///"_$E(TYPE,1)_";8////"_ICDCODE_";10////"_DESC_";3///"_ICDCODE_";9////30"
+14 SET DIC("DR")=".04///SA;.06///1"
+15 DO FILE^DICN
SET IEN=+Y
+16 IF +Y>0
WRITE "."
SET COUNT=COUNT+1
+17 IF Y=-1
SET ERR=$GET(ERR)+1
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
PURG ; -- CLEAN OUT ENTRIES TO TRY AGAIN
+1 ; - FOR development and testing only
+2 NEW CNT,CNT2
+3 SET CNT=0
+4 DO PURGV
DO PURGD
+5 WRITE !,"Entries Deleted - Diagnosis=",$GET(CNT)
+6 QUIT
PURGV ; delete version from entries
+1 NEW IEN,ICDVER
+2 FOR IEN=0:0
SET IEN=$ORDER(^ACK(509850.1,IEN))
if 'IEN
QUIT
IF $GET(^ACK(509850.1,IEN,0))'=""
SET $PIECE(^ACK(509850.1,IEN,0),"^",7)=""
+3 QUIT
PURGD ; clear out data added to retest
+1 NEW DIC,DIE,TEXT,ICDCODE,DA,DR,IEN,DIK
+2 ;F DGI=1:1 S TEXT=$P($T(DIAG+DGI^ACKQ3P22),";;",2,3) Q:TEXT="" D
+3 NEW DGI,ROU
FOR ROU="ACKQ3P22","ACKQ3P23","ACKQ3P24","ACKQ3P25","ACKQ3P26","ACKQ3P27","ACKQ3P28","ACKQ3P29","ACKQ3P30","ACKQ3P31"
FOR DGI=1:1
SET TEXT=$PIECE($TEXT(@("DIAG+"_DGI_"^"_ROU)),";;",2,3)
if TEXT=""
QUIT
Begin DoDot:1
+4 SET ICDCODE=$PIECE(TEXT,"^",2)
+5 SET IEN=+$$CODEN^ICDEX(ICDCODE,80)
+6 ;S DIC=509850.1,DIC(0)="EMN",X=ICDCODE D ^DIC S IEN=+Y
+7 ;K DIC(0)
+8 if '$DATA(^ACK(509850.1,IEN,0))
QUIT
+9 SET DIK="^ACK(509850.1,"
SET DA=IEN
DO ^DIK
+10 SET CNT=$GET(CNT)+1
+11 WRITE "."
End DoDot:1
+12 QUIT
