LREPICD ;ALB/TEJ - EMERGING PATHOGENS ICD UTILITIES;16 Jun 2013 5:55 PM ; 19 Jun 2013 2:37 AM
;;5.2;LAB SERVICE;**421**;Sep 27, 1994;Build 48
;
; ICR 5747 - $$SINFO^ICDEX API supported by this IA
;
ICDSYS(LREPDOS,LRICDTYP) ;
; Parameters
; input: LREPDOS - date of service (REQ)
; LRICDTYP - code type requested "D"iag/"P"roc)
; output: LRICDSYS - icd system for implementation
; e.g. (3131001,"D")
;
N LRDT,LRCTYP,LRICDSYS
S LRDT=$G(LREPDOS),LRCTYP=$S($G(LRICDTYP)="D":"DIAG",$G(LRICDTYP)="P":"PROC",1:"")
I LRDT']"" S LRICDSYS="-1^P1(DATE) is REQUIRED" G Q1
I LRCTYP']"" S LRICDSYS="-1^P2(CODING_SYSTEM) is REQUIRED" G Q1
; Check date of interest / code type
S LRICDSYS=$P($$SINFO^ICDEX(LRCTYP,LRDT),U,3)
Q1 Q LRICDSYS
ICDCONVT ; Convert File #69.5 "ICD-9" text entries to "ICD"
;
K LREPI695
S LREPI695=0 F S LREPI695=$O(^LAB(69.5,LREPI695)) Q:+LREPI695=0 D
.K LREPITXT S LREPIX=$$GET1^DIQ(69.5,LREPI695_",",15,"","LREPITXT") F LRX=1:1 Q:'$D(^LAB(69.5,LREPI695,8,LRX,0)) D
..S LRTXT=@(LREPIX_"("_LRX_")") D:(LRTXT["ICDM-9")!(LRTXT["ICD-9")
...L +^LAB(69.5,LREPI695):999
...S LRP=$S(LRTXT["ICDM-9":"ICDM-9",1:"ICD-9"),^LAB(69.5,LREPI695,8,LRX,0)=$P(LRTXT,LRP)_"ICD"_$P(LRTXT,LRP,2) W !,^LAB(69.5,LREPI695,8,LRX,0)
...L -^LAB(69.5,LREPI695)
Q2 K LREPIX,LRP,LRTXT,LRX Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPICD 1347 printed Nov 22, 2024@17:24:22 Page 2
LREPICD ;ALB/TEJ - EMERGING PATHOGENS ICD UTILITIES;16 Jun 2013 5:55 PM ; 19 Jun 2013 2:37 AM
+1 ;;5.2;LAB SERVICE;**421**;Sep 27, 1994;Build 48
+2 ;
+3 ; ICR 5747 - $$SINFO^ICDEX API supported by this IA
+4 ;
ICDSYS(LREPDOS,LRICDTYP) ;
+1 ; Parameters
+2 ; input: LREPDOS - date of service (REQ)
+3 ; LRICDTYP - code type requested "D"iag/"P"roc)
+4 ; output: LRICDSYS - icd system for implementation
+5 ; e.g. (3131001,"D")
+6 ;
+7 NEW LRDT,LRCTYP,LRICDSYS
+8 SET LRDT=$GET(LREPDOS)
SET LRCTYP=$SELECT($GET(LRICDTYP)="D":"DIAG",$GET(LRICDTYP)="P":"PROC",1:"")
+9 IF LRDT']""
SET LRICDSYS="-1^P1(DATE) is REQUIRED"
GOTO Q1
+10 IF LRCTYP']""
SET LRICDSYS="-1^P2(CODING_SYSTEM) is REQUIRED"
GOTO Q1
+11 ; Check date of interest / code type
+12 SET LRICDSYS=$PIECE($$SINFO^ICDEX(LRCTYP,LRDT),U,3)
Q1 QUIT LRICDSYS
ICDCONVT ; Convert File #69.5 "ICD-9" text entries to "ICD"
+1 ;
+2 KILL LREPI695
+3 SET LREPI695=0
FOR
SET LREPI695=$ORDER(^LAB(69.5,LREPI695))
if +LREPI695=0
QUIT
Begin DoDot:1
+4 KILL LREPITXT
SET LREPIX=$$GET1^DIQ(69.5,LREPI695_",",15,"","LREPITXT")
FOR LRX=1:1
if '$DATA(^LAB(69.5,LREPI695,8,LRX,0))
QUIT
Begin DoDot:2
+5 SET LRTXT=@(LREPIX_"("_LRX_")")
if (LRTXT["ICDM-9")!(LRTXT["ICD-9")
Begin DoDot:3
+6 LOCK +^LAB(69.5,LREPI695):999
+7 SET LRP=$SELECT(LRTXT["ICDM-9":"ICDM-9",1:"ICD-9")
SET ^LAB(69.5,LREPI695,8,LRX,0)=$PIECE(LRTXT,LRP)_"ICD"_$PIECE(LRTXT,LRP,2)
WRITE !,^LAB(69.5,LREPI695,8,LRX,0)
+8 LOCK -^LAB(69.5,LREPI695)
End DoDot:3
End DoDot:2
End DoDot:1
Q2 KILL LREPIX,LRP,LRTXT,LRX
QUIT
+1 ;
