ORWDXIHS ; IHS/CIA/DKM - Order dialog utilities for IHS ;18-Jul-2016 12:51;DU
;;3.0;ORDER ENTRY/RESULTS REPORTING;**1002,1008,1010,1012,1013,1015,1016**;Dec 17, 1997;Build 41
;
;Modified - IHS/MSC/PLS - 06/22/2011 - Line ADDIND+1
; 06/28/2013 - Line ADDIND+4
; IHS/MSC/MGH 07/18/2016 - Made Exclusionary on status
;
; RPC: Returns clinical indicators for orderable item.
; DFN = Patient IEN
; VIEN = Visit IEN
; OI = Orderable item (not currently used)
; SNOMED = flag for EHR 13
CLININD(DATA,DFN,VIEN,OI,SNOMED) ;EP
N IEN,ITM,ICD,STAT
K DATA
S IEN=0,VIEN=+VIEN,SNOMED=$G(SNOMED)
D SNOMED(.DATA,DFN,VIEN,OI) Q
;IHS/MSC/MGH No longer needed since its all changed to snomed p15
;F S IEN=+$O(^AUPNVPOV("AD",VIEN,IEN)) Q:'IEN D
;.S ITM=$$GET1^DIQ(9000010.07,IEN,.04),ICD=+$G(^AUPNVPOV(IEN,0))
;.D ADDIND(1,ITM,ICD)
;F S IEN=+$O(^AUPNPROB("ACTIVE",DFN,"A",IEN)) Q:'IEN D
;.S ITM=$$GET1^DIQ(9000011,IEN,.05),ICD=+$G(^AUPNPROB(IEN,0))
;.D ADDIND(2,ITM,ICD)
;K DATA(0)
Q
ADDIND(SUB,ITM,ICD,IEN,CONCID) ;EP-
N CODE
I $$AICD S CODE=$P($$ICDDX^ICDEX(ICD,$$NOW^XLFDT),U,2)
E S CODE=$$GET1^DIQ(80,ICD,.01)
;Q:CODE=".9999" ;IHS/MSC/PLS - 06/28/13 - per Susan
I '$L(ITM) D
.I $$AICD S ITM=$P($$ICDDX^ICDEX(ICD,$$NOW^XLFDT),U,4)
.E S ITM=$$GET1^DIQ(80,ICD,3)
I $L(ITM),'$D(DATA(0,ITM)) D
.S DATA(0,ITM)="",DATA(SUB,ITM)=ITM_U_$S(SUB=1:"POV",1:"PL")_U_CODE_U_IEN_U_CONCID
.;E S DATA(0,ITM)="",DATA(SUB,ITM)=ITM_U_$P("POV^PL",U,SUB)_U_CODE
Q
SNOMED(DATA,DFN,VIEN,OI) ;EP-
N IEN,ITM,NARR,SUB,IMP,VDT,SNODATA,POVIEN
S VIEN=$G(VIEN)
S IEN=0
S STAT="" F S STAT=$O(^AUPNPROB("ACTIVE",DFN,STAT)) Q:STAT="" D
.Q:STAT="I"!(STAT="D") ;Patch 1016 Make it exclusionary
.S IEN="" F S IEN=+$O(^AUPNPROB("ACTIVE",DFN,STAT,IEN)) Q:'IEN D
..S ITM=$$GET1^DIQ(9000011,IEN,.05),ICD=+$G(^AUPNPROB(IEN,0))
..S CONCID=$$GET1^DIQ(9000011,IEN,80001)
..Q:CONCID=""
..;IHS/MSC/MGH Patch 1013 for ICD-10 conversion
..S SNODATA=$$CONC^BSTSAPI(CONCID_"^^^1")
..S ICD=$P($P(SNODATA,U,5),";",1)
..I $D(^AUPNPROB(IEN,14,"B",VIEN)) D
...S SUB=1
...S POVIEN="" F S POVIEN=$O(^AUPNVPOV("AD",VIEN,POVIEN)) Q:POVIEN="" D
....I $P($G(^AUPNVPOV(POVIEN,0)),U,16)=IEN D
.....S ICD=$$GET1^DIQ(9000010.07,POVIEN,.01)
..E S SUB=$S(STAT="A":2,STAT="S":3,STAT="E":4,STAT="O":5,STAT="R":6,1:2) ;Patch 1016 add in routine/admin
..D ADDIND(SUB,ITM,ICD,IEN,CONCID)
K DATA(0)
Q
;
; Returns boolean flag indicating if order has a SNOMED Concept ID
ORDSMCID(DATA,ORIFN) ;EP-
N RES
S RES=$$VALUE^ORCSAVE2(+ORIFN,"SNMDCNPTID")
S DATA=$L(RES)>0
Q
;
; Input: ORIFN: Order File IEN
; SNMD: Snomed Description^Source^ICD|..n(optional)^Problem IEN(optional)^Snomed Concept ID
UPSNMD(DATA,ORIFN,SNMD) ;EP-
D RESP^ORCSAVE2(+ORIFN,"OR GTX CLININD",$P(SNMD,U))
D RESP^ORCSAVE2(+ORIFN,"OR GTX CLININD2",$P($P(SNMD,U,3),"|"))
D RESP^ORCSAVE2(+ORIFN,"OR GTX SNMDCNPTID",$P(SNMD,U,5))
D ORDSMCID(.DATA,ORIFN)
Q
AICD() ;EP
Q $S($$VERSION^XPDUTL("AICD")<"4.0":0,1:1)
ORWDXIHS ; IHS/CIA/DKM - Order dialog utilities for IHS ;18-Jul-2016 12:51;DU
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1002,1008,1010,1012,1013,1015,1016**;Dec 17, 1997;Build 41
+2 ;
+3 ;Modified - IHS/MSC/PLS - 06/22/2011 - Line ADDIND+1
+4 ; 06/28/2013 - Line ADDIND+4
+5 ; IHS/MSC/MGH 07/18/2016 - Made Exclusionary on status
+6 ;
+7 ; RPC: Returns clinical indicators for orderable item.
+8 ; DFN = Patient IEN
+9 ; VIEN = Visit IEN
+10 ; OI = Orderable item (not currently used)
+11 ; SNOMED = flag for EHR 13
CLININD(DATA,DFN,VIEN,OI,SNOMED) ;EP
+1 NEW IEN,ITM,ICD,STAT
+2 KILL DATA
+3 SET IEN=0
SET VIEN=+VIEN
SET SNOMED=$GET(SNOMED)
+4 DO SNOMED(.DATA,DFN,VIEN,OI)
QUIT
+5 ;IHS/MSC/MGH No longer needed since its all changed to snomed p15
+6 ;F S IEN=+$O(^AUPNVPOV("AD",VIEN,IEN)) Q:'IEN D
+7 ;.S ITM=$$GET1^DIQ(9000010.07,IEN,.04),ICD=+$G(^AUPNVPOV(IEN,0))
+8 ;.D ADDIND(1,ITM,ICD)
+9 ;F S IEN=+$O(^AUPNPROB("ACTIVE",DFN,"A",IEN)) Q:'IEN D
+10 ;.S ITM=$$GET1^DIQ(9000011,IEN,.05),ICD=+$G(^AUPNPROB(IEN,0))
+11 ;.D ADDIND(2,ITM,ICD)
+12 ;K DATA(0)
+13 QUIT
ADDIND(SUB,ITM,ICD,IEN,CONCID) ;EP-
+1 NEW CODE
+2 IF $$AICD
SET CODE=$PIECE($$ICDDX^ICDEX(ICD,$$NOW^XLFDT),U,2)
+3 IF '$TEST
SET CODE=$$GET1^DIQ(80,ICD,.01)
+4 ;Q:CODE=".9999" ;IHS/MSC/PLS - 06/28/13 - per Susan
+5 IF '$LENGTH(ITM)
Begin DoDot:1
+6 IF $$AICD
SET ITM=$PIECE($$ICDDX^ICDEX(ICD,$$NOW^XLFDT),U,4)
+7 IF '$TEST
SET ITM=$$GET1^DIQ(80,ICD,3)
End DoDot:1
+8 IF $LENGTH(ITM)
IF '$DATA(DATA(0,ITM))
Begin DoDot:1
+9 SET DATA(0,ITM)=""
SET DATA(SUB,ITM)=ITM_U_$SELECT(SUB=1:"POV",1:"PL")_U_CODE_U_IEN_U_CONCID
+10 ;E S DATA(0,ITM)="",DATA(SUB,ITM)=ITM_U_$P("POV^PL",U,SUB)_U_CODE
End DoDot:1
+11 QUIT
SNOMED(DATA,DFN,VIEN,OI) ;EP-
+1 NEW IEN,ITM,NARR,SUB,IMP,VDT,SNODATA,POVIEN
+2 SET VIEN=$GET(VIEN)
+3 SET IEN=0
+4 SET STAT=""
FOR
SET STAT=$ORDER(^AUPNPROB("ACTIVE",DFN,STAT))
IF STAT=""
QUIT
Begin DoDot:1
+5 ;Patch 1016 Make it exclusionary
IF STAT="I"!(STAT="D")
QUIT
+6 SET IEN=""
FOR
SET IEN=+$ORDER(^AUPNPROB("ACTIVE",DFN,STAT,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+7 SET ITM=$$GET1^DIQ(9000011,IEN,.05)
SET ICD=+$GET(^AUPNPROB(IEN,0))
+8 SET CONCID=$$GET1^DIQ(9000011,IEN,80001)
+9 IF CONCID=""
QUIT
+10 ;IHS/MSC/MGH Patch 1013 for ICD-10 conversion
+11 SET SNODATA=$$CONC^BSTSAPI(CONCID_"^^^1")
+12 SET ICD=$PIECE($PIECE(SNODATA,U,5),";",1)
+13 IF $DATA(^AUPNPROB(IEN,14,"B",VIEN))
Begin DoDot:3
+14 SET SUB=1
+15 SET POVIEN=""
FOR
SET POVIEN=$ORDER(^AUPNVPOV("AD",VIEN,POVIEN))
IF POVIEN=""
QUIT
Begin DoDot:4
+16 IF $PIECE($GET(^AUPNVPOV(POVIEN,0)),U,16)=IEN
Begin DoDot:5
+17 SET ICD=$$GET1^DIQ(9000010.07,POVIEN,.01)
End DoDot:5
End DoDot:4
End DoDot:3
+18 ;Patch 1016 add in routine/admin
IF '$TEST
SET SUB=$SELECT(STAT="A":2,STAT="S":3,STAT="E":4,STAT="O":5,STAT="R":6,1:2)
+19 DO ADDIND(SUB,ITM,ICD,IEN,CONCID)
End DoDot:2
End DoDot:1
+20 KILL DATA(0)
+21 QUIT
+22 ;
+23 ; Returns boolean flag indicating if order has a SNOMED Concept ID
ORDSMCID(DATA,ORIFN) ;EP-
+1 NEW RES
+2 SET RES=$$VALUE^ORCSAVE2(+ORIFN,"SNMDCNPTID")
+3 SET DATA=$LENGTH(RES)>0
+4 QUIT
+5 ;
+6 ; Input: ORIFN: Order File IEN
+7 ; SNMD: Snomed Description^Source^ICD|..n(optional)^Problem IEN(optional)^Snomed Concept ID
UPSNMD(DATA,ORIFN,SNMD) ;EP-
+1 DO RESP^ORCSAVE2(+ORIFN,"OR GTX CLININD",$PIECE(SNMD,U))
+2 DO RESP^ORCSAVE2(+ORIFN,"OR GTX CLININD2",$PIECE($PIECE(SNMD,U,3),"|"))
+3 DO RESP^ORCSAVE2(+ORIFN,"OR GTX SNMDCNPTID",$PIECE(SNMD,U,5))
+4 DO ORDSMCID(.DATA,ORIFN)
+5 QUIT
AICD() ;EP
+1 QUIT $SELECT($$VERSION^XPDUTL("AICD")<"4.0":0,1:1)
