LREPICD.m

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 ---LREPICD   1347     printed  Apr 09, 2024@21:25:54                                                                                                                                                                                                     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       ;