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

HMPDMDC.m

Go to the documentation of this file. 
  1. HMPDMDC ;SLC/MKB,DP,ASMR/RRB - CLiO extract;8/2/11  15:29
  1.  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^MDC(704.101                 5748 (Private)
  1.  ; ^MDC(704.102                 5748 (Private)
  1.  ; ^MDC(704.117                 5748 (Private)
  1.  ; ^MDC(704.118                 5811 (Private)
  1.  ; DIC                          2051
  1.  ; DIQ                          2056
  1.  ; XLFDT                       10103
  1.  ; XLFSTR                      10104
  1.  Q
  1.  ; ------------ Get observations from VistA ------------
  1.  ;
  1. EN(DFN,BEG,END,MAX,ID) ; -- find patient's observations
  1.  N HMPCLIO,HMPN,HMPITM,HMPCNT,X
  1.  ;
  1.  ; get one observation
  1.  I $L($G(ID)) D EN1(ID,.HMPITM),XML(.HMPITM) Q
  1.  ;
  1.  ; get all patient observations
  1.  S DFN=+$G(DFN) Q:DFN<1
  1.  S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999),HMPCNT=0
  1.  ;D QRYPT^MDCLIO1("HMPCLIO",DFN,BEG,END) ;all [verified] observations
  1.  D QRYPT("HMPCLIO",DFN,BEG,END) ;all [verified] observations
  1.  S HMPN=0 F  S HMPN=$O(HMPCLIO(HMPN)) Q:(HMPN<1)!(HMPCNT'<MAX)  D
  1.  . S ID=$G(HMPCLIO(HMPN)) K HMPITM ;GUID
  1.  . D EN1(ID,.HMPITM) Q:'$D(HMPITM)
  1.  . D XML(.HMPITM) S HMPCNT=HMPCNT+1
  1.  Q
  1.  ;
  1. EN1(GUID,CLIO) ; -- return an observation in CLIO("attribute")=value
  1.  N HMPT,HMPC,LOC,I,X,Y K CLIO
  1.  S GUID=$G(GUID) Q:GUID=""  ;invalid GUID
  1.  ;D QRYOBS^MDCLIO1("HMPC",GUID) Q:'$D(HMPC)  ;doesn't exist
  1.  D QRYOBS("HMPC",GUID) Q:'$D(HMPC)  ;doesn't exist
  1.  Q:$L($G(HMPC("PARENT_ID","E")))            ;PARENT also in list
  1.  S CLIO("id")=GUID,CLIO("vuid")=$G(HMPC("TERM_ID","I"))
  1.  S CLIO("name")=$G(HMPC("TERM_ID","E"))
  1.  S CLIO("value")=$G(HMPC("SVALUE","E"))
  1.  S CLIO("units")=$G(HMPC("UNIT_ID","ABBV"))
  1.  S CLIO("entered")=$G(HMPC("ENTERED_DATE_TIME","I"))
  1.  S CLIO("observed")=$G(HMPC("OBSERVED_DATE_TIME","I"))
  1.  ;D QRYTYPES^MDCLIO1("HMPT")
  1.  D QRYTYPES("HMPT")
  1.  F I=3:1:7 S X=$G(HMPT(I,"XML")) Q:I<1  I $L($G(HMPC(X,"E"))) D
  1.  . S Y=HMPT(I,"NAME"),Y=$S(Y="LOCATION":"bodySite",1:$$LOW^XLFSTR(Y))
  1.  . S CLIO(Y)=HMPC(X,"I")_U_HMPC(X,"E")
  1.  S CLIO("range")=$G(HMPC("RANGE","E"))
  1.  S CLIO("status")=$G(HMPC("STATUS","E"))
  1.  S LOC=$G(HMPC("HOSPITAL_LOCATION_ID","I")),CLIO("facility")=$$FAC^HMPD(LOC)
  1.  S CLIO("location")=LOC_U_$G(HMPC("HOSPITAL_LOCATION_ID","E"))
  1.  S CLIO("comment")=$G(HMPC("COMMENT","E"))
  1.  Q
  1.  ;
  1.  ; ------------ Return data to middle tier ------------
  1.  ;
  1. XML(OBS) ; -- Return observation as XML in @HMP@(#)
  1.  N ATT,X,Y,I,J,P,NAMES,TAG
  1.  D ADD("<observation>") S HMPTOTL=$G(HMPTOTL)+1
  1.  S ATT="" F  S ATT=$O(OBS(ATT)) Q:ATT=""  D
  1.  . S X=$G(OBS(ATT)),Y="" Q:'$L(X)
  1.  . I X'["^" S Y="<"_ATT_" value='"_$$ESC^HMPD(X)_"' />" D ADD(Y) Q
  1.  . I $L(X)>1 D
  1.  .. S Y="<"_ATT_" "
  1.  .. F P=1:1 S TAG=$P("code^name^Z",U,P) Q:TAG="Z"  I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^HMPD($P(X,U,P))_"' "
  1.  .. S Y=Y_"/>" D ADD(Y)
  1.  D ADD("</observation>")
  1.  Q
  1.  ;
  1. LOOP() ; -- build sub-items string from NAMES and X
  1.  N STR,P,TAG S STR=""
  1.  F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z"  I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^HMPD($P(X,U,P))_"' "
  1.  Q STR
  1.  ;
  1. ADD(X) ; Add a line @HMP@(n)=X
  1.  S HMPI=$G(HMPI)+1
  1.  S @HMP@(HMPI)=X
  1.  Q
  1.  ;
  1.  ; -- CliO specific code accessing the ^MDC( global for data
  1.  ; 
  1. QRYPT(HMPRET,HMPDFN,HMPFR,HMPTO,HMPSTAT) ; List of observations by pt, datetime, status
  1.  K @HMPRET
  1.  N HMPDT,HMPIEN
  1.  S HMPSTAT=$G(HMPSTAT,1) ; Default to Verified
  1.  F HMPDT=HMPFR-.0000001:0 S HMPDT=$O(^MDC(704.117,"AS",HMPSTAT,HMPDFN,HMPDT)) Q:'HMPDT!(HMPDT>HMPTO)  D
  1.  . F HMPIEN=0:0 S HMPIEN=$O(^MDC(704.117,"AS",HMPSTAT,HMPDFN,HMPDT,HMPIEN)) Q:'HMPIEN  D
  1.  . . S:$P(^MDC(704.117,HMPIEN,0),U,9)=HMPSTAT @HMPRET@(HMPIEN)=$P(^MDC(704.117,HMPIEN,0),U)
  1.  Q
  1.  ;
  1. QRYOBS(HMPRET,HMPID) ; Return a single observation
  1.  K @HMPRET
  1.  N HMPTMP,HMPIEN
  1.  S HMPIEN=$$FIND1^DIC(704.117,"","PKX",HMPID,"PK")
  1.  I HMPIEN<1 S @HMPRET@(0)="-1^No such observation '"_HMPID_"'" Q
  1.  D GETS^DIQ(704.117,HMPIEN_",","*","EIR","HMPTMP")
  1.  M @HMPRET=HMPTMP(704.117,HMPIEN_",") K HMPTMP
  1.  S @HMPRET@("TERM_ID","I")=$$GET1^DIQ(704.117,HMPIEN_",",".07:99.99")
  1.  S @HMPRET@("TERM_ID","E")=$$GET1^DIQ(704.117,HMPIEN_",",".07:.02")
  1.  S @HMPRET@("TERM_ID","GUID")=$$GET1^DIQ(704.117,HMPIEN_",",".07")
  1.  S @HMPRET@("TERM_ID","ABBV")=$$GET1^DIQ(704.117,HMPIEN_",",".07:.03")
  1.  D:$$GET1^DIQ(704.117,HMPIEN_",",".07:.06","I")=3  ; Coded data values
  1.  . S HMPTMP=$$FIND1^DIC(704.101,"","PKX",@HMPRET@("SVALUE","I"),"PK")
  1.  . S @HMPRET@("SVALUE","E")=$$GET1^DIQ(704.101,HMPTMP_",",.02)
  1.  D QRYQUAL(HMPRET,HMPIEN)
  1.  D QRYCTX($NA(@HMPRET@("CONTEXT")),HMPID)
  1.  Q
  1.  ;
  1. QRYQUAL(HMPRET,HMPIEN) ; Returns the qualifiers for obs in HMPIEN
  1.  ; We do NOT want to kill HMPRET here because it points at the parent node of the return
  1.  N HMPQUAL
  1.  F Y=0:0 S Y=$O(^MDC(704.118,"PK",HMPIEN,Y)) Q:'Y  D  ;ICR 5811 DE2818 ASF 11/25/15
  1.  . S HMPQUAL=$$GET1^DIQ(704.101,Y_",",".05:.02")
  1.  . S @HMPRET@(HMPQUAL,"I")=$$GET1^DIQ(704.101,Y_",","99.99")
  1.  . S @HMPRET@(HMPQUAL,"E")=$$GET1^DIQ(704.101,Y_",",".02")
  1.  . S @HMPRET@(HMPQUAL,"GUID")=$$GET1^DIQ(704.101,Y_",",".01")
  1.  . S @HMPRET@(HMPQUAL,"ABBV")=$$GET1^DIQ(704.101,Y_",",".03")
  1.  Q
  1.  ;
  1. QRYCTX(HMPRET,HMPID) ; We need a terminology based context observation relationship here
  1.  N HMPIEN,HMPCTX,HMPDT,HMPFR,HMPTO,HMPDFN,HMPTERM,HMPCNT,HMPXID,HMPOBS
  1.  S HMPIEN=+$$FIND1^DIC(704.117,"","PKX",HMPID,"PK") Q:HMPIEN<1
  1.  S HMPCTX=$$GET1^DIQ(704.117,HMPIEN_",",.07) ; GET THE PRIMARY TERM (GUID)
  1.  ; FILTER OUT EVERYTHING BUT SpO2 for now
  1.  Q:HMPCTX'="{5F84DD55-3CCF-094C-2536-B51EB7FAD999}"
  1.  S HMPDFN=+$$GET1^DIQ(704.117,HMPIEN_",",.08,"I") ; GET THE PATIENT
  1.  S HMPDT=+$$GET1^DIQ(704.117,HMPIEN_",",.05,"I") ; GET THE OBS DATE
  1.  S HMPFR=$$FMADD^XLFDT(HMPDT,0,0,0,-30) ; PREVIOUS 30 SECONDS
  1.  S HMPTO=$$FMADD^XLFDT(HMPDT,0,0,0,30) ; NEXT 30 SECONDS
  1.  ; Now we find the context observations
  1.  F HMPDT=HMPFR:0 S HMPDT=$O(^MDC(704.117,"PT",HMPDFN,HMPDT)) Q:'HMPDT!(HMPDT>HMPTO)  D  ;ICR 5810 DE2818 ASF 11/25/15 
  1.  . F HMPOBS=0:0 S HMPOBS=$O(^MDC(704.117,"PT",HMPDFN,HMPDT,HMPOBS)) Q:'HMPOBS  D
  1.  . . Q:$$GET1^DIQ(704.117,HMPOBS_",",.09,"I")'=1  ; Verified Only
  1.  . . S HMPXID=$$GET1^DIQ(704.117,HMPOBS_",",.01)
  1.  . . Q:HMPXID=HMPID  ; You should ignore yourself in this loop
  1.  . . S HMPTERM=$$GET1^DIQ(704.117,HMPOBS_",",".07")
  1.  . . ; INSERT FILTER CODE FOR O2 Flowrate and Concentration here - In the future we will find all context terms for an observation in terminology
  1.  . . Q:(HMPTERM'="{56F82CAC-3564-46CE-A520-1025020DADE9}")&(HMPTERM'="{3BB314E8-9BBB-480E-B34E-B56EDE43BAC4}")
  1.  . . S HMPCNT=$O(@HMPRET@(""),-1)+1,@HMPRET@(0)=HMPCNT
  1.  . . S @HMPRET@(HMPCNT,"OBS_ID","I")=HMPXID
  1.  . . S @HMPRET@(HMPCNT,"OBS_ID","E")=HMPXID
  1.  . . S @HMPRET@(HMPCNT,"TERM_ID","I")=$$GET1^DIQ(704.117,HMPOBS_",",".07:99.99")
  1.  . . S @HMPRET@(HMPCNT,"TERM_ID","E")=$$GET1^DIQ(704.117,HMPOBS_",",".07:.02")
  1.  . . S @HMPRET@(HMPCNT,"SVALUE","I")=$$GET1^DIQ(704.117,HMPOBS_",",".1","I")
  1.  . . S @HMPRET@(HMPCNT,"SVALUE","E")=$$GET1^DIQ(704.117,HMPOBS_",",".1","E")
  1.  . . D QRYQUAL($NA(@HMPRET@(HMPCNT)),HMPOBS)
  1.  Q
  1.  ;
  1. QRYTYPES(HMPRET) ; Return the terminology Term Types
  1.  K @HMPRET
  1.  N X
  1.  F X=0:0 S X=$O(^MDC(704.102,X)) Q:'X  D  ;ICR 5748 DE2818 ASF 11/25/15
  1.  . S @HMPRET@(X,"NAME")=$P(^MDC(704.102,X,0),U,1)
  1.  . S @HMPRET@(X,"XML")=$P(^MDC(704.102,X,0),U,2)
  1.  . S @HMPRET@("B",$P(^MDC(704.102,X,0),U,1),X)=""
  1.  Q
  1.  ;