LEXQIP2 ;ISL/KER - Query - ICD Procedure - Extract ;04/21/2014
;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
;
; Global Variables
; None
;
; External References
; $$MOR^ICDEX ICR 5747
; MD^ICDEX ICR 5747
; $$DT^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
;
; Documented Integration Agreements
;
; Local Variables NEWed or KILLed in LEXQIP
; LEXINT
;
Q
MDCDRG(X,LEXCDT,LEX,LEXLEN) ; Major Diagnostic Category/DRG
N LEXAI,LEXC,LEXDA,LEXDI,LEXEF,LEXFY,LEXI,LEXIEN,LEXL,LEXLC,LEXMDCC,LEXMDCS,LEXME,LEXMI,LEXN,LEXT
N LEXT1,LEXT2,LEXUD,LEXUM,LEXVDT S LEXVDT=+($G(LEXCDT)) S:LEXVDT'?7N LEXVDT=$$DT^XLFDT K LEXUM,LEXUD,LEX
S LEXLC=0,LEXIEN=+($G(X)),LEXCDT=$G(LEXCDT),LEXLEN=+($G(LEXLEN)) S:+LEXLEN'>0 LEXLEN=62 Q:LEXCDT'?7N
D MD^ICDEX(80.1,+LEXIEN,$G(LEXCDT),.LEXMDCS,"IE")
S LEXMDCC=0,LEXMI=0,(LEXEF,LEXFY)=$O(LEXMDCS(0)) Q:LEXFY'>0
S LEXMI=0 F S LEXMI=$O(LEXMDCS(LEXFY,"E",LEXMI)) Q:+LEXMI'>0 D
. S LEXME=$G(LEXMDCS(LEXFY,"E",LEXMI)) Q:'$L(LEXME)
. S LEXI=$O(LEX(" "),-1)+1,LEX(LEXI)=LEXME
. S LEXDI=0 F S LEXDI=$O(LEXMDCS(LEXFY,"E",LEXMI,LEXDI)) Q:+LEXDI'>0 D
. . K LEXDA S LEXDA(1)=$G(LEXMDCS(LEXFY,"E",LEXMI,LEXDI))
. . D PR^LEXQM(.LEXDA,(LEXLEN-14)) S LEXT1=" DRG "_LEXDI
. . S LEXT1=LEXT1_$J(" ",(14-$L(LEXT1))),LEXT2=$J(" ",14)
. . S (LEXC,LEXI)=0 F S LEXI=$O(LEXDA(LEXI)) Q:+LEXI'>0 D
. . . N LEXT,LEXL,LEXN,LEXAI S LEXT=$$TM^LEXQM($G(LEXDA(LEXI)))
. . . Q:'$L(LEXT) S LEXC=LEXC+1 S:LEXC=1 LEXL=LEXT1_LEXT S:LEXC>1 LEXL=LEXT2_LEXT
. . . S LEXAI=$O(LEX(" "),-1)+1,LEX(LEXAI)=LEXL
S:LEXEF?7N&($L(LEX(1))) LEX(0)=$$SD^LEXQM(LEXEF) S LEX=+($O(LEX(" "),-1))
Q
MAJ(X,LEX) ; Major O.R. Procedures
N LEXC,LEXCHR,LEXHDR,LEXI,LEXI1,LEXI2,LEXIDI,LEXIEN,LEXPC,LEXSTR,LEXT S LEXIEN=+($G(X)) Q:+LEXIEN'>0
S LEXSTR=$$MOR^ICDEX(+LEXIEN) Q:'$L(LEXSTR) D OR(LEXSTR,.LEX)
Q
OR(X,LEX) ; O.R. Procedures
K LEX N LEXC,LEXCHR,LEXHDR,LEXI,LEXI1,LEXI2,LEXIDI,LEXPC,LEXSTR,LEXT S LEXSTR=$G(X) Q:'$L(LEXSTR)
S LEXHDR="Major O.R. ID",LEXPC=0,LEXCHR="" F LEXC=1:1 Q:'$L($E(LEXSTR,LEXC)) D
. S LEXCHR=$E(LEXSTR,LEXC) Q:LEXCHR="" F LEXI=1:1 S LEXIDI=$T(MID+LEXI),LEXIDI=$P(LEXIDI,";;",2) Q:LEXIDI="EXIT" D
. . S LEXI1=$$TM^LEXQM($P(LEXIDI,"=")),LEXI2=$$TM^LEXQM($P(LEXIDI,"=",2)) Q:$L(LEXI1)'=1 Q:LEXI1'=LEXCHR Q:'$L(LEXI2)
. . S LEXT=LEXI2 S:$D(LEXINT) LEXT=LEXT_$J(" ",(22-$L(LEXT)))_"("_LEXI1_")" S LEXPC=LEXPC+1,LEX(1,LEXPC)=$$UP^XLFSTR(LEXT)
S:+($O(LEX(1," "),-1))>0 LEX(0)=$$UP^XLFSTR(LEXHDR),LEX(1)=$$UP^XLFSTR(LEXSTR),LEX=+($O(LEX(1," "),-1))
Q
MID ; Major O.R. Procedures Text
;;1=Bowel
;;2=Chest
;;3=Lymphoma/Leukemia
;;4=Joint
;;5=Pancreas/Liver
;;6=Pelvic
;;7=Shoulder/Elbow
;;8=Thumb/Joint
;;9=Head/Neck
;;A=Cardio
;;M=Musculoskeletal
;;EXIT
Q
LEXQIP2 ;ISL/KER - Query - ICD Procedure - Extract ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; $$MOR^ICDEX ICR 5747
+8 ; MD^ICDEX ICR 5747
+9 ; $$DT^XLFDT ICR 10103
+10 ; $$UP^XLFSTR ICR 10104
+11 ;
+12 ; Documented Integration Agreements
+13 ;
+14 ; Local Variables NEWed or KILLed in LEXQIP
+15 ; LEXINT
+16 ;
+17 QUIT
MDCDRG(X,LEXCDT,LEX,LEXLEN) ; Major Diagnostic Category/DRG
+1 NEW LEXAI,LEXC,LEXDA,LEXDI,LEXEF,LEXFY,LEXI,LEXIEN,LEXL,LEXLC,LEXMDCC,LEXMDCS,LEXME,LEXMI,LEXN,LEXT
+2 NEW LEXT1,LEXT2,LEXUD,LEXUM,LEXVDT
SET LEXVDT=+($GET(LEXCDT))
IF LEXVDT'?7N
SET LEXVDT=$$DT^XLFDT
KILL LEXUM,LEXUD,LEX
+3 SET LEXLC=0
SET LEXIEN=+($GET(X))
SET LEXCDT=$GET(LEXCDT)
SET LEXLEN=+($GET(LEXLEN))
IF +LEXLEN'>0
SET LEXLEN=62
IF LEXCDT'?7N
QUIT
+4 DO MD^ICDEX(80.1,+LEXIEN,$GET(LEXCDT),.LEXMDCS,"IE")
+5 SET LEXMDCC=0
SET LEXMI=0
SET (LEXEF,LEXFY)=$ORDER(LEXMDCS(0))
IF LEXFY'>0
QUIT
+6 SET LEXMI=0
FOR
SET LEXMI=$ORDER(LEXMDCS(LEXFY,"E",LEXMI))
IF +LEXMI'>0
QUIT
Begin DoDot:1
+7 SET LEXME=$GET(LEXMDCS(LEXFY,"E",LEXMI))
IF '$LENGTH(LEXME)
QUIT
+8 SET LEXI=$ORDER(LEX(" "),-1)+1
SET LEX(LEXI)=LEXME
+9 SET LEXDI=0
FOR
SET LEXDI=$ORDER(LEXMDCS(LEXFY,"E",LEXMI,LEXDI))
IF +LEXDI'>0
QUIT
Begin DoDot:2
+10 KILL LEXDA
SET LEXDA(1)=$GET(LEXMDCS(LEXFY,"E",LEXMI,LEXDI))
+11 DO PR^LEXQM(.LEXDA,(LEXLEN-14))
SET LEXT1=" DRG "_LEXDI
+12 SET LEXT1=LEXT1_$JUSTIFY(" ",(14-$LENGTH(LEXT1)))
SET LEXT2=$JUSTIFY(" ",14)
+13 SET (LEXC,LEXI)=0
FOR
SET LEXI=$ORDER(LEXDA(LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:3
+14 NEW LEXT,LEXL,LEXN,LEXAI
SET LEXT=$$TM^LEXQM($GET(LEXDA(LEXI)))
+15 IF '$LENGTH(LEXT)
QUIT
SET LEXC=LEXC+1
IF LEXC=1
SET LEXL=LEXT1_LEXT
IF LEXC>1
SET LEXL=LEXT2_LEXT
+16 SET LEXAI=$ORDER(LEX(" "),-1)+1
SET LEX(LEXAI)=LEXL
End DoDot:3
End DoDot:2
End DoDot:1
+17 IF LEXEF?7N&($LENGTH(LEX(1)))
SET LEX(0)=$$SD^LEXQM(LEXEF)
SET LEX=+($ORDER(LEX(" "),-1))
+18 QUIT
MAJ(X,LEX) ; Major O.R. Procedures
+1 NEW LEXC,LEXCHR,LEXHDR,LEXI,LEXI1,LEXI2,LEXIDI,LEXIEN,LEXPC,LEXSTR,LEXT
SET LEXIEN=+($GET(X))
IF +LEXIEN'>0
QUIT
+2 SET LEXSTR=$$MOR^ICDEX(+LEXIEN)
IF '$LENGTH(LEXSTR)
QUIT
DO OR(LEXSTR,.LEX)
+3 QUIT
OR(X,LEX) ; O.R. Procedures
+1 KILL LEX
NEW LEXC,LEXCHR,LEXHDR,LEXI,LEXI1,LEXI2,LEXIDI,LEXPC,LEXSTR,LEXT
SET LEXSTR=$GET(X)
IF '$LENGTH(LEXSTR)
QUIT
+2 SET LEXHDR="Major O.R. ID"
SET LEXPC=0
SET LEXCHR=""
FOR LEXC=1:1
IF '$LENGTH($EXTRACT(LEXSTR,LEXC))
QUIT
Begin DoDot:1
+3 SET LEXCHR=$EXTRACT(LEXSTR,LEXC)
IF LEXCHR=""
QUIT
FOR LEXI=1:1
SET LEXIDI=$TEXT(MID+LEXI)
SET LEXIDI=$PIECE(LEXIDI,";;",2)
IF LEXIDI="EXIT"
QUIT
Begin DoDot:2
+4 SET LEXI1=$$TM^LEXQM($PIECE(LEXIDI,"="))
SET LEXI2=$$TM^LEXQM($PIECE(LEXIDI,"=",2))
IF $LENGTH(LEXI1)'=1
QUIT
IF LEXI1'=LEXCHR
QUIT
IF '$LENGTH(LEXI2)
QUIT
+5 SET LEXT=LEXI2
IF $DATA(LEXINT)
SET LEXT=LEXT_$JUSTIFY(" ",(22-$LENGTH(LEXT)))_"("_LEXI1_")"
SET LEXPC=LEXPC+1
SET LEX(1,LEXPC)=$$UP^XLFSTR(LEXT)
End DoDot:2
End DoDot:1
+6 IF +($ORDER(LEX(1," "),-1))>0
SET LEX(0)=$$UP^XLFSTR(LEXHDR)
SET LEX(1)=$$UP^XLFSTR(LEXSTR)
SET LEX=+($ORDER(LEX(1," "),-1))
+7 QUIT
MID ; Major O.R. Procedures Text
+1 ;;1=Bowel
+2 ;;2=Chest
+3 ;;3=Lymphoma/Leukemia
+4 ;;4=Joint
+5 ;;5=Pancreas/Liver
+6 ;;6=Pelvic
+7 ;;7=Shoulder/Elbow
+8 ;;8=Thumb/Joint
+9 ;;9=Head/Neck
+10 ;;A=Cardio
+11 ;;M=Musculoskeletal
+12 ;;EXIT
+13 QUIT
