LR421P ;DALISC/SED - LR*5.2*421 PATCH POST INIT ROUTINE ;10 Oct 2013 4:49 PM
;;5.2;LAB SERVICE;**421**;Sep 27, 1994;Build 48
EN ;
D BMES^XPDUTL("**** ICD 10 Remediation****")
D BMES^XPDUTL("**Updating Emerging Pathogen File (69.5) with ICD Codes**")
CONVERT ;
S LRCSYS="10D"
I $T(^LREPICD)]"" D ICDCONVT^LREPICD
ICD ;Add the ICD codes to the file.
;SET CURRENT CODES TO APPROPRIATE CODE SYSTEMS
N LRICDDA,LRICDCOD K LRPATH S LRPATH=0 F S LRPATH=$O(^LAB(69.5,LRPATH)) Q:+LRPATH=0 D
.I $D(^LAB(69.5,LRPATH,3)) S LRICDDA=0 F S LRICDDA=$O(^LAB(69.5,LRPATH,3,LRICDDA)) Q:+LRICDDA=0 D
..K LRSET S LRICDCOD=+(^LAB(69.5,LRPATH,3,LRICDDA,0)),LRSET=$$CSI^ICDEX(80,LRICDCOD)
..S DIE="^LAB(69.5,"_LRPATH_",3,",DA=LRICDDA,DR="1////"_LRSET D ^DIE
.Q
;LEISHMANIASIS PATH14
S LRPATH=14
F LRICDNO=0,1,2,9 S LREPICDX="B55."_LRICDNO_" ",LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80) D
.Q:+LRICDIEN'>0
.S LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
.Q:+LRTMP<0
.D SETIC(LRICDIEN)
;MALARIA PATH11
S LRPATH=11
F LREPICDX="B50.0 ","B50.8 ","B50.9 ","B51.0 ","B51.8 ","B51.9 ","B52.0 ","B52.8 ","B52.9 ","B53.0 ","B53.1 ","B53.8 ","B54. " S LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80) D
.Q:+LRICDIEN'>0
.S LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
.Q:+LRTMP<0
.D SETIC(LRICDIEN)
;DENGUE PATH12
S LRPATH=12
F LREPICDX="A90. ","A91. ","A93.8 " S LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80) D
.Q:+LRICDIEN'>0
.S LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
.Q:+LRTMP<0
.D SETIC(LRICDIEN)
;
;JAKOB-CREUTZFELDT DIS PATH13
S LRPATH=13
F LREPICDX="A81.00 ","A81.01 ","A81.09 ","A81.1 ","A81.2 ","A81.81 ","A81.82 ","A81.83 ","A81.89 ","A81.9 " S LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80) D
.Q:+LRICDIEN'>0
.S LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
.Q:+LRTMP<0
.D SETIC(LRICDIEN)
;
;LEGIONELLA PATH7
S LRPATH=7
F LREPICDX="A48.1 ","A48.2 ","A48.8 " S LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80) D
.Q:+LRICDIEN'>0
.S LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
.Q:+LRTMP<0
.D SETIC(LRICDIEN)
;
;CRYPTOSPORIDIUM PATH9
S LRPATH=9
F LREPICDX="A07.2 ","A07.9 " S LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80) D
.Q:+LRICDIEN'>0
.S LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
.Q:+LRTMP<0
.D SETIC(LRICDIEN)
;
EXIT K LRPATH,LRINT,X,Y,DA,DIC,DIE,DR,LRICDNO,DD,LRCSYS,LREPICDX,LRICDIEN
K LRND,LRNDM,LRANT,LRTMP,LRMSG,LRANM
;
Q
SETIC(LRINT) ;ADD THE ENTRY FOR ICD
Q:$D(^LAB(69.5,LRPATH,3,"B",LRINT))
S LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRINT,,)
Q:LRTMP'>0
S LRMSG="Adding "_$P(LRTMP,U,2)_" "_$P(LRTMP,U,4)_" into "
S LRMSG=LRMSG_$P(^LAB(69.5,LRPATH,0),U,1)
D BMES^XPDUTL(LRMSG)
K DD
S DIC="^LAB(69.5,"_LRPATH_",3,",DIC(0)="L",X=LRINT
S DIC("P")=$P(^DD(69.5,4,0),U,2),DA(1)=LRPATH
D FILE^DICN
S DIE="^LAB(69.5,"_LRPATH_",3,",DR="1////"_$P(LRTMP,U,20) D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR421P 2843 printed Apr 09, 2024@21:23:53 Page 2
LR421P ;DALISC/SED - LR*5.2*421 PATCH POST INIT ROUTINE ;10 Oct 2013 4:49 PM
+1 ;;5.2;LAB SERVICE;**421**;Sep 27, 1994;Build 48
EN ;
+1 DO BMES^XPDUTL("**** ICD 10 Remediation****")
+2 DO BMES^XPDUTL("**Updating Emerging Pathogen File (69.5) with ICD Codes**")
CONVERT ;
+1 SET LRCSYS="10D"
+2 IF $TEXT(^LREPICD)]""
DO ICDCONVT^LREPICD
ICD ;Add the ICD codes to the file.
+1 ;SET CURRENT CODES TO APPROPRIATE CODE SYSTEMS
+2 NEW LRICDDA,LRICDCOD
KILL LRPATH
SET LRPATH=0
FOR
SET LRPATH=$ORDER(^LAB(69.5,LRPATH))
if +LRPATH=0
QUIT
Begin DoDot:1
+3 IF $DATA(^LAB(69.5,LRPATH,3))
SET LRICDDA=0
FOR
SET LRICDDA=$ORDER(^LAB(69.5,LRPATH,3,LRICDDA))
if +LRICDDA=0
QUIT
Begin DoDot:2
+4 KILL LRSET
SET LRICDCOD=+(^LAB(69.5,LRPATH,3,LRICDDA,0))
SET LRSET=$$CSI^ICDEX(80,LRICDCOD)
+5 SET DIE="^LAB(69.5,"_LRPATH_",3,"
SET DA=LRICDDA
SET DR="1////"_LRSET
DO ^DIE
End DoDot:2
+6 QUIT
End DoDot:1
+7 ;LEISHMANIASIS PATH14
+8 SET LRPATH=14
+9 FOR LRICDNO=0,1,2,9
SET LREPICDX="B55."_LRICDNO_" "
SET LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80)
Begin DoDot:1
+10 if +LRICDIEN'>0
QUIT
+11 SET LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
+12 if +LRTMP<0
QUIT
+13 DO SETIC(LRICDIEN)
End DoDot:1
+14 ;MALARIA PATH11
+15 SET LRPATH=11
+16 FOR LREPICDX="B50.0 ","B50.8 ","B50.9 ","B51.0 ","B51.8 ","B51.9 ","B52.0 ","B52.8 ","B52.9 ","B53.0 ","B53.1 ","B53.8 ","B54. "
SET LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80)
Begin DoDot:1
+17 if +LRICDIEN'>0
QUIT
+18 SET LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
+19 if +LRTMP<0
QUIT
+20 DO SETIC(LRICDIEN)
End DoDot:1
+21 ;DENGUE PATH12
+22 SET LRPATH=12
+23 FOR LREPICDX="A90. ","A91. ","A93.8 "
SET LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80)
Begin DoDot:1
+24 if +LRICDIEN'>0
QUIT
+25 SET LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
+26 if +LRTMP<0
QUIT
+27 DO SETIC(LRICDIEN)
End DoDot:1
+28 ;
+29 ;JAKOB-CREUTZFELDT DIS PATH13
+30 SET LRPATH=13
+31 FOR LREPICDX="A81.00 ","A81.01 ","A81.09 ","A81.1 ","A81.2 ","A81.81 ","A81.82 ","A81.83 ","A81.89 ","A81.9 "
SET LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80)
Begin DoDot:1
+32 if +LRICDIEN'>0
QUIT
+33 SET LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
+34 if +LRTMP<0
QUIT
+35 DO SETIC(LRICDIEN)
End DoDot:1
+36 ;
+37 ;LEGIONELLA PATH7
+38 SET LRPATH=7
+39 FOR LREPICDX="A48.1 ","A48.2 ","A48.8 "
SET LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80)
Begin DoDot:1
+40 if +LRICDIEN'>0
QUIT
+41 SET LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
+42 if +LRTMP<0
QUIT
+43 DO SETIC(LRICDIEN)
End DoDot:1
+44 ;
+45 ;CRYPTOSPORIDIUM PATH9
+46 SET LRPATH=9
+47 FOR LREPICDX="A07.2 ","A07.9 "
SET LRICDIEN=+$$CODEN^ICDEX(LREPICDX,80)
Begin DoDot:1
+48 if +LRICDIEN'>0
QUIT
+49 SET LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRICDIEN,,)
+50 if +LRTMP<0
QUIT
+51 DO SETIC(LRICDIEN)
End DoDot:1
+52 ;
EXIT KILL LRPATH,LRINT,X,Y,DA,DIC,DIE,DR,LRICDNO,DD,LRCSYS,LREPICDX,LRICDIEN
+1 KILL LRND,LRNDM,LRANT,LRTMP,LRMSG,LRANM
+2 ;
+3 QUIT
SETIC(LRINT) ;ADD THE ENTRY FOR ICD
+1 if $DATA(^LAB(69.5,LRPATH,3,"B",LRINT))
QUIT
+2 SET LRTMP=$$ICDDATA^ICDXCODE(LRCSYS,LRINT,,)
+3 if LRTMP'>0
QUIT
+4 SET LRMSG="Adding "_$PIECE(LRTMP,U,2)_" "_$PIECE(LRTMP,U,4)_" into "
+5 SET LRMSG=LRMSG_$PIECE(^LAB(69.5,LRPATH,0),U,1)
+6 DO BMES^XPDUTL(LRMSG)
+7 KILL DD
+8 SET DIC="^LAB(69.5,"_LRPATH_",3,"
SET DIC(0)="L"
SET X=LRINT
+9 SET DIC("P")=$PIECE(^DD(69.5,4,0),U,2)
SET DA(1)=LRPATH
+10 DO FILE^DICN
+11 SET DIE="^LAB(69.5,"_LRPATH_",3,"
SET DR="1////"_$PIECE(LRTMP,U,20)
DO ^DIE
+12 QUIT
