BEHOTIU ;MSC/IND/DKM - TIU extensions;09-Jan-2014 16:23;DU
;;1.1;BEH COMPONENTS;**015002,015003**;Sep 18, 2007
;=================================================================
; RPC: Returns true if document has an associated diagnosis
HASDX(DATA,DOCIEN,DXS,ONEONLY) ;EP
N VIEN,LP1,LP2,NAR1,NAR2,NAR3,ICD,X,Y,VDATE
S DATA=0,ONEONLY=$G(ONEONLY,1),VIEN=$P($G(^TIU(8925,+DOCIEN,0)),U,3)
S VDATE=$P($G(^AUPNVSIT(VIEN,0)),U,1)
Q:'VIEN
S LP1=0,DXS=""
F S DXS=$O(DXS(DXS)) Q:'$L(DXS) D
.I $TR(DXS(DXS)," ")="" K DXS(DXS)
.E S DXS(DXS)=$$UP^XLFSTR(DXS(DXS))
F S LP1=$O(^AUPNVPOV("AD",VIEN,LP1)) Q:'LP1 D Q:DATA
.S X=$G(^AUPNVPOV(LP1,0))
.Q:'X
.;Changes made for ICD-10
.;S NAR1=$P(X,U,4)
.S NAR1=$$GET1^DIQ(9000010.07,LP1,.04)
.;S:NAR1 NAR1=$P($G(^AUTNPOV(NAR1,0)),U)
.I $$AICD^BEHOENPC D
..S ICD=$P($$ICDDX^ICDEX(X,VDATE),U,2)
..S NAR3=$$SD^ICDEX(80,X,VDATE)
..S NAR2=$$LD^ICDEX(80,X,VDATE)
.E D
..S X=$G(^ICD9(+X,0)),NAR3=$G(^(1))
..S ICD=$P(X,U),NAR2=$P(X,U,3)
.S DXS=""
.F S DXS=$O(DXS(DXS)) Q:'$L(DXS) D Q:DATA
..S X=DXS(DXS)
..I X=ICD
..E I NAR1[X
..E I NAR2[X
..E I NAR3[X
..E Q
..I ONEONLY K DXS
..E K DXS(DXS)
..S DATA=$D(DXS)<10
Q
; RPC: Get title IEN given name
TITLEIEN(DATA,VALUE) ;EP
S DATA=$O(^TIU(8925.1,"B",VALUE,0))
Q
; RPC: Get document text associated with package reference
DOCTEXT(DATA,PKGREF) ;EP
N TIUDA,UND,GBL,CANVIEW
Q:'$L(PKGREF)
S TIUDA=0,UND=$$REPEAT^XLFSTR("-",80)
F S TIUDA=$O(^TIU(8925,"G",PKGREF,TIUDA)) Q:'TIUDA D
.S CANVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
.I +CANVIEW>0 D
..D TGET^TIUSRVR1(.GBL,TIUDA)
..S @GBL@(0)=UND
..M @DATA@(TIUDA)=@GBL
..K @GBL
Q
BEHOTIU ;MSC/IND/DKM - TIU extensions;09-Jan-2014 16:23;DU
+1 ;;1.1;BEH COMPONENTS;**015002,015003**;Sep 18, 2007
+2 ;=================================================================
+3 ; RPC: Returns true if document has an associated diagnosis
HASDX(DATA,DOCIEN,DXS,ONEONLY) ;EP
+1 NEW VIEN,LP1,LP2,NAR1,NAR2,NAR3,ICD,X,Y,VDATE
+2 SET DATA=0
SET ONEONLY=$GET(ONEONLY,1)
SET VIEN=$PIECE($GET(^TIU(8925,+DOCIEN,0)),U,3)
+3 SET VDATE=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)
+4 IF 'VIEN
QUIT
+5 SET LP1=0
SET DXS=""
+6 FOR
SET DXS=$ORDER(DXS(DXS))
IF '$LENGTH(DXS)
QUIT
Begin DoDot:1
+7 IF $TRANSLATE(DXS(DXS)," ")=""
KILL DXS(DXS)
+8 IF '$TEST
SET DXS(DXS)=$$UP^XLFSTR(DXS(DXS))
End DoDot:1
+9 FOR
SET LP1=$ORDER(^AUPNVPOV("AD",VIEN,LP1))
IF 'LP1
QUIT
Begin DoDot:1
+10 SET X=$GET(^AUPNVPOV(LP1,0))
+11 IF 'X
QUIT
+12 ;Changes made for ICD-10
+13 ;S NAR1=$P(X,U,4)
+14 SET NAR1=$$GET1^DIQ(9000010.07,LP1,.04)
+15 ;S:NAR1 NAR1=$P($G(^AUTNPOV(NAR1,0)),U)
+16 IF $$AICD^BEHOENPC
Begin DoDot:2
+17 SET ICD=$PIECE($$ICDDX^ICDEX(X,VDATE),U,2)
+18 SET NAR3=$$SD^ICDEX(80,X,VDATE)
+19 SET NAR2=$$LD^ICDEX(80,X,VDATE)
End DoDot:2
+20 IF '$TEST
Begin DoDot:2
+21 SET X=$GET(^ICD9(+X,0))
SET NAR3=$GET(^(1))
+22 SET ICD=$PIECE(X,U)
SET NAR2=$PIECE(X,U,3)
End DoDot:2
+23 SET DXS=""
+24 FOR
SET DXS=$ORDER(DXS(DXS))
IF '$LENGTH(DXS)
QUIT
Begin DoDot:2
+25 SET X=DXS(DXS)
+26 IF X=ICD
+27 IF '$TEST
IF NAR1[X
+28 IF '$TEST
IF NAR2[X
+29 IF '$TEST
IF NAR3[X
+30 IF '$TEST
QUIT
+31 IF ONEONLY
KILL DXS
+32 IF '$TEST
KILL DXS(DXS)
+33 SET DATA=$DATA(DXS)<10
End DoDot:2
IF DATA
QUIT
End DoDot:1
IF DATA
QUIT
+34 QUIT
+35 ; RPC: Get title IEN given name
TITLEIEN(DATA,VALUE) ;EP
+1 SET DATA=$ORDER(^TIU(8925.1,"B",VALUE,0))
+2 QUIT
+3 ; RPC: Get document text associated with package reference
DOCTEXT(DATA,PKGREF) ;EP
+1 NEW TIUDA,UND,GBL,CANVIEW
+2 IF '$LENGTH(PKGREF)
QUIT
+3 SET TIUDA=0
SET UND=$$REPEAT^XLFSTR("-",80)
+4 FOR
SET TIUDA=$ORDER(^TIU(8925,"G",PKGREF,TIUDA))
IF 'TIUDA
QUIT
Begin DoDot:1
+5 SET CANVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
+6 IF +CANVIEW>0
Begin DoDot:2
+7 DO TGET^TIUSRVR1(.GBL,TIUDA)
+8 SET @GBL@(0)=UND
+9 MERGE @DATA@(TIUDA)=@GBL
+10 KILL @GBL
End DoDot:2
End DoDot:1
+11 QUIT
