BLRICDO ; IHS/OIT/MKK - ICDO Global Utilities ; 17-Oct-2014 09:22 ; MKK
;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88
;
; This routine creates the ^BLRICDO global for the Input Transform for Field .07 file 61.
;
; ICD-10 Codes retrieved from http://seer.cancer.gov/tools/conversion/
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
;
CLEANSET ; EP
; This subroutine is called during the post-install phase of LR*5.2*1034.
; It first creates the ^BLRICDO (see SETUP below).
; It then purges all non-valid ICD codes from ^BLRICDO (see SILPURGE below).
;
D SETUP
D SILPURGE
Q
;
;
SETUP ; EP
; This subroutine creates the ^BLRICDO global with the necessary ICDO codes
; so that the input transform subroutine (see ICDO below) can use it instead
; of having to create an array every time it is accessed.
;
NEW CODE,GLOBAL,I,SUB,X
;
S GLOBAL="^BLRICDO"
K @GLOBAL
;
; The following are ICD-9 codes.
; They were determined by the original Input Transform.
F CODE=140:1:199 F SUB=1:1:99 S X=CODE_"."_SUB I X?3N1"."1N D STUFFIT(CODE_".",SUB)
;
; The following are ICD-10 codes from seer.cancer.gov
; are equivalent to the ICD-9 codes above.
F I=0,1,2,3,4,5,6,8,9 D STUFFIT("C00.",I)
D STUFFIT("C01.",9)
F I=0,1,2,3,4,8,9 D STUFFIT("C02.",I)
F I=0,1,9 D STUFFIT("C03.",I)
F I=0,1,8,9 D STUFFIT("C04.",I)
F I=0,1,2,8,9 D STUFFIT("C05.",I)
F I=0,1,2,8,9 D STUFFIT("C06.",I)
D STUFFIT("C07.",9)
F I=0,1,8,9 D STUFFIT("C08.",I)
F I=0,1,8,9 D STUFFIT("C09.",I)
F I=4,8,9 D STUFFIT("C10.",I)
F I=0,1,2,3,8,9 D STUFFIT("C11.",I)
D STUFFIT("C12.",9)
F I=0,1,2,8,9 D STUFFIT("C13.",I)
F I=0,2,8 D STUFFIT("C14.",I)
F I=0,1,2,3,4,5,8,9 D STUFFIT("C15.",I)
F I=0,1,2,3,4,5,6,8,9 D STUFFIT("C16.",I)
F I=0,1,2,3,8,9 D STUFFIT("C17.",I)
F I=0:1:9 D STUFFIT("C18.",I)
D STUFFIT("C19.",9)
D STUFFIT("C20.")
F I=0,1,8 D STUFFIT("C21.",I)
F I=0,1 D STUFFIT("C22.",I)
D STUFFIT("C23.",9)
F I=0,1,8,9 D STUFFIT("C24.",I)
F I=0,1,2,3,4,5,7,8,9 D STUFFIT("C25.",I)
F I=0,1,9 D STUFFIT("C26.",I)
Q
;
;
STUFFIT(CODE,SUB) ; EP - Create and "stuff" resulting code into ^BLRICDO
S ^BLRICDO(CODE_$G(SUB))=""
Q
;
;
ICHEKALL ; EP - Interactively CHEcK ALL the codes in ^BLRICDO
; This is to ensure that the codes are in the ICD DIAGNOSIS (#80) dictionary.
; If the code is in ^BLRICDO but not in File 80, delete it from ^BLRICDO
;
NEW CNT,GLOBAL,HEADER,ICD,KILLER,PURGED
;
S GLOBAL="^BLRICDO"
;
S HEADER(1)="ICDO Codes"
S HEADER(2)="Data File Analysis"
D HEADERDT^BLRGMENU
S ICD=""
S (CNT,PURGED)=0
;
W ?4,"Analysis "
F S ICD=$O(^BLRICDO(ICD)) Q:ICD="" D
. S CNT=CNT+1
. W:(CNT#10)=0 "." W:$X>74 !,?4
. ;
. Q:+$$ICDDX^ICDEX(ICD)>0 ; Valid code
. ;
. S PURGED(ICD)=""
. S PURGED=PURGED+1
;
W !!,?4,CNT," Codes Analyzed.",!!
I PURGED=0 W ?9,"No Codes Purged.",!
E D
. W ?9,"The following ",PURGED," codes will be purged from the ^BLRICDO global.",!!,?14
. S ICD=""
. F S ICD=$O(PURGED(ICD)) Q:ICD="" D
.. W $$LJ^XLFSTR(ICD,7)
.. W:$X>64 !,?14
.. S ICDSTR=ICD
.. S:$E(ICD)?1A!($P(ICD,".",2)="0") ICDSTR=$C(34)_ICD_$C(34)
.. S KILLER=GLOBAL_"("_ICDSTR_")"
.. K @KILLER
;
D PRESSKEY^BLRGMENU(4)
Q
;
SILPURGE ; EP - SILent Purge of BLRICDO dictionary
; This is to ensure that the codes are in the ICD DIAGNOSIS (#80) dictionary.
; If the code is in ^BLRICDO but not in File 80, delete it from ^BLRICDO
;
NEW CNT,GLOBAL,ICD,KILLER,PURGED
;
S GLOBAL="^BLRICDO"
;
S ICD=""
S (CNT,PURGED)=0
;
F S ICD=$O(^BLRICDO(ICD)) Q:ICD="" D
. S CNT=CNT+1
. ;
. Q:+$$ICDDX^ICDEX(ICD)>0 ; Valid code
. ;
. S PURGED(ICD)=""
. S PURGED=PURGED+1
;
I PURGED D
. S ICD=""
. F S ICD=$O(PURGED(ICD)) Q:ICD="" D
.. S ICDSTR=ICD
.. S:$E(ICD)?1A!($P(ICD,".",2)="0") ICDSTR=$C(34)_ICD_$C(34)
.. S KILLER=GLOBAL_"("_ICDSTR_")"
.. K @KILLER
Q
;
;
ICDO(X) ; EP - Input Transform for field .07 file 61
;X is the value entered by the user, this subroutine checks to make
;sure that the value matches a valid code. This function evaluates
;to true if X is okay, false if X is not valid.
Q $D(^BLRICDO(X))
BLRICDO ; IHS/OIT/MKK - ICDO Global Utilities ; 17-Oct-2014 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88
+2 ;
+3 ; This routine creates the ^BLRICDO global for the Input Transform for Field .07 file 61.
+4 ;
+5 ; ICD-10 Codes retrieved from http://seer.cancer.gov/tools/conversion/
+6 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
+4 ;
CLEANSET ; EP
+1 ; This subroutine is called during the post-install phase of LR*5.2*1034.
+2 ; It first creates the ^BLRICDO (see SETUP below).
+3 ; It then purges all non-valid ICD codes from ^BLRICDO (see SILPURGE below).
+4 ;
+5 DO SETUP
+6 DO SILPURGE
+7 QUIT
+8 ;
+9 ;
SETUP ; EP
+1 ; This subroutine creates the ^BLRICDO global with the necessary ICDO codes
+2 ; so that the input transform subroutine (see ICDO below) can use it instead
+3 ; of having to create an array every time it is accessed.
+4 ;
+5 NEW CODE,GLOBAL,I,SUB,X
+6 ;
+7 SET GLOBAL="^BLRICDO"
+8 KILL @GLOBAL
+9 ;
+10 ; The following are ICD-9 codes.
+11 ; They were determined by the original Input Transform.
+12 FOR CODE=140:1:199
FOR SUB=1:1:99
SET X=CODE_"."_SUB
IF X?3N1"."1N
DO STUFFIT(CODE_".",SUB)
+13 ;
+14 ; The following are ICD-10 codes from seer.cancer.gov
+15 ; are equivalent to the ICD-9 codes above.
+16 FOR I=0,1,2,3,4,5,6,8,9
DO STUFFIT("C00.",I)
+17 DO STUFFIT("C01.",9)
+18 FOR I=0,1,2,3,4,8,9
DO STUFFIT("C02.",I)
+19 FOR I=0,1,9
DO STUFFIT("C03.",I)
+20 FOR I=0,1,8,9
DO STUFFIT("C04.",I)
+21 FOR I=0,1,2,8,9
DO STUFFIT("C05.",I)
+22 FOR I=0,1,2,8,9
DO STUFFIT("C06.",I)
+23 DO STUFFIT("C07.",9)
+24 FOR I=0,1,8,9
DO STUFFIT("C08.",I)
+25 FOR I=0,1,8,9
DO STUFFIT("C09.",I)
+26 FOR I=4,8,9
DO STUFFIT("C10.",I)
+27 FOR I=0,1,2,3,8,9
DO STUFFIT("C11.",I)
+28 DO STUFFIT("C12.",9)
+29 FOR I=0,1,2,8,9
DO STUFFIT("C13.",I)
+30 FOR I=0,2,8
DO STUFFIT("C14.",I)
+31 FOR I=0,1,2,3,4,5,8,9
DO STUFFIT("C15.",I)
+32 FOR I=0,1,2,3,4,5,6,8,9
DO STUFFIT("C16.",I)
+33 FOR I=0,1,2,3,8,9
DO STUFFIT("C17.",I)
+34 FOR I=0:1:9
DO STUFFIT("C18.",I)
+35 DO STUFFIT("C19.",9)
+36 DO STUFFIT("C20.")
+37 FOR I=0,1,8
DO STUFFIT("C21.",I)
+38 FOR I=0,1
DO STUFFIT("C22.",I)
+39 DO STUFFIT("C23.",9)
+40 FOR I=0,1,8,9
DO STUFFIT("C24.",I)
+41 FOR I=0,1,2,3,4,5,7,8,9
DO STUFFIT("C25.",I)
+42 FOR I=0,1,9
DO STUFFIT("C26.",I)
+43 QUIT
+44 ;
+45 ;
STUFFIT(CODE,SUB) ; EP - Create and "stuff" resulting code into ^BLRICDO
+1 SET ^BLRICDO(CODE_$GET(SUB))=""
+2 QUIT
+3 ;
+4 ;
ICHEKALL ; EP - Interactively CHEcK ALL the codes in ^BLRICDO
+1 ; This is to ensure that the codes are in the ICD DIAGNOSIS (#80) dictionary.
+2 ; If the code is in ^BLRICDO but not in File 80, delete it from ^BLRICDO
+3 ;
+4 NEW CNT,GLOBAL,HEADER,ICD,KILLER,PURGED
+5 ;
+6 SET GLOBAL="^BLRICDO"
+7 ;
+8 SET HEADER(1)="ICDO Codes"
+9 SET HEADER(2)="Data File Analysis"
+10 DO HEADERDT^BLRGMENU
+11 SET ICD=""
+12 SET (CNT,PURGED)=0
+13 ;
+14 WRITE ?4,"Analysis "
+15 FOR
SET ICD=$ORDER(^BLRICDO(ICD))
IF ICD=""
QUIT
Begin DoDot:1
+16 SET CNT=CNT+1
+17 IF (CNT#10)=0
WRITE "."
IF $X>74
WRITE !,?4
+18 ;
+19 ; Valid code
IF +$$ICDDX^ICDEX(ICD)>0
QUIT
+20 ;
+21 SET PURGED(ICD)=""
+22 SET PURGED=PURGED+1
End DoDot:1
+23 ;
+24 WRITE !!,?4,CNT," Codes Analyzed.",!!
+25 IF PURGED=0
WRITE ?9,"No Codes Purged.",!
+26 IF '$TEST
Begin DoDot:1
+27 WRITE ?9,"The following ",PURGED," codes will be purged from the ^BLRICDO global.",!!,?14
+28 SET ICD=""
+29 FOR
SET ICD=$ORDER(PURGED(ICD))
IF ICD=""
QUIT
Begin DoDot:2
+30 WRITE $$LJ^XLFSTR(ICD,7)
+31 IF $X>64
WRITE !,?14
+32 SET ICDSTR=ICD
+33 IF $EXTRACT(ICD)?1A!($PIECE(ICD,".",2)="0")
SET ICDSTR=$CHAR(34)_ICD_$CHAR(34)
+34 SET KILLER=GLOBAL_"("_ICDSTR_")"
+35 KILL @KILLER
End DoDot:2
End DoDot:1
+36 ;
+37 DO PRESSKEY^BLRGMENU(4)
+38 QUIT
+39 ;
SILPURGE ; EP - SILent Purge of BLRICDO dictionary
+1 ; This is to ensure that the codes are in the ICD DIAGNOSIS (#80) dictionary.
+2 ; If the code is in ^BLRICDO but not in File 80, delete it from ^BLRICDO
+3 ;
+4 NEW CNT,GLOBAL,ICD,KILLER,PURGED
+5 ;
+6 SET GLOBAL="^BLRICDO"
+7 ;
+8 SET ICD=""
+9 SET (CNT,PURGED)=0
+10 ;
+11 FOR
SET ICD=$ORDER(^BLRICDO(ICD))
IF ICD=""
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 ;
+14 ; Valid code
IF +$$ICDDX^ICDEX(ICD)>0
QUIT
+15 ;
+16 SET PURGED(ICD)=""
+17 SET PURGED=PURGED+1
End DoDot:1
+18 ;
+19 IF PURGED
Begin DoDot:1
+20 SET ICD=""
+21 FOR
SET ICD=$ORDER(PURGED(ICD))
IF ICD=""
QUIT
Begin DoDot:2
+22 SET ICDSTR=ICD
+23 IF $EXTRACT(ICD)?1A!($PIECE(ICD,".",2)="0")
SET ICDSTR=$CHAR(34)_ICD_$CHAR(34)
+24 SET KILLER=GLOBAL_"("_ICDSTR_")"
+25 KILL @KILLER
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
+28 ;
ICDO(X) ; EP - Input Transform for field .07 file 61
+1 ;X is the value entered by the user, this subroutine checks to make
+2 ;sure that the value matches a valid code. This function evaluates
+3 ;to true if X is okay, false if X is not valid.
+4 QUIT $DATA(^BLRICDO(X))
