ICDEXC4.m

ICDEXC4 ;SLC/KER - ICD Extractor - Code APIs (cont) ;04/21/2014

 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7

 ;               

 ; Global Variables

 ;    None

 ;               

 ; External References

 ;    None

 ;               

 Q

SDH(FILE,IEN,ARY) ; Short Description History

 ;            

 ; Input:

 ; 

 ;   FILE    File Number (Required)

 ;   IEN     Internal Entry Number (Required)

 ;  .ARY     Array Passed by Reference (Optional)

 ;   

 ; Output:

 ; 

 ;   $$SDH   This is a three piece "^" delimited 

 ;           string containing:

 ;           

 ;              1   Number of short descriptions found

 ;              2   The earliest date found

 ;              3   The latest date found

 ;              

 ;           OR -1 ^ Error Message

 ;           

 ;   ARY     Short Descriptions by date

 ;   

 ;              ARY(0)= # ^ Earliest Date ^ Latest Date

 ;              ARY(DATE)=Long Description

 ;   

 K ARY N EFF,TXT,HIS,ROOT,CNT,FD,LD,BEG,END S IEN=+($G(IEN)),LD=0,FD=9999999

 S FILE=$$FILE^ICDEX($G(FILE)) Q:"^80^80.1^"'[("^"_FILE_"^") "-1^File not found"

 S ROOT=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")

 Q:'$L(ROOT) "-1^File not found"  S CNT=0

 S HIS=0 F  S HIS=$O(@(ROOT_+IEN_",67,"_+HIS_")")) Q:+HIS'>0  D

 . N NOD,EFF,TXT S NOD=$G(@(ROOT_+IEN_",67,"_+HIS_",0)"))

 . S EFF=$P(NOD,"^",1),TXT=$P(NOD,"^",2) Q:EFF'?7N  Q:'$L(TXT)

 . S:EFF<FD FD=EFF  S:EFF>LD LD=EFF

 . S CNT=CNT+1,ARY(0)=CNT,ARY(EFF)=TXT

 S (BEG,END)="" S:FD?7N&(FD'=9999999)&(FD'>LD) BEG=FD S:LD?7N&(LD'<FD) END=LD

 S:BEG?7N&(END?7N)&(CNT>0) ARY(0)=CNT_"^"_BEG_"^"_END S CNT=ARY(0)

 I +CNT'>0 D  Q ERR

 . N TYP S TYP=$S(FILE=80:"Diagnosis",FILE=80.1:"Operation/Procedure",1:"")

 . S:$L(TYP) ERR="-1^No "_TYP_" Short Descriptions found"

 . S:'$L(TYP) ERR="-1^No Short Descriptions found"

 Q CNT

LDH(FILE,IEN,ARY) ; Long Description History

 ;            

 ; Input:

 ; 

 ;   FILE    File Number (Required)

 ;   IEN     Internal Entry Number (Required)

 ;  .ARY     Array Passed by Reference (Optional)

 ;  

 ; Output:

 ; 

 ;   $$LDH   This is a three piece "^" delimited 

 ;           string containing:

 ;           

 ;             1   Number of long descriptions found

 ;             2   The earliest date found

 ;             3   The latest date found

 ;              

 ;           OR -1 ^ Error Message

 ;           

 ;   ARY     Long Descriptions by date

 ;   

 ;             ARY(0)= # ^ Earliest Date ^ Latest Date

 ;             ARY(DATE)=Long Description

 ;              

 K ARY N EFF,TXT,HIS,ROOT,CNT,FD,LD,BEG,END S IEN=+($G(IEN)),LD=0,FD=9999999

 S FILE=$$FILE^ICDEX($G(FILE)) Q:"^80^80.1^"'[("^"_FILE_"^") "-1^File not found"

 S ROOT=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")

 Q:'$L(ROOT) "-1^File not found"  S CNT=0

 S HIS=0 F  S HIS=$O(@(ROOT_+IEN_",68,"_+HIS_")")) Q:+HIS'>0  D

 . N NOD,EFF,TXT S EFF=$P($G(@(ROOT_+IEN_",68,"_+HIS_",0)")),"^",1)

 . S TXT=$P($G(@(ROOT_+IEN_",68,"_+HIS_",1)")),"^",1)

 . Q:EFF'?7N  Q:'$L(TXT)

 . S:EFF<FD FD=EFF  S:EFF>LD LD=EFF

 . S CNT=CNT+1,ARY(0)=CNT,ARY(EFF)=TXT

 S (BEG,END)="" S:FD?7N&(FD'=9999999)&(FD'>LD) BEG=FD S:LD?7N&(LD'<FD) END=LD

 S:BEG?7N&(END?7N)&(CNT>0) ARY(0)=CNT_"^"_BEG_"^"_END S CNT=ARY(0)

 I +CNT'>0 D  Q ERR

 . N TYP S TYP=$S(FILE=80:"Diagnosis",FILE=80.1:"Operation/Procedure",1:"")

 . S:$L(TYP) ERR="-1^No "_TYP_" Long Descriptions found"

 . S:'$L(TYP) ERR="-1^No Long Descriptions found"

 Q CNT

TRIM(X,Y) ; Trim Character

 ;

 ; Input:

 ;

 ;   X     Input String

 ;   Y     Character to Trim (default " ")

 ;

 ; Output:

 ; 

 ;   X     String without Leading/Trailing character Y

 ;

 S X=$G(X) Q:X="" X  S Y=$G(Y) S:'$L(Y) Y=" "

 F  Q:$E(X,1)'=Y  S X=$E(X,2,$L(X))

 F  Q:$E(X,$L(X))'=Y  S X=$E(X,1,($L(X)-1))

 Q X

ICDEXC4   ;SLC/KER - ICD Extractor - Code APIs (cont) ;04/21/2014

 +1       ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7

 +2       ;               

 +3       ; Global Variables

 +4       ;    None

 +5       ;               

 +6       ; External References

 +7       ;    None

 +8       ;               

 +9        QUIT 

SDH(FILE,IEN,ARY) ; Short Description History

 +1       ;            

 +2       ; Input:

 +3       ; 

 +4       ;   FILE    File Number (Required)

 +5       ;   IEN     Internal Entry Number (Required)

 +6       ;  .ARY     Array Passed by Reference (Optional)

 +7       ;   

 +8       ; Output:

 +9       ; 

 +10      ;   $$SDH   This is a three piece "^" delimited 

 +11      ;           string containing:

 +12      ;           

 +13      ;              1   Number of short descriptions found

 +14      ;              2   The earliest date found

 +15      ;              3   The latest date found

 +16      ;              

 +17      ;           OR -1 ^ Error Message

 +18      ;           

 +19      ;   ARY     Short Descriptions by date

 +20      ;   

 +21      ;              ARY(0)= # ^ Earliest Date ^ Latest Date

 +22      ;              ARY(DATE)=Long Description

 +23      ;   

 +24       KILL ARY

           NEW EFF,TXT,HIS,ROOT,CNT,FD,LD,BEG,END

           SET IEN=+($GET(IEN))

           SET LD=0

           SET FD=9999999

 +25       SET FILE=$$FILE^ICDEX($GET(FILE))

           IF "^80^80.1^"'[("^"_FILE_"^")

               QUIT "-1^File not found"

 +26       SET ROOT=$SELECT(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")

 +27       IF '$LENGTH(ROOT)

               QUIT "-1^File not found"

           SET CNT=0

 +28       SET HIS=0

           FOR 

               SET HIS=$ORDER(@(ROOT_+IEN_",67,"_+HIS_")"))

               IF +HIS'>0

                   QUIT 

               Begin DoDot:1

 +29               NEW NOD,EFF,TXT

                   SET NOD=$GET(@(ROOT_+IEN_",67,"_+HIS_",0)"))

 +30               SET EFF=$PIECE(NOD,"^",1)

                   SET TXT=$PIECE(NOD,"^",2)

                   IF EFF'?7N

                       QUIT 

                   IF '$LENGTH(TXT)

                       QUIT 

 +31               IF EFF<FD

                       SET FD=EFF

                   IF EFF>LD

                       SET LD=EFF

 +32               SET CNT=CNT+1

                   SET ARY(0)=CNT

                   SET ARY(EFF)=TXT

               End DoDot:1

 +33       SET (BEG,END)=""

           IF FD?7N&(FD'=9999999)&(FD'>LD)

               SET BEG=FD

           IF LD?7N&(LD'<FD)

               SET END=LD

 +34       IF BEG?7N&(END?7N)&(CNT>0)

               SET ARY(0)=CNT_"^"_BEG_"^"_END

           SET CNT=ARY(0)

 +35       IF +CNT'>0

               Begin DoDot:1

 +36               NEW TYP

                   SET TYP=$SELECT(FILE=80:"Diagnosis",FILE=80.1:"Operation/Procedure",1:"")

 +37               IF $LENGTH(TYP)

                       SET ERR="-1^No "_TYP_" Short Descriptions found"

 +38               IF '$LENGTH(TYP)

                       SET ERR="-1^No Short Descriptions found"

               End DoDot:1

               QUIT ERR

 +39       QUIT CNT

LDH(FILE,IEN,ARY) ; Long Description History

 +1       ;            

 +2       ; Input:

 +3       ; 

 +4       ;   FILE    File Number (Required)

 +5       ;   IEN     Internal Entry Number (Required)

 +6       ;  .ARY     Array Passed by Reference (Optional)

 +7       ;  

 +8       ; Output:

 +9       ; 

 +10      ;   $$LDH   This is a three piece "^" delimited 

 +11      ;           string containing:

 +12      ;           

 +13      ;             1   Number of long descriptions found

 +14      ;             2   The earliest date found

 +15      ;             3   The latest date found

 +16      ;              

 +17      ;           OR -1 ^ Error Message

 +18      ;           

 +19      ;   ARY     Long Descriptions by date

 +20      ;   

 +21      ;             ARY(0)= # ^ Earliest Date ^ Latest Date

 +22      ;             ARY(DATE)=Long Description

 +23      ;              

 +24       KILL ARY

           NEW EFF,TXT,HIS,ROOT,CNT,FD,LD,BEG,END

           SET IEN=+($GET(IEN))

           SET LD=0

           SET FD=9999999

 +25       SET FILE=$$FILE^ICDEX($GET(FILE))

           IF "^80^80.1^"'[("^"_FILE_"^")

               QUIT "-1^File not found"

 +26       SET ROOT=$SELECT(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")

 +27       IF '$LENGTH(ROOT)

               QUIT "-1^File not found"

           SET CNT=0

 +28       SET HIS=0

           FOR 

               SET HIS=$ORDER(@(ROOT_+IEN_",68,"_+HIS_")"))

               IF +HIS'>0

                   QUIT 

               Begin DoDot:1

 +29               NEW NOD,EFF,TXT

                   SET EFF=$PIECE($GET(@(ROOT_+IEN_",68,"_+HIS_",0)")),"^",1)

 +30               SET TXT=$PIECE($GET(@(ROOT_+IEN_",68,"_+HIS_",1)")),"^",1)

 +31               IF EFF'?7N

                       QUIT 

                   IF '$LENGTH(TXT)

                       QUIT 

 +32               IF EFF<FD

                       SET FD=EFF

                   IF EFF>LD

                       SET LD=EFF

 +33               SET CNT=CNT+1

                   SET ARY(0)=CNT

                   SET ARY(EFF)=TXT

               End DoDot:1

 +34       SET (BEG,END)=""

           IF FD?7N&(FD'=9999999)&(FD'>LD)

               SET BEG=FD

           IF LD?7N&(LD'<FD)

               SET END=LD

 +35       IF BEG?7N&(END?7N)&(CNT>0)

               SET ARY(0)=CNT_"^"_BEG_"^"_END

           SET CNT=ARY(0)

 +36       IF +CNT'>0

               Begin DoDot:1

 +37               NEW TYP

                   SET TYP=$SELECT(FILE=80:"Diagnosis",FILE=80.1:"Operation/Procedure",1:"")

 +38               IF $LENGTH(TYP)

                       SET ERR="-1^No "_TYP_" Long Descriptions found"

 +39               IF '$LENGTH(TYP)

                       SET ERR="-1^No Long Descriptions found"

               End DoDot:1

               QUIT ERR

 +40       QUIT CNT

TRIM(X,Y) ; Trim Character

 +1       ;

 +2       ; Input:

 +3       ;

 +4       ;   X     Input String

 +5       ;   Y     Character to Trim (default " ")

 +6       ;

 +7       ; Output:

 +8       ; 

 +9       ;   X     String without Leading/Trailing character Y

 +10      ;

 +11       SET X=$GET(X)

           IF X=""

               QUIT X

           SET Y=$GET(Y)

           IF '$LENGTH(Y)

               SET Y=" "

 +12       FOR 

               IF $EXTRACT(X,1)'=Y

                   QUIT 

               SET X=$EXTRACT(X,2,$LENGTH(X))

 +13       FOR 

               IF $EXTRACT(X,$LENGTH(X))'=Y

                   QUIT 

               SET X=$EXTRACT(X,1,($LENGTH(X)-1))

 +14       QUIT X