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

VPRDMDC.m

Go to the documentation of this file. 
  1. VPRDMDC ;SLC/MKB,DP -- CLiO extract ;8/2/11  15:29
  1.  ;;1.0;VIRTUAL PATIENT RECORD;**1,2**;Sep 01, 2011;Build 317
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^MDC(704.101                 5748 (Private)
  1.  ; ^MDC(704.102                 5809 (Private)
  1.  ; ^MDC(704.1122                5999 (Private)
  1.  ; ^MDC(704.116                 5995 (Private)
  1.  ; ^MDC(704.1161                5996 (Private)
  1.  ; ^MDC(704.117                 5810 (Private)
  1.  ; ^MDC(704.118                 5811 (Private)
  1.  ; DIC                          2051
  1.  ; DIQ                          2056
  1.  ; XLFDT                       10103
  1.  ; XLFSTR                      10104
  1.  ; XPAR                         2263
  1.  ;
  1.  ; ------------ Get observations from VistA ------------
  1.  ;
  1. EN(DFN,BEG,END,MAX,ID) ; -- find patient's observations
  1.  N VPRCLIO,VPRN,VPRITM,VPRCNT,X
  1.  ;
  1.  ; get one observation
  1.  I $L($G(ID)) D EN1(ID,.VPRITM),XML(.VPRITM) 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),VPRCNT=0
  1.  ;D QRYPT^MDCLIO1("VPRCLIO",DFN,BEG,END) ;all [verified] observations
  1.  D QRYPT("VPRCLIO",DFN,BEG,END) ;all [verified] observations
  1.  S VPRN=0 F  S VPRN=$O(VPRCLIO(VPRN)) Q:(VPRN<1)!(VPRCNT'<MAX)  D
  1.  . S ID=$G(VPRCLIO(VPRN)) K VPRITM ;GUID
  1.  . D EN1(ID,.VPRITM) Q:'$D(VPRITM)
  1.  . D XML(.VPRITM) S VPRCNT=VPRCNT+1
  1.  Q
  1.  ;
  1. EN1(GUID,CLIO) ; -- return an observation in CLIO("attribute")=value
  1.  N VPRT,VPRC,LOC,I,X,Y K CLIO
  1.  S GUID=$G(GUID) Q:GUID=""  ;invalid GUID
  1.  ;D QRYOBS^MDCLIO1("VPRC",GUID) Q:'$D(VPRC)  ;doesn't exist
  1.  D QRYOBS("VPRC",GUID) Q:'$D(VPRC)  ;doesn't exist
  1.  Q:$L($G(VPRC("PARENT_ID","E")))            ;PARENT also in list
  1.  S CLIO("id")=GUID,CLIO("vuid")=$G(VPRC("TERM_ID","I"))
  1.  S CLIO("name")=$G(VPRC("TERM_ID","E"))
  1.  S CLIO("value")=$G(VPRC("SVALUE","E"))
  1.  S CLIO("units")=$G(VPRC("UNIT_ID","ABBV"))
  1.  S CLIO("entered")=$G(VPRC("ENTERED_DATE_TIME","I"))
  1.  S CLIO("observed")=$G(VPRC("OBSERVED_DATE_TIME","I"))
  1.  ;D QRYTYPES^MDCLIO1("VPRT")
  1.  D QRYTYPES("VPRT")
  1.  F I=3:1:7 S X=$G(VPRT(I,"XML")) Q:I<1  I $L($G(VPRC(X,"E"))) D
  1.  . S Y=VPRT(I,"NAME"),Y=$S(Y="LOCATION":"bodySite",1:$$LOW^XLFSTR(Y))
  1.  . S CLIO(Y)=VPRC(X,"I")_U_VPRC(X,"E")
  1.  S CLIO("range")=$G(VPRC("RANGE","E"))
  1.  S CLIO("status")=$G(VPRC("STATUS","E"))
  1.  S LOC=$G(VPRC("HOSPITAL_LOCATION_ID","I")),CLIO("facility")=$$FAC^VPRD(LOC)
  1.  S CLIO("location")=LOC_U_$G(VPRC("HOSPITAL_LOCATION_ID","E"))
  1.  S CLIO("comment")=$G(VPRC("COMMENT","E"))
  1.  Q
  1.  ;
  1.  ; ------------ Return data to middle tier ------------
  1.  ;
  1. XML(OBS) ; -- Return observation as XML in @VPR@(#)
  1.  N ATT,X,Y,I,J,P,NAMES,TAG
  1.  D ADD("<observation>") S VPRTOTL=$G(VPRTOTL)+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^VPRD(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^VPRD($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^VPRD($P(X,U,P))_"' "
  1.  Q STR
  1.  ;
  1. ADD(X) ; Add a line @VPR@(n)=X
  1.  S VPRI=$G(VPRI)+1
  1.  S @VPR@(VPRI)=X
  1.  Q
  1.  ;
  1.  ; -- CliO specific code accessing the ^MDC( global for data
  1.  ; 
  1. QRYPT(VPRRET,VPRDFN,VPRFR,VPRTO,VPRSTAT) ; List of observations by pt, datetime, status
  1.  K @VPRRET
  1.  N VPRDT,VPRIEN
  1.  S VPRSTAT=$G(VPRSTAT,1) ; Default to Verified
  1.  F VPRDT=VPRFR-.0000001:0 S VPRDT=$O(^MDC(704.117,"AS",VPRSTAT,VPRDFN,VPRDT)) Q:'VPRDT!(VPRDT>VPRTO)  D
  1.  . F VPRIEN=0:0 S VPRIEN=$O(^MDC(704.117,"AS",VPRSTAT,VPRDFN,VPRDT,VPRIEN)) Q:'VPRIEN  D
  1.  . . S:$P(^MDC(704.117,VPRIEN,0),U,9)=VPRSTAT @VPRRET@(VPRIEN)=$P(^MDC(704.117,VPRIEN,0),U)
  1.  Q
  1.  ;
  1. QRYOBS(VPRRET,VPRID) ; Return a single observation
  1.  K @VPRRET
  1.  N VPRTMP,VPRIEN
  1.  S VPRIEN=$$FIND1^DIC(704.117,"","PKX",VPRID,"PK")
  1.  I VPRIEN<1 S @VPRRET@(0)="-1^No such observation '"_VPRID_"'" Q
  1.  D GETS^DIQ(704.117,VPRIEN_",","*","EIR","VPRTMP")
  1.  M @VPRRET=VPRTMP(704.117,VPRIEN_",") K VPRTMP
  1.  S @VPRRET@("TERM_ID","I")=$$GET1^DIQ(704.117,VPRIEN_",",".07:99.99")
  1.  S @VPRRET@("TERM_ID","E")=$$GET1^DIQ(704.117,VPRIEN_",",".07:.02")
  1.  S @VPRRET@("TERM_ID","GUID")=$$GET1^DIQ(704.117,VPRIEN_",",".07")
  1.  S @VPRRET@("TERM_ID","ABBV")=$$GET1^DIQ(704.117,VPRIEN_",",".07:.03")
  1.  D:$$GET1^DIQ(704.117,VPRIEN_",",".07:.06","I")=3  ; Coded data values
  1.  . S VPRTMP=$$FIND1^DIC(704.101,"","PKX",@VPRRET@("SVALUE","I"),"PK")
  1.  . S @VPRRET@("SVALUE","E")=$$GET1^DIQ(704.101,VPRTMP_",",.02)
  1.  D QRYQUAL(VPRRET,VPRIEN)
  1.  D QRYCTX($NA(@VPRRET@("CONTEXT")),VPRID)
  1.  D QRYSET(VPRRET,VPRIEN)
  1.  Q
  1.  ;
  1. QRYQUAL(VPRRET,VPRIEN) ; Returns the qualifiers for obs in VPRIEN
  1.  ; We do NOT want to kill VPRRET here because it points at the parent node of the return
  1.  N VPRQUAL
  1.  F Y=0:0 S Y=$O(^MDC(704.118,"PK",VPRIEN,Y)) Q:'Y  D
  1.  . S VPRQUAL=$$GET1^DIQ(704.101,Y_",",".05:.02")
  1.  . S @VPRRET@(VPRQUAL,"I")=$$GET1^DIQ(704.101,Y_",","99.99")
  1.  . S @VPRRET@(VPRQUAL,"E")=$$GET1^DIQ(704.101,Y_",",".02")
  1.  . S @VPRRET@(VPRQUAL,"GUID")=$$GET1^DIQ(704.101,Y_",",".01")
  1.  . S @VPRRET@(VPRQUAL,"ABBV")=$$GET1^DIQ(704.101,Y_",",".03")
  1.  Q
  1.  ;
  1. QRYCTX(VPRRET,VPRID) ; We need a terminology based context observation relationship here
  1.  N VPRIEN,VPRCTX,VPRDT,VPRFR,VPRTO,VPRDFN,VPRTERM,VPRCNT,VPRXID,VPROBS
  1.  S VPRIEN=+$$FIND1^DIC(704.117,"","PKX",VPRID,"PK") Q:VPRIEN<1
  1.  S VPRCTX=$$GET1^DIQ(704.117,VPRIEN_",",.07) ; GET THE PRIMARY TERM (GUID)
  1.  ; FILTER OUT EVERYTHING BUT SpO2 for now
  1.  Q:VPRCTX'="{5F84DD55-3CCF-094C-2536-B51EB7FAD999}"
  1.  S VPRDFN=+$$GET1^DIQ(704.117,VPRIEN_",",.08,"I") ; GET THE PATIENT
  1.  S VPRDT=+$$GET1^DIQ(704.117,VPRIEN_",",.05,"I") ; GET THE OBS DATE
  1.  S VPRFR=$$FMADD^XLFDT(VPRDT,0,0,0,-30) ; PREVIOUS 30 SECONDS
  1.  S VPRTO=$$FMADD^XLFDT(VPRDT,0,0,0,30) ; NEXT 30 SECONDS
  1.  ; Now we find the context observations
  1.  F VPRDT=VPRFR:0 S VPRDT=$O(^MDC(704.117,"PT",VPRDFN,VPRDT)) Q:'VPRDT!(VPRDT>VPRTO)  D
  1.  . F VPROBS=0:0 S VPROBS=$O(^MDC(704.117,"PT",VPRDFN,VPRDT,VPROBS)) Q:'VPROBS  D
  1.  . . Q:$$GET1^DIQ(704.117,VPROBS_",",.09,"I")'=1  ; Verfied Only
  1.  . . S VPRXID=$$GET1^DIQ(704.117,VPROBS_",",.01)
  1.  . . Q:VPRXID=VPRID  ; You should ignore yourself in this loop
  1.  . . S VPRTERM=$$GET1^DIQ(704.117,VPROBS_",",".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:(VPRTERM'="{56F82CAC-3564-46CE-A520-1025020DADE9}")&(VPRTERM'="{3BB314E8-9BBB-480E-B34E-B56EDE43BAC4}")
  1.  . . S VPRCNT=$O(@VPRRET@(""),-1)+1,@VPRRET@(0)=VPRCNT
  1.  . . S @VPRRET@(VPRCNT,"OBS_ID","I")=VPRXID
  1.  . . S @VPRRET@(VPRCNT,"OBS_ID","E")=VPRXID
  1.  . . S @VPRRET@(VPRCNT,"TERM_ID","I")=$$GET1^DIQ(704.117,VPROBS_",",".07:99.99")
  1.  . . S @VPRRET@(VPRCNT,"TERM_ID","E")=$$GET1^DIQ(704.117,VPROBS_",",".07:.02")
  1.  . . S @VPRRET@(VPRCNT,"SVALUE","I")=$$GET1^DIQ(704.117,VPROBS_",",".1","I")
  1.  . . S @VPRRET@(VPRCNT,"SVALUE","E")=$$GET1^DIQ(704.117,VPROBS_",",".1","E")
  1.  . . D QRYQUAL($NA(@VPRRET@(VPRCNT)),VPROBS)
  1.  Q
  1.  ;
  1. QRYSET(VPRRET,VPRIEN) ; Return the Obs Set/View information
  1.  N VPRDFN,VPRSET,VPRDT,VPRPG,VPRVW,X
  1.  S VPRDFN=+$G(@VPRRET@("PATIENT_ID","I"))
  1.  S VPRSET=+$O(^MDC(704.1161,"AS",VPRIEN,0)) Q:VPRSET<1  ;not part of set
  1.  S @VPRRET@("SET_ID","GUID")=$$GET1^DIQ(704.116,VPRSET_",",".01")
  1.  S VPRDT=$$GET1^DIQ(704.116,VPRSET_",",".02","I")
  1.  ; loop backwards to find supplemental page for Obs_Set
  1.  F  S VPRDT=$O(^MDC(704.1122,"ADT",VPRDFN,VPRDT),-1) Q:VPRDT<1  D  Q:VPRPG  ;found
  1.  . S VPRPG=+$O(^MDC(704.1122,"ADT",VPRDFN,VPRDT,0))
  1.  . I $P($G(^MDC(704.1122,VPRPG,0)),U,10)'=VPRSET S VPRPG="" Q
  1.  . S @VPRRET@("SUPP_PAGE","GUID")=$$GET1^DIQ(704.1122,VPRPG_",",".01")
  1.  . S @VPRRET@("SUPP_PAGE","DISPLAY_NAME")=$$GET1^DIQ(704.1122,VPRPG_",",".08")
  1.  . S @VPRRET@("SUPP_PAGE","ACTIVATED_DATE_TIME")=$$GET1^DIQ(704.1122,VPRPG_",",".11","I")
  1.  . S @VPRRET@("SUPP_PAGE","DEACTIVATED_DATE_TIME")=$$GET1^DIQ(704.1122,VPRPG_",",".21","I")
  1.  . S VPRVW=$$GET1^DIQ(704.1122,VPRPG_",",".02"),X=$$GET^XPAR("ALL","VPR OBS VIEW TYPE",VPRVW,"E")
  1.  . I $L(X) S @VPRRET@("SUPP_PAGE","TYPE")=X
  1.  Q
  1.  ;
  1. QRYTYPES(VPRRET) ; Return the terminology Term Types
  1.  K @VPRRET
  1.  N X
  1.  F X=0:0 S X=$O(^MDC(704.102,X)) Q:'X  D
  1.  . S @VPRRET@(X,"NAME")=$P(^MDC(704.102,X,0),U,1)
  1.  . S @VPRRET@(X,"XML")=$P(^MDC(704.102,X,0),U,2)
  1.  . S @VPRRET@("B",$P(^MDC(704.102,X,0),U,1),X)=""
  1.  Q