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
