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

HMPDGMPL.m

Go to the documentation of this file.
  1. HMPDGMPL ;SLC/MKB,ASMR/RRB,BL - Problem extract;Aug 29, 2016 20:06:27
  1. ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^AUPNPROB 5703
  1. ; ^DPT 10035
  1. ; ^VA(200 10060
  1. ; ^WV(790.05 5772
  1. ; %DT 10003
  1. ; DIQ 2056
  1. ; GMPLUTL2 2741
  1. ; SDUTL3 1252
  1. ; XLFDT 10103
  1. ; XUAF4 2171
  1. Q
  1. ; ------------ Get problems from VistA ------------
  1. ;
  1. EN(DFN,BEG,END,MAX,IFN) ; -- find patient's problems
  1. N HMPSTS,HMPPROB,HMPN,HMPITM,HMPCNT,X
  1. ;
  1. ; get one problem
  1. I $G(IFN)="WV" D WV(.HMPITM,1),XML(.HMPITM):$D(HMPITM) Q
  1. I $G(IFN) D EN1(IFN,.HMPITM),XML(.HMPITM) Q
  1. ;
  1. ; get all patient problems
  1. S DFN=+$G(DFN) I '(DFN>0) D LOGDPT^HMPLOG(DFN) Q ;DE4496, 19 August 2016
  1. S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999),HMPCNT=0
  1. S HMPSTS=$G(FILTER("status")) ;default = all problems
  1. D LIST^GMPLUTL2(.HMPPROB,DFN,HMPSTS)
  1. S HMPN=0 F S HMPN=$O(HMPPROB(HMPN)) Q:(HMPN<1)!(HMPCNT'<MAX) D
  1. . S X=$P(HMPPROB(HMPN),U,5) I X,(X<BEG)!(X>END) Q ;onset
  1. . S X=+HMPPROB(HMPN) K HMPITM ;ien
  1. . D EN1(X,.HMPITM),XML(.HMPITM)
  1. . S HMPCNT=HMPCNT+1
  1. I $P($G(^DPT(DFN,0)),U,2)="F" D WV(.HMPITM),XML(.HMPITM):$D(HMPITM) ;ICR 10035 DE2818 ASF 11/2/15
  1. Q
  1. ;
  1. EN1(ID,PROB) ; -- return a problem in PROB("attribute")=value
  1. N HMPL,X,I,J K PROB
  1. S ID=+$G(ID) Q:ID<1 ;invalid ien
  1. D DETAIL^GMPLUTL2(ID,.HMPL) Q:'$D(HMPL) ;doesn't exist
  1. S PROB("id")=ID ;,PROB("lexiconID")=+X1 ;SNOMED?
  1. S PROB("name")=$G(HMPL("NARRATIVE"))
  1. S X=$G(HMPL("MODIFIED")) S:$L(X) PROB("updated")=$$DATE(X)
  1. S PROB("icd")=$G(HMPL("DIAGNOSIS"))
  1. S X=$G(HMPL("STATUS")) S:$L(X) PROB("status")=$E(X)_U_X
  1. S X=$G(HMPL("HISTORY")) S:$L(X) PROB("history")=$E(X)_U_X
  1. S X=$G(HMPL("PRIORITY")) S:$L(X) PROB("acuity")=$E(X)_U_X
  1. S X=$G(HMPL("ONSET")) S:$L(X) PROB("onset")=$$DATE(X)
  1. S X=$$GET1^DIQ(9000011,ID_",",1.07,"I") S:X PROB("resolved")=X
  1. S X=$P($G(HMPL("ENTERED")),U) S:$L(X) PROB("entered")=$$DATE(X)
  1. S X=$$GET1^DIQ(9000011,ID_",",1.02,"I")
  1. S:X="P" PROB("unverified")=0,PROB("removed")=0
  1. S:X="T" PROB("unverified")=1,PROB("removed")=0
  1. S:X="H" PROB("unverified")=0,PROB("removed")=1
  1. S X=$G(HMPL("SC")),X=$S(X="YES":1,X="NO":0,1:"")
  1. S:$L(X) PROB("sc")=X I $G(HMPL("EXPOSURE")) D ;ao^rad^pgulf^hnc^mst^cv
  1. . S I=0 F S I=$O(HMPL("EXPOSURE",I)) Q:I<1 D
  1. .. S X=$G(HMPL("EXPOSURE",I))
  1. .. S PROB("exposure",I)=$$EXP(X)
  1. S X=$G(HMPL("PROVIDER")) S:$L(X) PROB("provider")=$$GET1^DIQ(9000011,ID_",",1.05,"I")_U_X
  1. S X=$$GET1^DIQ(9000011,ID_",",1.06) S:$L(X) PROB("service")=X
  1. S X=$G(HMPL("CLINIC")) S:$L(X) PROB("location")=X
  1. S X=+$$GET1^DIQ(9000011,ID_",",.06,"I")
  1. S:X PROB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
  1. I 'X S PROB("facility")=$$FAC^HMPD ;local stn#^name
  1. CMT ; comments
  1. Q:'$G(HMPL("COMMENT"))
  1. S I=0 F S I=$O(HMPL("COMMENT",I)) Q:I<1 D
  1. . S X=$G(HMPL("COMMENT",I))
  1. . S PROB("comment",I)=$$DATE($P(X,U))_U_$P(X,U,2,3)
  1. . ; = date ^ name of author ^ text
  1. Q
  1. ;
  1. WV(PROB,UPD) ; -- return a pregnancy log entry in PROB("attribute")=value
  1. N I,X0,Y K PROB
  1. S I=$O(^WV(790.05,"C",DFN,""),-1) Q:'I ;last entry ICR 5772 DE2818 ASF 11/23/15
  1. S X0=$G(^WV(790.05,I,0)),Y=0
  1. ; status=YES, future due date (allow past 14 days)
  1. I $P(X0,U,3),$P(X0,U,4)'<$$FMADD^XLFDT(DT,-14) S Y=1
  1. I 'Y,'$G(UPD) Q
  1. ; continue if pregnant, or update requested
  1. S PROB("id")="WV",PROB("entered")=+X0
  1. S PROB("name")="Pregnancy",PROB("icd")="V22.2"
  1. ; PROB("problemType")=64572001 ;HITSP/Condition
  1. S PROB("status")=$S(Y:"A^ACTIVE",1:"I^INACTIVE")
  1. S PROB("resolved")=$P(X0,U,4) ;due date
  1. S PROB("provider")=$$OUTPTPR^SDUTL3(DFN) ;primary care
  1. S PROB("facility")=$$FAC^HMPD
  1. Q
  1. ;
  1. DATE(X) ; -- Return internal form of date X
  1. N %DT,Y
  1. S %DT="" D ^%DT S:Y<1 Y=X
  1. Q Y
  1. ;
  1. VA200(X) ; -- Return ien of New Person X
  1. N Y S Y=$S($L($G(X)):+$O(^VA(200,"B",X,0)),1:"") ;ICR 10060 DE2818 ASF 11/23/15
  1. Q Y
  1. ;
  1. EXP(X) ; -- Return code for exposure name X
  1. N Y S Y="",X=$E($G(X))
  1. I X="A" S Y="AO" ;agent orange
  1. I X="R" S Y="IR" ;ionizing radiation
  1. I X="E" S Y="PG" ;persian gulf
  1. I X="H" S Y="HNC" ;head/neck cancer
  1. I X="M" S Y="MST" ;military sexual trauma
  1. I X="C" S Y="CV" ;combat vet
  1. I X="S" S Y="SHAD"
  1. Q Y
  1. ;
  1. ; ------------ Return data to middle tier ------------
  1. ;
  1. XML(PROB) ; -- Return patient problem as XML in @HMP@(I)
  1. N ATT,I,X,Y,P,TAG
  1. D ADD("<problem>") S HMPTOTL=$G(HMPTOTL)+1
  1. S ATT="" F S ATT=$O(PROB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
  1. . I ATT="exposure" D S Y="" Q
  1. .. S Y="<exposures>" D ADD(Y)
  1. .. S I=0 F S I=$O(PROB(ATT,I)) Q:I<1 S X=$G(PROB(ATT,I)) S:$L(X) Y="<exposure value='"_X_"' />" D ADD(Y)
  1. .. D ADD("</exposures>")
  1. . I ATT="comment" D S Y="" Q
  1. .. D ADD("<comments>")
  1. .. S I=0 F S I=$O(PROB(ATT,I)) Q:I<1 S X=$G(PROB(ATT,I)) D
  1. ... S Y="<comment id='"_I
  1. ... S:$L($P(X,U,1)) Y=Y_"' entered='"_$P(X,U)
  1. ... S:$L($P(X,U,2)) Y=Y_"' enteredBy='"_$$ESC^HMPD($P(X,U,2))
  1. ... S:$L($P(X,U,3)) Y=Y_"' commentText='"_$$ESC^HMPD($P(X,U,3))
  1. ... S Y=Y_"' />" D ADD(Y)
  1. .. D ADD("</comments>")
  1. . S X=$G(PROB(ATT)),Y="" Q:'$L(X)
  1. . I X'["^" S Y="<"_ATT_" value='"_$$ESC^HMPD(X)_"' />" Q
  1. . I $L(X)>1 D S Y=""
  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("</problem>")
  1. Q
  1. ;
  1. ADD(X) ; Add a line @HMP@(n)=X
  1. S HMPI=$G(HMPI)+1
  1. S @HMP@(HMPI)=X
  1. Q