- 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
