Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWDXIHS

ORWDXIHS.m

Go to the documentation of this file. 
  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
  1.  ;
  1.  ;Modified - IHS/MSC/PLS - 06/22/2011 - Line ADDIND+1
  1.  ;                         06/28/2013 - Line ADDIND+4
  1.  ;           IHS/MSC/MGH   07/18/2016 - Made Exclusionary on status
  1.  ;
  1.  ; RPC: Returns clinical indicators for orderable item.
  1.  ;   DFN  = Patient IEN
  1.  ;   VIEN = Visit IEN
  1.  ;   OI   = Orderable item (not currently used)
  1.  ;   SNOMED = flag for EHR 13
  1. CLININD(DATA,DFN,VIEN,OI,SNOMED) ;EP
  1.  N IEN,ITM,ICD,STAT
  1.  K DATA
  1.  S IEN=0,VIEN=+VIEN,SNOMED=$G(SNOMED)
  1.  D SNOMED(.DATA,DFN,VIEN,OI) Q
  1.  ;IHS/MSC/MGH No longer needed since its all changed to snomed p15
  1.  ;F  S IEN=+$O(^AUPNVPOV("AD",VIEN,IEN)) Q:'IEN  D
  1.  ;.S ITM=$$GET1^DIQ(9000010.07,IEN,.04),ICD=+$G(^AUPNVPOV(IEN,0))
  1.  ;.D ADDIND(1,ITM,ICD)
  1.  ;F  S IEN=+$O(^AUPNPROB("ACTIVE",DFN,"A",IEN)) Q:'IEN  D
  1.  ;.S ITM=$$GET1^DIQ(9000011,IEN,.05),ICD=+$G(^AUPNPROB(IEN,0))
  1.  ;.D ADDIND(2,ITM,ICD)
  1.  ;K DATA(0)
  1.  Q
  1. ADDIND(SUB,ITM,ICD,IEN,CONCID) ;EP-
  1.  N CODE
  1.  I $$AICD S CODE=$P($$ICDDX^ICDEX(ICD,$$NOW^XLFDT),U,2)
  1.  E  S CODE=$$GET1^DIQ(80,ICD,.01)
  1.  ;Q:CODE=".9999"  ;IHS/MSC/PLS - 06/28/13 - per Susan
  1.  I '$L(ITM) D
  1.  .I $$AICD S ITM=$P($$ICDDX^ICDEX(ICD,$$NOW^XLFDT),U,4)
  1.  .E  S ITM=$$GET1^DIQ(80,ICD,3)
  1.  I $L(ITM),'$D(DATA(0,ITM)) D
  1.  .S DATA(0,ITM)="",DATA(SUB,ITM)=ITM_U_$S(SUB=1:"POV",1:"PL")_U_CODE_U_IEN_U_CONCID
  1.  .;E  S DATA(0,ITM)="",DATA(SUB,ITM)=ITM_U_$P("POV^PL",U,SUB)_U_CODE
  1.  Q
  1. SNOMED(DATA,DFN,VIEN,OI) ;EP-
  1.  N IEN,ITM,NARR,SUB,IMP,VDT,SNODATA,POVIEN
  1.  S VIEN=$G(VIEN)
  1.  S IEN=0
  1.  S STAT="" F  S STAT=$O(^AUPNPROB("ACTIVE",DFN,STAT)) Q:STAT=""  D
  1.  .Q:STAT="I"!(STAT="D")                     ;Patch 1016 Make it exclusionary
  1.  .S IEN="" F  S IEN=+$O(^AUPNPROB("ACTIVE",DFN,STAT,IEN)) Q:'IEN  D
  1.  ..S ITM=$$GET1^DIQ(9000011,IEN,.05),ICD=+$G(^AUPNPROB(IEN,0))
  1.  ..S CONCID=$$GET1^DIQ(9000011,IEN,80001)
  1.  ..Q:CONCID=""
  1.  ..;IHS/MSC/MGH Patch 1013 for ICD-10 conversion
  1.  ..S SNODATA=$$CONC^BSTSAPI(CONCID_"^^^1")
  1.  ..S ICD=$P($P(SNODATA,U,5),";",1)
  1.  ..I $D(^AUPNPROB(IEN,14,"B",VIEN)) D
  1.  ...S SUB=1
  1.  ...S POVIEN="" F  S POVIEN=$O(^AUPNVPOV("AD",VIEN,POVIEN)) Q:POVIEN=""  D
  1.  ....I $P($G(^AUPNVPOV(POVIEN,0)),U,16)=IEN D
  1.  .....S ICD=$$GET1^DIQ(9000010.07,POVIEN,.01)
  1.  ..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
  1.  ..D ADDIND(SUB,ITM,ICD,IEN,CONCID)
  1.  K DATA(0)
  1.  Q
  1.  ;
  1.  ; Returns boolean flag indicating if order has a SNOMED Concept ID
  1. ORDSMCID(DATA,ORIFN) ;EP-
  1.  N RES
  1.  S RES=$$VALUE^ORCSAVE2(+ORIFN,"SNMDCNPTID")
  1.  S DATA=$L(RES)>0
  1.  Q
  1.  ;
  1.  ; Input: ORIFN: Order File IEN
  1.  ;        SNMD: Snomed Description^Source^ICD|..n(optional)^Problem IEN(optional)^Snomed Concept ID
  1. UPSNMD(DATA,ORIFN,SNMD) ;EP-
  1.  D RESP^ORCSAVE2(+ORIFN,"OR GTX CLININD",$P(SNMD,U))
  1.  D RESP^ORCSAVE2(+ORIFN,"OR GTX CLININD2",$P($P(SNMD,U,3),"|"))
  1.  D RESP^ORCSAVE2(+ORIFN,"OR GTX SNMDCNPTID",$P(SNMD,U,5))
  1.  D ORDSMCID(.DATA,ORIFN)
  1.  Q
  1. AICD() ;EP
  1.  Q $S($$VERSION^XPDUTL("AICD")<"4.0":0,1:1)