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

VPRDJ02.m

Go to the documentation of this file. 
  1. VPRDJ02 ;SLC/MKB -- Problems,Allergies,Vitals ;6/25/12  16:11
  1.  ;;1.0;VIRTUAL PATIENT RECORD;**2,5**;Sep 01, 2011;Build 21
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^PXRMINDX                     4290
  1.  ; ^SC                          10040
  1.  ; DIC                           2051
  1.  ; DIQ                           2056
  1.  ; GMPLUTL2                      2741
  1.  ; GMRADPT                      10099
  1.  ; GMRAOR2                       2422
  1.  ; GMRVUT0,^UTILITY($J           1446
  1.  ; GMVGETQL                      5048
  1.  ; GMVGETVT                      5047
  1.  ; GMVUTL                        5046
  1.  ; ICDEX                         5747
  1.  ; XLFSTR                       10104
  1.  ; XUAF4                         2171
  1.  ;
  1.  ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
  1.  ;
  1. GMPL1(ID) ; -- problem
  1.  N VPRL,PROB,X,I,DATE,USER,FAC
  1.  D DETAIL^GMPLUTL2(ID,.VPRL) Q:'$D(VPRL)  ;doesn't exist
  1.  ;
  1.  S PROB("uid")=$$SETUID^VPRUTILS("problem",DFN,ID),PROB("localId")=ID
  1.  S PROB("problemText")=$G(VPRL("NARRATIVE"))
  1.  S DATE=$P($G(VPRL("ENTERED")),U)
  1.  S:$L(DATE) DATE=$$DATE^VPRDGMPL(DATE),PROB("entered")=$$JSONDT^VPRUTILS(DATE)
  1.  S X=$G(VPRL("DIAGNOSIS")) I $L(X) D
  1.  . N ICD9ZN,DIAG,SYS
  1.  . I DATE'>0 S DATE=DT
  1.  . S ICD9ZN=$$ICDDX^ICDEX(X,DATE,,"E"),DIAG=$S($P($G(ICD9ZN),U,4)'="":$P(ICD9ZN,U,4),1:X)
  1.  . S SYS=$$LOW^XLFSTR($G(VPRL("CSYS"),"ICD")) ;icd or 10d
  1.  . S PROB("icdCode")=$$SETNCS^VPRUTILS(SYS,X),PROB("icdName")=DIAG
  1.  S X=$G(VPRL("ONSET")) S:$L(X) X=$$DATE^VPRDGMPL(X),PROB("onset")=$$JSONDT^VPRUTILS(X)
  1.  S X=$G(VPRL("MODIFIED")) S:$L(X) X=$$DATE^VPRDGMPL(X),PROB("updated")=$$JSONDT^VPRUTILS(X)
  1.  S X=$G(VPRL("STATUS")) I $L(X) D
  1.  . S PROB("statusName")=X,X=$E(X)
  1.  . S X=$S(X="A":55561003,X="I":73425007,1:"")
  1.  . S PROB("statusCode")=$$SETNCS^VPRUTILS("sct",X)
  1.  S X=$G(VPRL("PRIORITY")) I X]"" D
  1.  . S X=$$LOW^XLFSTR(X),PROB("acuityName")=X
  1.  . S PROB("acuityCode")=$$SETVURN^VPRUTILS("prob-acuity",$E(X))
  1.  S X=$$GET1^DIQ(9000011,ID_",",1.07,"I") S:X PROB("resolved")=$$JSONDT^VPRUTILS(X)
  1.  S X=$$GET1^DIQ(9000011,ID_",",1.02,"I")
  1.  S:X="P" PROB("unverified")="false",PROB("removed")="false"
  1.  S:X="T" PROB("unverified")="true",PROB("removed")="false"
  1.  S:X="H" PROB("unverified")="false",PROB("removed")="true"
  1.  S X=$G(VPRL("SC")),X=$S(X="YES":"",X="NO":"false",1:"")
  1.  S:$L(X) PROB("serviceConnected")=X
  1.  S X=$G(VPRL("PROVIDER")) I $L(X) D
  1.  . S PROB("providerName")=X,X=$$GET1^DIQ(9000011,ID_",",1.05,"I")
  1.  . S PROB("providerUid")=$$SETUID^VPRUTILS("user",,+X)
  1.  S X=$$GET1^DIQ(9000011,ID_",",1.06) S:$L(X) PROB("service")=X
  1.  S X=$G(VPRL("CLINIC")) I $L(X) D
  1.  . S PROB("locationName")=X
  1.  . N LOC S LOC=+$$FIND1^DIC(44,,"QX",X)
  1.  . S:LOC PROB("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
  1.  S X=+$$GET1^DIQ(9000011,ID_",",.06,"I")
  1.  S:X FAC=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
  1.  I 'X S FAC=$$FAC^VPRD ;local stn#^name
  1.  D FACILITY^VPRUTILS(FAC,"PROB")
  1.  S I=0 F  S I=$O(VPRL("COMMENT",I)) Q:I<1  D
  1.  . S X=$G(VPRL("COMMENT",I))
  1.  . S USER=$$VA200^VPRDGMPL($P(X,U,2)),DATE=$$DATE^VPRDGMPL($P(X,U))
  1.  . S PROB("comments",I,"enteredByCode")=$$SETUID^VPRUTILS("user",,+USER)
  1.  . S PROB("comments",I,"enteredByName")=$P(X,U,2)
  1.  . S PROB("comments",I,"entered")=$$JSONDT^VPRUTILS(DATE)
  1.  . S PROB("comments",I,"comment")=$P(X,U,3)
  1.  D ADD^VPRDJ("PROB","problem")
  1.  Q
  1.  ;
  1. GMRA1(ID) ; -- allergy/reaction GMRAL(ID)
  1.  N GMRA,VPRY,REAC,X,Y,I
  1.  S GMRA=$G(GMRAL(ID)) D EN1^GMRAOR2(ID,"VPRY")
  1.  ;
  1.  S X=$P(VPRY,U,10) I $L(X) S X=$$DATE^VPRDGMRA(X) Q:X<VPRSTART  Q:X>VPRSTOP  S REAC("entered")=$$JSONDT^VPRUTILS(X)
  1.  S X=$$FAC^VPRD D FACILITY^VPRUTILS(X,"REAC")
  1.  S REAC("kind")="Allergy / Adverse Reaction"
  1.  S REAC("localId")=ID,REAC("uid")=$$SETUID^VPRUTILS("allergy",DFN,ID)
  1.  S (REAC("summary"),REAC("products",1,"name"))=$P(VPRY,U) I $P(GMRA,U,9) D
  1.  . S X=$P(GMRA,U,9),REAC("reference")=X
  1.  . S Y=+$P(X,"(",2) I 'Y,X["PSDRUG" S Y=50
  1.  . S I=$$VUID^VPRD(+X,Y),REAC("products",1,"vuid")=$$SETVURN^VPRUTILS("vuid",I)
  1.  S REAC("historical")=$S($E($P(VPRY,U,5))="H":"true",1:"false")
  1.  ; REAC("adverseEventTypeName")=$P(VPRY,U,7)_" "_$P(VPRY,U,6) ;TYPE_MECH
  1.  I $P(VPRY,U,4)="VERIFIED",$P(VPRY,U,9) S REAC("verified")=$$JSONDT^VPRUTILS($P(VPRY,U,9))
  1.  ; reactions
  1.  S I=0 F  S I=$O(GMRAL(ID,"S",I)) Q:I<1  D
  1.  . S X=$G(GMRAL(ID,"S",I))
  1.  . S REAC("reactions",I,"name")=$P(X,";")
  1.  . S Y=$$VUID^VPRD(+$P(X,";",2),120.83)
  1.  . S REAC("reactions",I,"vuid")=$$SETVURN^VPRUTILS("vuid",Y)
  1.  I GMRA="" S REAC("removed")="true" ;entered in error
  1.  D ADD^VPRDJ("REAC","allergy")
  1.  Q
  1.  ;
  1. NKA ; -- no assessment or NKA [GMRAL=0 or ""]
  1.  N REAC,X
  1.  S REAC("assessment")=$S(GMRAL=0:"nka",1:"not done")
  1.  S X=$$FAC^VPRD D FACILITY^VPRUTILS(X,"REAC")
  1.  D ADD^VPRDJ("REAC","allergy")
  1.  Q
  1.  ;
  1. GMV1(ID) ; -- vital/measurement ^UTILITY($J,"GMRVD",VPRIDT,VPRTYP,ID)
  1.  N VIT,VPRY,X0,TYPE,LOC,FAC,X,Y,MRES,MUNT,HIGH,LOW,I
  1.  D GETREC^GMVUTL(.VPRY,ID,1) S X0=$G(VPRY(0))
  1.  ; GMRVUT0 returns CLiO data with a pseudo-ID >> get real ID
  1.  I X0="",$G(VPRIDT),$D(VPRTYP) D  ;[from VPRDJ0]
  1.  . N GMRVD S GMRVD=$G(^UTILITY($J,"GMRVD",VPRIDT,VPRTYP,ID))
  1.  . S ID=$O(^PXRMINDX(120.5,"PI",DFN,$P(GMRVD,U,3),+GMRVD,""))
  1.  . I $L(ID) D GETREC^GMVUTL(.VPRY,ID,1) S X0=$G(VPRY(0))
  1.  Q:X0=""
  1.  ;
  1.  S VIT("localId")=ID,VIT("kind")="Vital Sign"
  1.  S VIT("uid")=$$SETUID^VPRUTILS("vital",DFN,ID)
  1.  S VIT("observed")=$$JSONDT^VPRUTILS(+X0)
  1.  S VIT("resulted")=$$JSONDT^VPRUTILS(+$P(X0,U,4))
  1.  S TYPE=$$FIELD^GMVGETVT(+$P(X0,U,3),2)
  1.  S VIT("displayName")=TYPE
  1.  S VIT("typeName")=$$FIELD^GMVGETVT($P(X0,U,3),1)
  1.  S VIT("typeCode")="urn:va:vuid:"_$$FIELD^GMVGETVT($P(X0,U,3),4)
  1.  S X=$P(X0,U,8),VIT("result")=X
  1.  S VIT("units")=$$UNIT^VPRDGMV(TYPE),(MRES,MUNT)=""
  1.  I TYPE="T"  S MUNT="C",MRES=$J(X-32*5/9,0,1) ;EN1^GMRVUTL
  1.  I TYPE="HT" S MUNT="cm",MRES=$J(2.54*X,0,2)  ;EN2^GMRVUTL
  1.  I TYPE="WT" S MUNT="kg",MRES=$J(X/2.2,0,2)   ;EN3^GMRVUTL
  1.  I TYPE="CG" S MUNT="cm",MRES=$J(2.54*X,0,2)
  1.  S:MRES VIT("metricResult")=MRES,VIT("metricUnits")=MUNT
  1.  S X=$$RANGE^VPRDGMV(TYPE) I $L(X) S VIT("high")=$P(X,U),VIT("low")=$P(X,U,2)
  1.  S VIT("summary")=VIT("typeName")_" "_VIT("result")_" "_VIT("units")
  1.  F I=1:1:$L(VPRY(5),U) S X=$P(VPRY(5),U,I) I X D
  1.  . S VIT("qualifiers",I,"name")=$$FIELD^GMVGETQL(X,1)
  1.  . S VIT("qualifiers",I,"vuid")=$$FIELD^GMVGETQL(X,3)
  1.  I $G(VPRY(2)) S VIT("removed")="true"        ;entered in error
  1.  S LOC=+$P(X0,U,5),FAC=$$FAC^VPRD(LOC)
  1.  S VIT("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
  1.  S VIT("locationName")=$S(LOC:$P($G(^SC(LOC,0)),U),1:"unknown")
  1.  D FACILITY^VPRUTILS(FAC,"VIT")
  1.  D ADD^VPRDJ("VIT","vital")
  1.  Q
  1.  ;
  1. VPR(COLL) ; -- VPR Patient Objects
  1.  N ID I $L($G(VPRID)) D  Q
  1.  . S ID=+VPRID I 'ID S ID=+$O(^VPR(560.1,"B",VPRID,0)) ;IEN or UID
  1.  . D:ID VPR1(560.1,ID)
  1.  Q:$G(COLL)=""  ;error
  1.  S ID=0 F  S ID=$O(^VPR(560.1,"C",DFN,COLL,ID)) Q:ID<1  D VPR1(560.1,ID)
  1.  Q
  1. VPR1(FNUM,ID) ; -- [patient] object
  1.  N I,X,VPRY
  1.  S I=0 F  S I=$O(^VPR(FNUM,ID,1,I)) Q:I<1  S X=$G(^(I,0)),VPRY(I)=X
  1.  I $D(VPRY) D  ;already encoded JSON
  1.  . S VPRI=VPRI+1 S:VPRI>1 @VPR@(VPRI,.3)=","
  1.  . M @VPR@(VPRI)=VPRY
  1.  Q