HMPDJ02 ;ASMR/MKB/JD,CK,CPC,PB - Problems,Allergies,Vitals ;Aug 23, 2016 09:56:26
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;Sep 02, 2016;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^PXRMINDX 4290
; ^SC 10040
; ^AUPNPROB 2727 (where items not available from GMPLUTL2)
; DIC 2051
; DIQ 2056
; GMPLUTL2 2741
; GMRADPT 10099
; GMRAOR2 2422
; GMRVUT0,^UTILITY($J 1446
; GMVGETQL 5048
; GMVGETVT 5047
; GMVUTL 5046
; ICDEX 5747
; XLFSTR 10104
; XUAF4 2171
; ^AUPNVSIT( 2028
; ^TIU(8925,DA,0 6154
;
; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
;
Q
;
GMPL1(ID,POVLST) ; -- problem
N HMPL,PROB,X,I,DATE,USER,FAC,LEXS
D DETAIL^GMPLUTL2(ID,.HMPL) Q:'$D(HMPL) ;doesn't exist
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the problem domain"
;
S PROB("uid")=$$SETUID^HMPUTILS("problem",DFN,ID),PROB("localId")=ID
S PROB("problemText")=$G(HMPL("NARRATIVE"))
S DATE=$P($G(HMPL("ENTERED")),U)
S:$L(DATE) DATE=$$DATE^HMPDGMPL(DATE),PROB("entered")=$$JSONDT^HMPUTILS(DATE)
S X=$G(HMPL("DIAGNOSIS")) I $L(X) D
. N ICD9ZN,DIAG,SCTCODE
. I DATE'>0 S DATE=DT
. S ICD9ZN=$$ICDDX^ICDEX(X,DATE),DIAG=$S($P($G(ICD9ZN),U,4)'="":$P(ICD9ZN,U,4),1:X) ;Sep 1, 2016 - PB - DE5033
. ; BEGIN MOD ASF 09/8/15 US 9239 DE 2082
. ; Only set icdCode and icdName if it is ICD9 (ICD10 is only available in codes array)
. I HMPL("CSYS")="ICD" S PROB("icdCode")=$$SETNCS^HMPUTILS("icd",HMPL("DIAGNOSIS")),PROB("icdName")=DIAG
. ; Create codes array for both ICD9 or ICD10
. S PROB("codes",1,"code")=HMPL("DIAGNOSIS")
. S PROB("codes",1,"display")=$S(HMPL("CSYS")="ICD":DIAG,HMPL("CSYS")="10D":HMPL("ICDD"))
. S PROB("codes",1,"system")=$S(HMPL("CSYS")="ICD":"urn:oid:2.16.840.1.113883.6.42",HMPL("CSYS")="10D":"urn:oid:2.16.840.1.113883.6.3",1:"codesystem error")
. ;SNOMED CT codes
. S SCTCODE=HMPL("SCTC") ;DE4685 ;9000011,80001 SNOMED CT CONCEPT CODE
. D:SCTCODE EN^LEXCODE(SCTCODE) ; ICR 1614
. I $D(LEXS("SCT",1)) D
. . S PROB("codes",2,"code")=SCTCODE
. . S PROB("codes",2,"code","\s")="" ; Ensure code is sent as a string
. . S PROB("codes",2,"display")=$P(LEXS("SCT",1),U,2)
. . S PROB("codes",2,"system")="http://snomed.info/sct"
. ; END MOD ASF US 9239 DE 2082
;Get the internal date from ^AUPNPROB so the imprecise date can be converted properly
;JD - 2/1/16 - DE3548
S X=$$GET1^DIQ(9000011,ID_",",.01,"I") S:$L(X) PROB("lexiconCode")=X ; DE4680 May 11, 2016 - added lexiconCode to JDS
S X=$$GET1^DIQ(9000011,ID_",",.13,"I") S:$L(X) PROB("onset")=$$JSONDT^HMPUTILS(X) ;retrieve internal value for proper date format
S X=$G(HMPL("MODIFIED")) S:$L(X) X=$$DATE^HMPDGMPL(X),PROB("updated")=$$JSONDT^HMPUTILS(X)
S X=$G(HMPL("STATUS")) I $L(X) D
. S PROB("statusName")=X,X=$E(X)
. S X=$S(X="A":55561003,X="I":73425007,1:"")
. S PROB("statusCode")=$$SETNCS^HMPUTILS("sct",X)
;S X=$G(HMPL("PRIORITY")) I X]"" D
S X=$$GET1^DIQ(9000011,ID_",",1.14,"I") I X]"" D ;DE3988 take directly from the file regardless of status
. S X=$S(X="C":"chronic",X="A":"acute",1:"")
. I X'="" S PROB("acuityName")=X,PROB("acuityCode")=$$SETVURN^HMPUTILS("prob-acuity",$E(X))
S X=$$GET1^DIQ(9000011,ID_",",1.07,"I") S:X PROB("resolved")=$$JSONDT^HMPUTILS(X)
S X=$P(HMPL("ENTERED"),U,2) S:$L(X) PROB("enteredBy")=X ; DE5096 June 24, 2016 - add addt'l problem fields to JDS
S X=$P(HMPL("RECORDED"),U,2) S:$L(X) PROB("recordedBy")=X ; DE5096 June 24, 2016
S X=$$GET1^DIQ(9000011,ID_",",1.09,"I") S:$L(X) PROB("recordedOn")=$$JSONDT^HMPUTILS(X) ; DE5096 July 1, 2016
S X=$$GET1^DIQ(9000011,ID_",",1.02,"I")
S:X="P" PROB("unverified")="false",PROB("removed")="false"
S:X="T" PROB("unverified")="true",PROB("removed")="false"
S:X="H" PROB("unverified")="false",PROB("removed")="true"
S X=$G(HMPL("SC")),X=$S(X="YES":"true",X="NO":"false",1:"") ; DE3918, Mar 2, 2016
S:$L(X) PROB("serviceConnected")=X
S X=$G(HMPL("PROVIDER")) I $L(X) D
. S PROB("providerName")=X,X=$$GET1^DIQ(9000011,ID_",",1.05,"I")
. S PROB("providerUid")=$$SETUID^HMPUTILS("user",,+X)
S X=$$GET1^DIQ(9000011,ID_",",1.06) S:$L(X) PROB("service")=X
S X=$G(HMPL("CLINIC")) I $L(X) D
. S PROB("locationName")=X
. N LOC S LOC=+$$FIND1^DIC(44,,"QX",X)
. S:LOC PROB("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
S X=+$$GET1^DIQ(9000011,ID_",",.06,"I")
S:X FAC=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
I 'X S FAC=$$FAC^HMPD ;local stn#^name
D FACILITY^HMPUTILS(FAC,"PROB")
S I=0 F S I=$O(HMPL("COMMENT",I)) Q:I<1 D
. S X=$G(HMPL("COMMENT",I))
. S USER=$$VA200^HMPDGMPL($P(X,U,2)),DATE=$$DATE^HMPDGMPL($P(X,U))
. S PROB("comments",I,"noteCounter")=I ; Feb 24, 2016 - US12724
. S PROB("comments",I,"enteredByCode")=$$SETUID^HMPUTILS("user",,+USER)
. S PROB("comments",I,"enteredByName")=$P(X,U,2)
. S PROB("comments",I,"entered")=$$JSONDT^HMPUTILS(DATE)
. S PROB("comments",I,"comment")=$P(X,U,3)
I $D(POVLST) D GMPLVST(ID,"PROB",.POVLST) ;JL;add encounter information.
;== Treatment attributes - Added on 1/4/16 - JD - US12358
;Modified 1/8/16 - JD - US12358
;Guarding against direct sets into ^AUPNPROB in RPC: "ORQQPL ADD SAVE" by checking for "Y" and "N".
S X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.11,"I"))
S:$L(X) PROB("agentOrangeExposure")=$S(X=1:"YES",$E(X)="Y":"YES",X=0:"NO",$E(X)="N":"NO",1:X)
S X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.12,"I"))
S:$L(X) PROB("radiationExposure")=$S(X=1:"YES",$E(X)="Y":"YES",X=0:"NO",$E(X)="N":"NO",1:X)
S X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.13,"I"))
S:$L(X) PROB("persianGulfExposure")=$S(X=1:"YES",$E(X)="Y":"YES",X=0:"NO",$E(X)="N":"NO",1:X)
S X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.15,"I"))
S:$L(X) PROB("headNeckCancer")=$S(X=1:"YES",$E(X)="Y":"YES",X=0:"NO",$E(X)="N":"NO",1:X)
S X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.16,"I"))
S:$L(X) PROB("militarySexualTrauma")=$S(X=1:"YES",$E(X)="Y":"YES",X=0:"NO",$E(X)="N":"NO",1:X)
S X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.17,"I"))
S:$L(X) PROB("combatVeteran")=$S(X=1:"YES",$E(X)="Y":"YES",X=0:"NO",$E(X)="N":"NO",1:X)
S X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.18,"I"))
S:$L(X) PROB("shipboardHazard")=$S(X=1:"YES",$E(X)="Y":"YES",X=0:"NO",$E(X)="N":"NO",1:X)
;==
S PROB("lastUpdateTime")=$$EN^HMPSTMP("problem")
S PROB("stampTime")=PROB("lastUpdateTime") ; RHL 20141231
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("problem",PROB("uid"),PROB("stampTime")) Q:HMPMETA=1 ;US11019/US6734
D ADD^HMPDJ("PROB","problem")
Q
;
GMPLVST(ID,Y,POVLST) ; --- JL;associate problem with visit and notes
Q:'$G(ID)!'$G(^AUPNPROB(ID,0))!'$D(POVLST) ;invalid id or no data
N ICDCODE
S ICDCODE=$$CODEC^ICDEX(80,$$GET1^DIQ(9000011,ID_",",.01,"I")) Q:ICDCODE=-1 ;invalid icdcode Sep 1, 2016 - PB - DE5033
Q:$D(POVLST(ICDCODE))=0
N IDX,VCNT,NCNT,DIEN,VIEN,FAC,STCODE
S IDX="",VCNT=0,NCNT=0 F S IDX=$O(POVLST(ICDCODE,IDX)) Q:IDX="" D
. S VCNT=VCNT+1
. S VIEN=+$G(POVLST(ICDCODE,IDX)),FAC=$$FAC^HMPDJ04(VIEN),STCODE=$$STCODE^HMPDJ04(VIEN)
. I FAC D FACILITY^HMPUTILS(FAC,Y_"(""encounters"","_VCNT_")") ; facility info
. I STCODE D STOPCODE^HMPDJ04(STCODE,Y_"(""encounters"","_VCNT_")") ; stop code
. S @Y@("encounters",VCNT,"dateTime")=$$JSONDT^HMPUTILS($$DATE^HMPDGMPL(+IDX))
. S @Y@("encounters",VCNT,"visitUid")=$$SETUID^HMPUTILS("visit",DFN,VIEN)
. N ENINFO S ENINFO=$G(POVLST(ICDCODE,IDX))
. S DIEN=+$P(ENINFO,U,2)
. ;W "DIEN is "_DIEN,!
. I DIEN D
. . S NCNT=NCNT+1
. . ; extract the extra data from the document
. . N DOCINFO S DOCINFO=$E(ENINFO,$F($G(ENINFO),U),$L(ENINFO))
. . N OUTPUT S OUTPUT="" D EN1^HMPDJ08(DOCINFO,3,.OUTPUT)
. . N NAME F NAME="documentTypeName","entered","summary","facilityName","authorDisplayName" D
. . . S:$D(OUTPUT(NAME)) @Y@("documents",NCNT,NAME)=$G(OUTPUT(NAME))
. . S @Y@("documents",NCNT,"documentUid")=$$SETUID^HMPUTILS("document",DFN,DIEN)
Q
;
GMPLPOV(DFNN,POVLST,DONTKILL) ; -- JL;All problem of visit related to the patient from V POV file
;INPUT: Patient's DFN
;OUTPUT: Patient's VISIT list in the format of
; OUTPUT(DIAGNOSIS,DATATIME)="VISITIEN"
;
Q:'$G(DFNN)
N INVVST
K:'DONTKILL POVLST ; clear the output
; Query V POV(^AUPNVPOV() by using "AA" Cross Reference.
S INVVST="",CURVST="" F S INVVST=$O(^AUPNVPOV("AA",DFNN,INVVST)) Q:INVVST="" D
. N CURVST,DIEN
. S CURVST=INVVST,DIEN="" F S DIEN=$O(^AUPNVPOV("AA",DFNN,CURVST,DIEN)) Q:DIEN="" D
. . N ICDIEN,PVISIT
. . S ICDIEN=+$P(^AUPNVPOV(DIEN,0),U,1),PVISIT=$P(^AUPNVPOV(DIEN,0),U,3)
. . N VISITDT
. . S VISITDT=+$G(^AUPNVSIT(PVISIT,0)) Q:'$L(VISITDT) ;quit if no visit is found, bad data entry.
. . N ICDCODE,VIEN
. . S ICDCODE=$$CODEC^ICDEX(80,ICDIEN) Q:ICDCODE=-1 ;convert to ICD code, quit if not valid Sep 1, 2016 - PB - DE5033
. . I $D(POVLST(ICDCODE,VISITDT))'=0 D Q
. . . S VIEN=$$GETVIEN^HMPDJ02A(DFNN,VISITDT)
. . . ; W:VIEN=-1 "Can not find VISIT IEN for "_VISITDT,!
. . . S:VIEN'=-1 POVLST(ICDCODE,VISITDT)=VIEN
Q
;
DIAGLIST(DIAGS,DFN,ORDATE,ORPRCNT) ;BL,JL; get list diagnosis on past notes
S:'+$G(ORDATE) ORDATE=DT
S:'+$G(ORPRCNT) ORPRCNT=1
;Use TIU DOCUMENTS BY CONTEXT to retrieve all notes associated with patient (CONTEXT^TIUSRVLO)
K ENC,DIAGCODE,CNT,DIAG,DIAGNUM,DIAGLINE,ENCNUM,LINE,IEN,CLASS,CONTEXT,EARLY,LATE,PERSON,OCCLIM,SEQUENCE,SHOWADD,INCUND,LSTNUM,NOTEINFO
K NEWCNT,OLDLST,DIAGCNT
S CLASS=3,CONTEXT=1,EARLY=-1,LATE=-1,PERSON=0,OCCLIM=0,SEQUENCE="D",SHOWADD=0,INCUND=0,OLDLST=""
;TAKE EXISTING LIST FROM ENCOUNTER CALL AND PRESERVE TO BE APPENDED AFTERWARD
K DIAGS S DIAGS=""
D CONTEXT^TIUSRVLO(.DIAGS,CLASS,CONTEXT,DFN,EARLY,LATE,PERSON,OCCLIM,SEQUENCE,SHOWADD,INCUND)
M DIAGS=^TMP("TIUR",$J)
;Go through notes list extract diagnosis associated with each encounter to previous problem list
S LSTNUM=""
;THIS CALL WILL EXTRACT ALL THE VISIT INFORMATION TO ^TMP(PXKENC,$J,VISIT)
N VIEN
F S LSTNUM=$O(DIAGS(LSTNUM)) Q:LSTNUM="" D
. N HMPV
. S NOTEINFO=""
. S IEN=$P(DIAGS(LSTNUM),"^",1)
. ;DE6877 - 21 Jan 17 - PB next two lines of code check to see if the Visit/Admit Date&Time and/or Patient Name fields are missing for the visit. if either are missing processing this record stops.
. S HMPV=$P($G(^TIU(8925,IEN,0)),U,3)
. I $G(HMPV)>0 Q:$$VSTIEN^HMPDJ02A(HMPV)>0
. D PCE4NOTE^ORWPCE3(.NOTEINFO,IEN,DFN)
. S CNT=0,DIAGCNT=0
. F S CNT=$O(NOTEINFO(CNT)) Q:CNT="" D
. . Q:$P(NOTEINFO(CNT),"^",1)'["POV"
. . S DIAGCNT=DIAGCNT+1
. . S VISITDT=$P($G(NOTEINFO(2)),U,3) ; get the visit datetime
. . S ICDCODE=$P(NOTEINFO(CNT),U,2) ; get the diagnosis code
. . I $D(ENC(ICDCODE,VISITDT))=0 D
. . . S VIEN=$$GETVIEN^HMPDJ02A(DFN,VISITDT)
. . . ;W:VIEN=-1 "Can not find Visit ID for "_NOTEINFO(CNT),!
. . . S:VIEN'=-1 ENC(ICDCODE,VISITDT)=VIEN_U_$G(DIAGS(LSTNUM)) ; add to list only if visit ien is valid
; KILL DIAGS BECAUSE IT NOW CONTAINS NOTE INFO
K DIAGS
M DIAGS=ENC
;CLEAN UP ARRAYS
K NOTEINFO,ENC,DIAG,^TMP("TIUR",$J)
D GMPLPOV(DFN,.DIAGS,1) ; Also loop thru V POV file to find extra encounter
Q
;
GMRA1(ID) ; -- allergy/reaction GMRAL(ID)
N GMRA,HMPY,REAC,X,Y,I,USER,CMMT
S GMRA=$G(GMRAL(ID)) D EN1^GMRAOR2(ID,"HMPY")
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the allergy domain"
;
S X=$P(HMPY,U,10) I $L(X) S X=$$DATE^HMPDGMRA(X) Q:X<HMPSTART Q:X>HMPSTOP S REAC("entered")=$$JSONDT^HMPUTILS(X)
S X=$$FAC^HMPD D FACILITY^HMPUTILS(X,"REAC")
S REAC("kind")="Allergy / Adverse Reaction"
S REAC("localId")=ID,REAC("uid")=$$SETUID^HMPUTILS("allergy",DFN,ID)
S (REAC("summary"),REAC("products",1,"name"))=$P(HMPY,U) I $P(GMRA,U,9) D
. S X=$P(GMRA,U,9),REAC("reference")=X
. S Y=+$P(X,"(",2) I 'Y,X["PSDRUG" S Y=50
. S I=$$VUID^HMPD(+X,Y),REAC("products",1,"vuid")=$$SETVURN^HMPUTILS("vuid",I)
S X=$P(HMPY,U,2) S:$L(X) REAC("originatorName")=X
S REAC("historical")=$S($E($P(HMPY,U,5))="H":"true",1:"false")
S X=$P(HMPY,U,6) S:$L(X) REAC("mechanism")=X
S X=$P(HMPY,U,7) S:$L(X) REAC("typeName")=X
; REAC("adverseEventTypeName")=$P(HMPY,U,7)_" "_$P(HMPY,U,6) ;TYPE_MECH
I $P(HMPY,U,4)="VERIFIED",$P(HMPY,U,9) D
. S REAC("verified")=$$JSONDT^HMPUTILS($P(HMPY,U,9))
. S REAC("verifierName")=$P(HMPY,U,8)
; severity
S I=0 F S I=$O(HMPY("O",I)) Q:I<1 D
. S X=$G(HMPY("O",I))
. S REAC("observations",I,"date")=$$JSONDT^HMPUTILS(+X)
. S REAC("observations",I,"severity")=$P(X,U,2)
; reactions
S I=0 F S I=$O(GMRAL(ID,"S",I)) Q:I<1 D
. S X=$G(GMRAL(ID,"S",I))
. S REAC("reactions",I,"name")=$P(X,";")
. S Y=$$VUID^HMPD(+$P(X,";",2),120.83)
. S REAC("reactions",I,"vuid")=$$SETVURN^HMPUTILS("vuid",Y)
; drug classes
S I=0 F S I=$O(HMPY("V",I)) Q:I<1 D
. S X=$G(HMPY("V",I))
. S REAC("drugClasses",I,"code")=$P(X,U)
. S REAC("drugClasses",I,"name")=$P(X,U,2)
S I=0 F S I=$O(HMPY("C",I)) Q:I<1 D
. S X=$G(HMPY("C",I)),USER=$$VA200^HMPDGMPL($P(X,U,3))
. S REAC("comments",I,"enteredByUid")=$$SETUID^HMPUTILS("user",,+USER)
. S REAC("comments",I,"enteredByName")=$P(X,U,3)
. S REAC("comments",I,"entered")=$$JSONDT^HMPUTILS(+X)
. K CMMT M CMMT=HMPY("C",I)
. S REAC("comments",I,"comment")=$$STRING^HMPD(.CMMT)
I GMRA="" S REAC("removed")="true" ;entered in error
; next
S REAC("lastUpdateTime")=$$EN^HMPSTMP("allergy")
S REAC("stampTime")=REAC("lastUpdateTime") ; RHL 20141231
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("allergy",REAC("uid"),REAC("stampTime")) Q:HMPMETA=1 ;US11019/US6734
D ADD^HMPDJ("REAC","allergy")
Q
;
NKA ; -- no assessment or NKA [GMRAL=0 or ""]
N REAC,X
S X=$G(^GMR(120.86,DFN,0)) Q:GMRAL=""!'$P(X,U,2)
S REAC("uid")=$$SETUID^HMPUTILS("obs",DFN,"120.86;"_DFN)
S REAC("typeCode")="urn:sct:160244002"
S REAC("typeName")="No known allergies"
S X=$$FAC^HMPD D FACILITY^HMPUTILS(X,"REAC")
D ADD^HMPDJ("REAC","allergy")
Q
;
GMV1(ID) ; -- vital/measurement ^UTILITY($J,"GMRVD",HMPIDT,HMPTYP,ID)
N VIT,HMPY,X0,TYPE,LOC,FAC,X,Y,MRES,MUNT,HIGH,LOW,I
D GETREC^GMVUTL(.HMPY,ID,1) S X0=$G(HMPY(0))
; GMRVUT0 returns CLiO data with a pseudo-ID >> get real ID
I X0="",$G(HMPIDT),$D(HMPTYP) D ;[from HMPDJ0]
. N GMRVD S GMRVD=$G(^UTILITY($J,"GMRVD",HMPIDT,HMPTYP,ID))
. S ID=$O(^PXRMINDX(120.5,"PI",DFN,$P(GMRVD,U,3),+GMRVD,""))
. I $L(ID) D GETREC^GMVUTL(.HMPY,ID,1) S X0=$G(HMPY(0))
Q:X0=""
;
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the vitals domain"
S VIT("localId")=ID,VIT("kind")="Vital Sign"
S VIT("uid")=$$SETUID^HMPUTILS("vital",DFN,ID)
S VIT("observed")=$$JSONDT^HMPUTILS(+X0)
S VIT("resulted")=$$JSONDT^HMPUTILS(+$P(X0,U,4))
S TYPE=$$FIELD^GMVGETVT(+$P(X0,U,3),2)
S VIT("displayName")=TYPE
S VIT("typeName")=$$FIELD^GMVGETVT($P(X0,U,3),1)
S VIT("typeCode")="urn:va:vuid:"_$$FIELD^GMVGETVT($P(X0,U,3),4)
S X=$P(X0,U,8),VIT("result")=X
S VIT("units")=$$UNIT^HMPDGMV(TYPE),(MRES,MUNT)=""
I TYPE="T" S:X=+X MUNT="C",MRES=$J(X-32*5/9,0,1) ;EN1^GMRVUTL
I TYPE="HT" S MUNT="cm",MRES=$J(2.54*X,0,2) ;EN2^GMRVUTL
I TYPE="WT" S MUNT="kg",MRES=$J(X/2.2,0,2) ;EN3^GMRVUTL
I TYPE="CG" S MUNT="cm",MRES=$J(2.54*X,0,2)
S:MRES VIT("metricResult")=MRES,VIT("metricUnits")=MUNT
S X=$$RANGE^HMPDGMV(TYPE) I $L(X) S VIT("high")=$P(X,U),VIT("low")=$P(X,U,2)
S VIT("summary")=VIT("typeName")_" "_VIT("result")_" "_VIT("units")
F I=1:1:$L(HMPY(5),U) S X=$P(HMPY(5),U,I) I X D
. S VIT("qualifiers",I,"name")=$$FIELD^GMVGETQL(X,1)
. S VIT("qualifiers",I,"vuid")=$$FIELD^GMVGETQL(X,3)
;US4338 - add pulse ox qualifier if it exists. name component is required. vuid is not per Thomas Loth
I $P(X0,U,10) S VIT("qualifiers",I+1,"name")=$P(X0,U,10)
I $G(HMPY(2)) D
. S VIT("removed")="true" ;entered in error
. S X=$$GET1^DIQ(120.506,"1,"_ID_",",.01,"E") S:X VIT("reasonEnteredInError")=X
. S X=$$GET1^DIQ(120.506,"1,"_ID_",",.02,"I") S:X VIT("dateEnteredInError")=$$JSONDT^HMPUTILS(X)
S LOC=+$P(X0,U,5),FAC=$$FAC^HMPD(LOC)
S VIT("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
S VIT("locationName")=$S(LOC:$P($G(^SC(LOC,0)),U),1:"unknown")
N USERID S USERID=$P(HMPY(0),U,6)
I $G(USERID) D
. S VIT("enteredByUid")=$$SETUID^HMPUTILS("user",,USERID)
. S VIT("enteredByName")=$P($G(^VA(200,USERID,0)),U,1)
D FACILITY^HMPUTILS(FAC,"VIT")
S VIT("lastUpdateTime")=$$EN^HMPSTMP("vital")
S VIT("stampTime")=VIT("lastUpdateTime") ; RHL 20141231
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("vital",VIT("uid"),VIT("stampTime")) Q:HMPMETA=1 ;US11019/US6734
D ADD^HMPDJ("VIT","vital")
Q
;
HMP(COLL) ; -- HMP Patient Objects
N ID I $L($G(HMPID)) D Q
. S ID=+HMPID I 'ID S ID=+$O(^HMP(800000.1,"B",HMPID,0)) ;IEN or UID
. D:ID HMP1(800000.1,ID)
Q:$G(COLL)="" ;error
S ID=0 F S ID=$O(^HMP(800000.1,"C",DFN,COLL,ID)) Q:ID<1 D HMP1(800000.1,ID)
Q
HMP1(FNUM,ID) ; -- [patient] object
N I,X,HMPY
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=$G(DFN)
S ERRMSG="A problem occurred retreiving record "_ID_" for the HMP domain"
S I=0 F S I=$O(^HMP(FNUM,ID,1,I)) Q:I<1 S X=$G(^(I,0)),HMPY(I)=X
I $D(HMPY) D ;already encoded JSON
. S HMPI=HMPI+1 S:HMPI>1 @HMP@(HMPI,.3)=","
. M @HMP@(HMPI)=HMPY
. ; -- chunk data if from DQINIT^HMPDJFSP ; i.e. HMPCHNK defined ;*S68-JCH*
. D CHNKCHK^HMPDJFSP(.HMP,.HMPI) ;*S68-JCH*
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ02 18030 printed Apr 09, 2024@21:00:05 Page 2
HMPDJ02 ;ASMR/MKB/JD,CK,CPC,PB - Problems,Allergies,Vitals ;Aug 23, 2016 09:56:26
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;Sep 02, 2016;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^PXRMINDX 4290
+7 ; ^SC 10040
+8 ; ^AUPNPROB 2727 (where items not available from GMPLUTL2)
+9 ; DIC 2051
+10 ; DIQ 2056
+11 ; GMPLUTL2 2741
+12 ; GMRADPT 10099
+13 ; GMRAOR2 2422
+14 ; GMRVUT0,^UTILITY($J 1446
+15 ; GMVGETQL 5048
+16 ; GMVGETVT 5047
+17 ; GMVUTL 5046
+18 ; ICDEX 5747
+19 ; XLFSTR 10104
+20 ; XUAF4 2171
+21 ; ^AUPNVSIT( 2028
+22 ; ^TIU(8925,DA,0 6154
+23 ;
+24 ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
+25 ;
+26 QUIT
+27 ;
GMPL1(ID,POVLST) ; -- problem
+1 NEW HMPL,PROB,X,I,DATE,USER,FAC,LEXS
+2 ;doesn't exist
DO DETAIL^GMPLUTL2(ID,.HMPL)
if '$DATA(HMPL)
QUIT
+3 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+4 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+5 SET ERRMSG="A problem occurred converting record "_ID_" for the problem domain"
+6 ;
+7 SET PROB("uid")=$$SETUID^HMPUTILS("problem",DFN,ID)
SET PROB("localId")=ID
+8 SET PROB("problemText")=$GET(HMPL("NARRATIVE"))
+9 SET DATE=$PIECE($GET(HMPL("ENTERED")),U)
+10 if $LENGTH(DATE)
SET DATE=$$DATE^HMPDGMPL(DATE)
SET PROB("entered")=$$JSONDT^HMPUTILS(DATE)
+11 SET X=$GET(HMPL("DIAGNOSIS"))
IF $LENGTH(X)
Begin DoDot:1
+12 NEW ICD9ZN,DIAG,SCTCODE
+13 IF DATE'>0
SET DATE=DT
+14 ;Sep 1, 2016 - PB - DE5033
SET ICD9ZN=$$ICDDX^ICDEX(X,DATE)
SET DIAG=$SELECT($PIECE($GET(ICD9ZN),U,4)'="":$PIECE(ICD9ZN,U,4),1:X)
+15 ; BEGIN MOD ASF 09/8/15 US 9239 DE 2082
+16 ; Only set icdCode and icdName if it is ICD9 (ICD10 is only available in codes array)
+17 IF HMPL("CSYS")="ICD"
SET PROB("icdCode")=$$SETNCS^HMPUTILS("icd",HMPL("DIAGNOSIS"))
SET PROB("icdName")=DIAG
+18 ; Create codes array for both ICD9 or ICD10
+19 SET PROB("codes",1,"code")=HMPL("DIAGNOSIS")
+20 SET PROB("codes",1,"display")=$SELECT(HMPL("CSYS")="ICD":DIAG,HMPL("CSYS")="10D":HMPL("ICDD"))
+21 SET PROB("codes",1,"system")=$SELECT(HMPL("CSYS")="ICD":"urn:oid:2.16.840.1.113883.6.42",HMPL("CSYS")="10D":"urn:oid:2.16.840.1.113883.6.3",1:"codesystem error")
+22 ;SNOMED CT codes
+23 ;DE4685 ;9000011,80001 SNOMED CT CONCEPT CODE
SET SCTCODE=HMPL("SCTC")
+24 ; ICR 1614
if SCTCODE
DO EN^LEXCODE(SCTCODE)
+25 IF $DATA(LEXS("SCT",1))
Begin DoDot:2
+26 SET PROB("codes",2,"code")=SCTCODE
+27 ; Ensure code is sent as a string
SET PROB("codes",2,"code","\s")=""
+28 SET PROB("codes",2,"display")=$PIECE(LEXS("SCT",1),U,2)
+29 SET PROB("codes",2,"system")="http://snomed.info/sct"
End DoDot:2
+30 ; END MOD ASF US 9239 DE 2082
End DoDot:1
+31 ;Get the internal date from ^AUPNPROB so the imprecise date can be converted properly
+32 ;JD - 2/1/16 - DE3548
+33 ; DE4680 May 11, 2016 - added lexiconCode to JDS
SET X=$$GET1^DIQ(9000011,ID_",",.01,"I")
if $LENGTH(X)
SET PROB("lexiconCode")=X
+34 ;retrieve internal value for proper date format
SET X=$$GET1^DIQ(9000011,ID_",",.13,"I")
if $LENGTH(X)
SET PROB("onset")=$$JSONDT^HMPUTILS(X)
+35 SET X=$GET(HMPL("MODIFIED"))
if $LENGTH(X)
SET X=$$DATE^HMPDGMPL(X)
SET PROB("updated")=$$JSONDT^HMPUTILS(X)
+36 SET X=$GET(HMPL("STATUS"))
IF $LENGTH(X)
Begin DoDot:1
+37 SET PROB("statusName")=X
SET X=$EXTRACT(X)
+38 SET X=$SELECT(X="A":55561003,X="I":73425007,1:"")
+39 SET PROB("statusCode")=$$SETNCS^HMPUTILS("sct",X)
End DoDot:1
+40 ;S X=$G(HMPL("PRIORITY")) I X]"" D
+41 ;DE3988 take directly from the file regardless of status
SET X=$$GET1^DIQ(9000011,ID_",",1.14,"I")
IF X]""
Begin DoDot:1
+42 SET X=$SELECT(X="C":"chronic",X="A":"acute",1:"")
+43 IF X'=""
SET PROB("acuityName")=X
SET PROB("acuityCode")=$$SETVURN^HMPUTILS("prob-acuity",$EXTRACT(X))
End DoDot:1
+44 SET X=$$GET1^DIQ(9000011,ID_",",1.07,"I")
if X
SET PROB("resolved")=$$JSONDT^HMPUTILS(X)
+45 ; DE5096 June 24, 2016 - add addt'l problem fields to JDS
SET X=$PIECE(HMPL("ENTERED"),U,2)
if $LENGTH(X)
SET PROB("enteredBy")=X
+46 ; DE5096 June 24, 2016
SET X=$PIECE(HMPL("RECORDED"),U,2)
if $LENGTH(X)
SET PROB("recordedBy")=X
+47 ; DE5096 July 1, 2016
SET X=$$GET1^DIQ(9000011,ID_",",1.09,"I")
if $LENGTH(X)
SET PROB("recordedOn")=$$JSONDT^HMPUTILS(X)
+48 SET X=$$GET1^DIQ(9000011,ID_",",1.02,"I")
+49 if X="P"
SET PROB("unverified")="false"
SET PROB("removed")="false"
+50 if X="T"
SET PROB("unverified")="true"
SET PROB("removed")="false"
+51 if X="H"
SET PROB("unverified")="false"
SET PROB("removed")="true"
+52 ; DE3918, Mar 2, 2016
SET X=$GET(HMPL("SC"))
SET X=$SELECT(X="YES":"true",X="NO":"false",1:"")
+53 if $LENGTH(X)
SET PROB("serviceConnected")=X
+54 SET X=$GET(HMPL("PROVIDER"))
IF $LENGTH(X)
Begin DoDot:1
+55 SET PROB("providerName")=X
SET X=$$GET1^DIQ(9000011,ID_",",1.05,"I")
+56 SET PROB("providerUid")=$$SETUID^HMPUTILS("user",,+X)
End DoDot:1
+57 SET X=$$GET1^DIQ(9000011,ID_",",1.06)
if $LENGTH(X)
SET PROB("service")=X
+58 SET X=$GET(HMPL("CLINIC"))
IF $LENGTH(X)
Begin DoDot:1
+59 SET PROB("locationName")=X
+60 NEW LOC
SET LOC=+$$FIND1^DIC(44,,"QX",X)
+61 if LOC
SET PROB("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
End DoDot:1
+62 SET X=+$$GET1^DIQ(9000011,ID_",",.06,"I")
+63 if X
SET FAC=$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U)
+64 ;local stn#^name
IF 'X
SET FAC=$$FAC^HMPD
+65 DO FACILITY^HMPUTILS(FAC,"PROB")
+66 SET I=0
FOR
SET I=$ORDER(HMPL("COMMENT",I))
if I<1
QUIT
Begin DoDot:1
+67 SET X=$GET(HMPL("COMMENT",I))
+68 SET USER=$$VA200^HMPDGMPL($PIECE(X,U,2))
SET DATE=$$DATE^HMPDGMPL($PIECE(X,U))
+69 ; Feb 24, 2016 - US12724
SET PROB("comments",I,"noteCounter")=I
+70 SET PROB("comments",I,"enteredByCode")=$$SETUID^HMPUTILS("user",,+USER)
+71 SET PROB("comments",I,"enteredByName")=$PIECE(X,U,2)
+72 SET PROB("comments",I,"entered")=$$JSONDT^HMPUTILS(DATE)
+73 SET PROB("comments",I,"comment")=$PIECE(X,U,3)
End DoDot:1
+74 ;JL;add encounter information.
IF $DATA(POVLST)
DO GMPLVST(ID,"PROB",.POVLST)
+75 ;== Treatment attributes - Added on 1/4/16 - JD - US12358
+76 ;Modified 1/8/16 - JD - US12358
+77 ;Guarding against direct sets into ^AUPNPROB in RPC: "ORQQPL ADD SAVE" by checking for "Y" and "N".
+78 SET X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.11,"I"))
+79 if $LENGTH(X)
SET PROB("agentOrangeExposure")=$SELECT(X=1:"YES",$EXTRACT(X)="Y":"YES",X=0:"NO",$EXTRACT(X)="N":"NO",1:X)
+80 SET X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.12,"I"))
+81 if $LENGTH(X)
SET PROB("radiationExposure")=$SELECT(X=1:"YES",$EXTRACT(X)="Y":"YES",X=0:"NO",$EXTRACT(X)="N":"NO",1:X)
+82 SET X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.13,"I"))
+83 if $LENGTH(X)
SET PROB("persianGulfExposure")=$SELECT(X=1:"YES",$EXTRACT(X)="Y":"YES",X=0:"NO",$EXTRACT(X)="N":"NO",1:X)
+84 SET X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.15,"I"))
+85 if $LENGTH(X)
SET PROB("headNeckCancer")=$SELECT(X=1:"YES",$EXTRACT(X)="Y":"YES",X=0:"NO",$EXTRACT(X)="N":"NO",1:X)
+86 SET X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.16,"I"))
+87 if $LENGTH(X)
SET PROB("militarySexualTrauma")=$SELECT(X=1:"YES",$EXTRACT(X)="Y":"YES",X=0:"NO",$EXTRACT(X)="N":"NO",1:X)
+88 SET X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.17,"I"))
+89 if $LENGTH(X)
SET PROB("combatVeteran")=$SELECT(X=1:"YES",$EXTRACT(X)="Y":"YES",X=0:"NO",$EXTRACT(X)="N":"NO",1:X)
+90 SET X=$$UP^XLFSTR($$GET1^DIQ(9000011,ID_",",1.18,"I"))
+91 if $LENGTH(X)
SET PROB("shipboardHazard")=$SELECT(X=1:"YES",$EXTRACT(X)="Y":"YES",X=0:"NO",$EXTRACT(X)="N":"NO",1:X)
+92 ;==
+93 SET PROB("lastUpdateTime")=$$EN^HMPSTMP("problem")
+94 ; RHL 20141231
SET PROB("stampTime")=PROB("lastUpdateTime")
+95 ;US6734 - pre-compile metastamp
+96 ;US11019/US6734
IF $GET(HMPMETA)
DO ADD^HMPMETA("problem",PROB("uid"),PROB("stampTime"))
if HMPMETA=1
QUIT
+97 DO ADD^HMPDJ("PROB","problem")
+98 QUIT
+99 ;
GMPLVST(ID,Y,POVLST) ; --- JL;associate problem with visit and notes
+1 ;invalid id or no data
if '$GET(ID)!'$GET(^AUPNPROB(ID,0))!'$DATA(POVLST)
QUIT
+2 NEW ICDCODE
+3 ;invalid icdcode Sep 1, 2016 - PB - DE5033
SET ICDCODE=$$CODEC^ICDEX(80,$$GET1^DIQ(9000011,ID_",",.01,"I"))
if ICDCODE=-1
QUIT
+4 if $DATA(POVLST(ICDCODE))=0
QUIT
+5 NEW IDX,VCNT,NCNT,DIEN,VIEN,FAC,STCODE
+6 SET IDX=""
SET VCNT=0
SET NCNT=0
FOR
SET IDX=$ORDER(POVLST(ICDCODE,IDX))
if IDX=""
QUIT
Begin DoDot:1
+7 SET VCNT=VCNT+1
+8 SET VIEN=+$GET(POVLST(ICDCODE,IDX))
SET FAC=$$FAC^HMPDJ04(VIEN)
SET STCODE=$$STCODE^HMPDJ04(VIEN)
+9 ; facility info
IF FAC
DO FACILITY^HMPUTILS(FAC,Y_"(""encounters"","_VCNT_")")
+10 ; stop code
IF STCODE
DO STOPCODE^HMPDJ04(STCODE,Y_"(""encounters"","_VCNT_")")
+11 SET @Y@("encounters",VCNT,"dateTime")=$$JSONDT^HMPUTILS($$DATE^HMPDGMPL(+IDX))
+12 SET @Y@("encounters",VCNT,"visitUid")=$$SETUID^HMPUTILS("visit",DFN,VIEN)
+13 NEW ENINFO
SET ENINFO=$GET(POVLST(ICDCODE,IDX))
+14 SET DIEN=+$PIECE(ENINFO,U,2)
+15 ;W "DIEN is "_DIEN,!
+16 IF DIEN
Begin DoDot:2
+17 SET NCNT=NCNT+1
+18 ; extract the extra data from the document
+19 NEW DOCINFO
SET DOCINFO=$EXTRACT(ENINFO,$FIND($GET(ENINFO),U),$LENGTH(ENINFO))
+20 NEW OUTPUT
SET OUTPUT=""
DO EN1^HMPDJ08(DOCINFO,3,.OUTPUT)
+21 NEW NAME
FOR NAME="documentTypeName","entered","summary","facilityName","authorDisplayName"
Begin DoDot:3
+22 if $DATA(OUTPUT(NAME))
SET @Y@("documents",NCNT,NAME)=$GET(OUTPUT(NAME))
End DoDot:3
+23 SET @Y@("documents",NCNT,"documentUid")=$$SETUID^HMPUTILS("document",DFN,DIEN)
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
GMPLPOV(DFNN,POVLST,DONTKILL) ; -- JL;All problem of visit related to the patient from V POV file
+1 ;INPUT: Patient's DFN
+2 ;OUTPUT: Patient's VISIT list in the format of
+3 ; OUTPUT(DIAGNOSIS,DATATIME)="VISITIEN"
+4 ;
+5 if '$GET(DFNN)
QUIT
+6 NEW INVVST
+7 ; clear the output
if 'DONTKILL
KILL POVLST
+8 ; Query V POV(^AUPNVPOV() by using "AA" Cross Reference.
+9 SET INVVST=""
SET CURVST=""
FOR
SET INVVST=$ORDER(^AUPNVPOV("AA",DFNN,INVVST))
if INVVST=""
QUIT
Begin DoDot:1
+10 NEW CURVST,DIEN
+11 SET CURVST=INVVST
SET DIEN=""
FOR
SET DIEN=$ORDER(^AUPNVPOV("AA",DFNN,CURVST,DIEN))
if DIEN=""
QUIT
Begin DoDot:2
+12 NEW ICDIEN,PVISIT
+13 SET ICDIEN=+$PIECE(^AUPNVPOV(DIEN,0),U,1)
SET PVISIT=$PIECE(^AUPNVPOV(DIEN,0),U,3)
+14 NEW VISITDT
+15 ;quit if no visit is found, bad data entry.
SET VISITDT=+$GET(^AUPNVSIT(PVISIT,0))
if '$LENGTH(VISITDT)
QUIT
+16 NEW ICDCODE,VIEN
+17 ;convert to ICD code, quit if not valid Sep 1, 2016 - PB - DE5033
SET ICDCODE=$$CODEC^ICDEX(80,ICDIEN)
if ICDCODE=-1
QUIT
+18 IF $DATA(POVLST(ICDCODE,VISITDT))'=0
Begin DoDot:3
+19 SET VIEN=$$GETVIEN^HMPDJ02A(DFNN,VISITDT)
+20 ; W:VIEN=-1 "Can not find VISIT IEN for "_VISITDT,!
+21 if VIEN'=-1
SET POVLST(ICDCODE,VISITDT)=VIEN
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
DIAGLIST(DIAGS,DFN,ORDATE,ORPRCNT) ;BL,JL; get list diagnosis on past notes
+1 if '+$GET(ORDATE)
SET ORDATE=DT
+2 if '+$GET(ORPRCNT)
SET ORPRCNT=1
+3 ;Use TIU DOCUMENTS BY CONTEXT to retrieve all notes associated with patient (CONTEXT^TIUSRVLO)
+4 KILL ENC,DIAGCODE,CNT,DIAG,DIAGNUM,DIAGLINE,ENCNUM,LINE,IEN,CLASS,CONTEXT,EARLY,LATE,PERSON,OCCLIM,SEQUENCE,SHOWADD,INCUND,LSTNUM,NOTEINFO
+5 KILL NEWCNT,OLDLST,DIAGCNT
+6 SET CLASS=3
SET CONTEXT=1
SET EARLY=-1
SET LATE=-1
SET PERSON=0
SET OCCLIM=0
SET SEQUENCE="D"
SET SHOWADD=0
SET INCUND=0
SET OLDLST=""
+7 ;TAKE EXISTING LIST FROM ENCOUNTER CALL AND PRESERVE TO BE APPENDED AFTERWARD
+8 KILL DIAGS
SET DIAGS=""
+9 DO CONTEXT^TIUSRVLO(.DIAGS,CLASS,CONTEXT,DFN,EARLY,LATE,PERSON,OCCLIM,SEQUENCE,SHOWADD,INCUND)
+10 MERGE DIAGS=^TMP("TIUR",$JOB)
+11 ;Go through notes list extract diagnosis associated with each encounter to previous problem list
+12 SET LSTNUM=""
+13 ;THIS CALL WILL EXTRACT ALL THE VISIT INFORMATION TO ^TMP(PXKENC,$J,VISIT)
+14 NEW VIEN
+15 FOR
SET LSTNUM=$ORDER(DIAGS(LSTNUM))
if LSTNUM=""
QUIT
Begin DoDot:1
+16 NEW HMPV
+17 SET NOTEINFO=""
+18 SET IEN=$PIECE(DIAGS(LSTNUM),"^",1)
+19 ;DE6877 - 21 Jan 17 - PB next two lines of code check to see if the Visit/Admit Date&Time and/or Patient Name fields are missing for the visit. if either are missing processing this record stops.
+20 SET HMPV=$PIECE($GET(^TIU(8925,IEN,0)),U,3)
+21 IF $GET(HMPV)>0
if $$VSTIEN^HMPDJ02A(HMPV)>0
QUIT
+22 DO PCE4NOTE^ORWPCE3(.NOTEINFO,IEN,DFN)
+23 SET CNT=0
SET DIAGCNT=0
+24 FOR
SET CNT=$ORDER(NOTEINFO(CNT))
if CNT=""
QUIT
Begin DoDot:2
+25 if $PIECE(NOTEINFO(CNT),"^",1)'["POV"
QUIT
+26 SET DIAGCNT=DIAGCNT+1
+27 ; get the visit datetime
SET VISITDT=$PIECE($GET(NOTEINFO(2)),U,3)
+28 ; get the diagnosis code
SET ICDCODE=$PIECE(NOTEINFO(CNT),U,2)
+29 IF $DATA(ENC(ICDCODE,VISITDT))=0
Begin DoDot:3
+30 SET VIEN=$$GETVIEN^HMPDJ02A(DFN,VISITDT)
+31 ;W:VIEN=-1 "Can not find Visit ID for "_NOTEINFO(CNT),!
+32 ; add to list only if visit ien is valid
if VIEN'=-1
SET ENC(ICDCODE,VISITDT)=VIEN_U_$GET(DIAGS(LSTNUM))
End DoDot:3
End DoDot:2
End DoDot:1
+33 ; KILL DIAGS BECAUSE IT NOW CONTAINS NOTE INFO
+34 KILL DIAGS
+35 MERGE DIAGS=ENC
+36 ;CLEAN UP ARRAYS
+37 KILL NOTEINFO,ENC,DIAG,^TMP("TIUR",$JOB)
+38 ; Also loop thru V POV file to find extra encounter
DO GMPLPOV(DFN,.DIAGS,1)
+39 QUIT
+40 ;
GMRA1(ID) ; -- allergy/reaction GMRAL(ID)
+1 NEW GMRA,HMPY,REAC,X,Y,I,USER,CMMT
+2 SET GMRA=$GET(GMRAL(ID))
DO EN1^GMRAOR2(ID,"HMPY")
+3 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+4 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+5 SET ERRMSG="A problem occurred converting record "_ID_" for the allergy domain"
+6 ;
+7 SET X=$PIECE(HMPY,U,10)
IF $LENGTH(X)
SET X=$$DATE^HMPDGMRA(X)
if X<HMPSTART
QUIT
if X>HMPSTOP
QUIT
SET REAC("entered")=$$JSONDT^HMPUTILS(X)
+8 SET X=$$FAC^HMPD
DO FACILITY^HMPUTILS(X,"REAC")
+9 SET REAC("kind")="Allergy / Adverse Reaction"
+10 SET REAC("localId")=ID
SET REAC("uid")=$$SETUID^HMPUTILS("allergy",DFN,ID)
+11 SET (REAC("summary"),REAC("products",1,"name"))=$PIECE(HMPY,U)
IF $PIECE(GMRA,U,9)
Begin DoDot:1
+12 SET X=$PIECE(GMRA,U,9)
SET REAC("reference")=X
+13 SET Y=+$PIECE(X,"(",2)
IF 'Y
IF X["PSDRUG"
SET Y=50
+14 SET I=$$VUID^HMPD(+X,Y)
SET REAC("products",1,"vuid")=$$SETVURN^HMPUTILS("vuid",I)
End DoDot:1
+15 SET X=$PIECE(HMPY,U,2)
if $LENGTH(X)
SET REAC("originatorName")=X
+16 SET REAC("historical")=$SELECT($EXTRACT($PIECE(HMPY,U,5))="H":"true",1:"false")
+17 SET X=$PIECE(HMPY,U,6)
if $LENGTH(X)
SET REAC("mechanism")=X
+18 SET X=$PIECE(HMPY,U,7)
if $LENGTH(X)
SET REAC("typeName")=X
+19 ; REAC("adverseEventTypeName")=$P(HMPY,U,7)_" "_$P(HMPY,U,6) ;TYPE_MECH
+20 IF $PIECE(HMPY,U,4)="VERIFIED"
IF $PIECE(HMPY,U,9)
Begin DoDot:1
+21 SET REAC("verified")=$$JSONDT^HMPUTILS($PIECE(HMPY,U,9))
+22 SET REAC("verifierName")=$PIECE(HMPY,U,8)
End DoDot:1
+23 ; severity
+24 SET I=0
FOR
SET I=$ORDER(HMPY("O",I))
if I<1
QUIT
Begin DoDot:1
+25 SET X=$GET(HMPY("O",I))
+26 SET REAC("observations",I,"date")=$$JSONDT^HMPUTILS(+X)
+27 SET REAC("observations",I,"severity")=$PIECE(X,U,2)
End DoDot:1
+28 ; reactions
+29 SET I=0
FOR
SET I=$ORDER(GMRAL(ID,"S",I))
if I<1
QUIT
Begin DoDot:1
+30 SET X=$GET(GMRAL(ID,"S",I))
+31 SET REAC("reactions",I,"name")=$PIECE(X,";")
+32 SET Y=$$VUID^HMPD(+$PIECE(X,";",2),120.83)
+33 SET REAC("reactions",I,"vuid")=$$SETVURN^HMPUTILS("vuid",Y)
End DoDot:1
+34 ; drug classes
+35 SET I=0
FOR
SET I=$ORDER(HMPY("V",I))
if I<1
QUIT
Begin DoDot:1
+36 SET X=$GET(HMPY("V",I))
+37 SET REAC("drugClasses",I,"code")=$PIECE(X,U)
+38 SET REAC("drugClasses",I,"name")=$PIECE(X,U,2)
End DoDot:1
+39 SET I=0
FOR
SET I=$ORDER(HMPY("C",I))
if I<1
QUIT
Begin DoDot:1
+40 SET X=$GET(HMPY("C",I))
SET USER=$$VA200^HMPDGMPL($PIECE(X,U,3))
+41 SET REAC("comments",I,"enteredByUid")=$$SETUID^HMPUTILS("user",,+USER)
+42 SET REAC("comments",I,"enteredByName")=$PIECE(X,U,3)
+43 SET REAC("comments",I,"entered")=$$JSONDT^HMPUTILS(+X)
+44 KILL CMMT
MERGE CMMT=HMPY("C",I)
+45 SET REAC("comments",I,"comment")=$$STRING^HMPD(.CMMT)
End DoDot:1
+46 ;entered in error
IF GMRA=""
SET REAC("removed")="true"
+47 ; next
+48 SET REAC("lastUpdateTime")=$$EN^HMPSTMP("allergy")
+49 ; RHL 20141231
SET REAC("stampTime")=REAC("lastUpdateTime")
+50 ;US6734 - pre-compile metastamp
+51 ;US11019/US6734
IF $GET(HMPMETA)
DO ADD^HMPMETA("allergy",REAC("uid"),REAC("stampTime"))
if HMPMETA=1
QUIT
+52 DO ADD^HMPDJ("REAC","allergy")
+53 QUIT
+54 ;
NKA ; -- no assessment or NKA [GMRAL=0 or ""]
+1 NEW REAC,X
+2 SET X=$GET(^GMR(120.86,DFN,0))
if GMRAL=""!'$PIECE(X,U,2)
QUIT
+3 SET REAC("uid")=$$SETUID^HMPUTILS("obs",DFN,"120.86;"_DFN)
+4 SET REAC("typeCode")="urn:sct:160244002"
+5 SET REAC("typeName")="No known allergies"
+6 SET X=$$FAC^HMPD
DO FACILITY^HMPUTILS(X,"REAC")
+7 DO ADD^HMPDJ("REAC","allergy")
+8 QUIT
+9 ;
GMV1(ID) ; -- vital/measurement ^UTILITY($J,"GMRVD",HMPIDT,HMPTYP,ID)
+1 NEW VIT,HMPY,X0,TYPE,LOC,FAC,X,Y,MRES,MUNT,HIGH,LOW,I
+2 DO GETREC^GMVUTL(.HMPY,ID,1)
SET X0=$GET(HMPY(0))
+3 ; GMRVUT0 returns CLiO data with a pseudo-ID >> get real ID
+4 ;[from HMPDJ0]
IF X0=""
IF $GET(HMPIDT)
IF $DATA(HMPTYP)
Begin DoDot:1
+5 NEW GMRVD
SET GMRVD=$GET(^UTILITY($JOB,"GMRVD",HMPIDT,HMPTYP,ID))
+6 SET ID=$ORDER(^PXRMINDX(120.5,"PI",DFN,$PIECE(GMRVD,U,3),+GMRVD,""))
+7 IF $LENGTH(ID)
DO GETREC^GMVUTL(.HMPY,ID,1)
SET X0=$GET(HMPY(0))
End DoDot:1
+8 if X0=""
QUIT
+9 ;
+10 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+11 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+12 SET ERRMSG="A problem occurred converting record "_ID_" for the vitals domain"
+13 SET VIT("localId")=ID
SET VIT("kind")="Vital Sign"
+14 SET VIT("uid")=$$SETUID^HMPUTILS("vital",DFN,ID)
+15 SET VIT("observed")=$$JSONDT^HMPUTILS(+X0)
+16 SET VIT("resulted")=$$JSONDT^HMPUTILS(+$PIECE(X0,U,4))
+17 SET TYPE=$$FIELD^GMVGETVT(+$PIECE(X0,U,3),2)
+18 SET VIT("displayName")=TYPE
+19 SET VIT("typeName")=$$FIELD^GMVGETVT($PIECE(X0,U,3),1)
+20 SET VIT("typeCode")="urn:va:vuid:"_$$FIELD^GMVGETVT($PIECE(X0,U,3),4)
+21 SET X=$PIECE(X0,U,8)
SET VIT("result")=X
+22 SET VIT("units")=$$UNIT^HMPDGMV(TYPE)
SET (MRES,MUNT)=""
+23 ;EN1^GMRVUTL
IF TYPE="T"
if X=+X
SET MUNT="C"
SET MRES=$JUSTIFY(X-32*5/9,0,1)
+24 ;EN2^GMRVUTL
IF TYPE="HT"
SET MUNT="cm"
SET MRES=$JUSTIFY(2.54*X,0,2)
+25 ;EN3^GMRVUTL
IF TYPE="WT"
SET MUNT="kg"
SET MRES=$JUSTIFY(X/2.2,0,2)
+26 IF TYPE="CG"
SET MUNT="cm"
SET MRES=$JUSTIFY(2.54*X,0,2)
+27 if MRES
SET VIT("metricResult")=MRES
SET VIT("metricUnits")=MUNT
+28 SET X=$$RANGE^HMPDGMV(TYPE)
IF $LENGTH(X)
SET VIT("high")=$PIECE(X,U)
SET VIT("low")=$PIECE(X,U,2)
+29 SET VIT("summary")=VIT("typeName")_" "_VIT("result")_" "_VIT("units")
+30 FOR I=1:1:$LENGTH(HMPY(5),U)
SET X=$PIECE(HMPY(5),U,I)
IF X
Begin DoDot:1
+31 SET VIT("qualifiers",I,"name")=$$FIELD^GMVGETQL(X,1)
+32 SET VIT("qualifiers",I,"vuid")=$$FIELD^GMVGETQL(X,3)
End DoDot:1
+33 ;US4338 - add pulse ox qualifier if it exists. name component is required. vuid is not per Thomas Loth
+34 IF $PIECE(X0,U,10)
SET VIT("qualifiers",I+1,"name")=$PIECE(X0,U,10)
+35 IF $GET(HMPY(2))
Begin DoDot:1
+36 ;entered in error
SET VIT("removed")="true"
+37 SET X=$$GET1^DIQ(120.506,"1,"_ID_",",.01,"E")
if X
SET VIT("reasonEnteredInError")=X
+38 SET X=$$GET1^DIQ(120.506,"1,"_ID_",",.02,"I")
if X
SET VIT("dateEnteredInError")=$$JSONDT^HMPUTILS(X)
End DoDot:1
+39 SET LOC=+$PIECE(X0,U,5)
SET FAC=$$FAC^HMPD(LOC)
+40 SET VIT("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
+41 SET VIT("locationName")=$SELECT(LOC:$PIECE($GET(^SC(LOC,0)),U),1:"unknown")
+42 NEW USERID
SET USERID=$PIECE(HMPY(0),U,6)
+43 IF $GET(USERID)
Begin DoDot:1
+44 SET VIT("enteredByUid")=$$SETUID^HMPUTILS("user",,USERID)
+45 SET VIT("enteredByName")=$PIECE($GET(^VA(200,USERID,0)),U,1)
End DoDot:1
+46 DO FACILITY^HMPUTILS(FAC,"VIT")
+47 SET VIT("lastUpdateTime")=$$EN^HMPSTMP("vital")
+48 ; RHL 20141231
SET VIT("stampTime")=VIT("lastUpdateTime")
+49 ;US6734 - pre-compile metastamp
+50 ;US11019/US6734
IF $GET(HMPMETA)
DO ADD^HMPMETA("vital",VIT("uid"),VIT("stampTime"))
if HMPMETA=1
QUIT
+51 DO ADD^HMPDJ("VIT","vital")
+52 QUIT
+53 ;
HMP(COLL) ; -- HMP Patient Objects
+1 NEW ID
IF $LENGTH($GET(HMPID))
Begin DoDot:1
+2 ;IEN or UID
SET ID=+HMPID
IF 'ID
SET ID=+$ORDER(^HMP(800000.1,"B",HMPID,0))
+3 if ID
DO HMP1(800000.1,ID)
End DoDot:1
QUIT
+4 ;error
if $GET(COLL)=""
QUIT
+5 SET ID=0
FOR
SET ID=$ORDER(^HMP(800000.1,"C",DFN,COLL,ID))
if ID<1
QUIT
DO HMP1(800000.1,ID)
+6 QUIT
HMP1(FNUM,ID) ; -- [patient] object
+1 NEW I,X,HMPY
+2 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=$GET(DFN)
+4 SET ERRMSG="A problem occurred retreiving record "_ID_" for the HMP domain"
+5 SET I=0
FOR
SET I=$ORDER(^HMP(FNUM,ID,1,I))
if I<1
QUIT
SET X=$GET(^(I,0))
SET HMPY(I)=X
+6 ;already encoded JSON
IF $DATA(HMPY)
Begin DoDot:1
+7 SET HMPI=HMPI+1
if HMPI>1
SET @HMP@(HMPI,.3)=","
+8 MERGE @HMP@(HMPI)=HMPY
+9 ; -- chunk data if from DQINIT^HMPDJFSP ; i.e. HMPCHNK defined ;*S68-JCH*
+10 ;*S68-JCH*
DO CHNKCHK^HMPDJFSP(.HMP,.HMPI)
End DoDot:1
+11 QUIT
