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

NHINVPL.m

Go to the documentation of this file.
  1. NHINVPL ;SLC/MKB -- Problem extract
  1. ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^VA(200 10060
  1. ; %DT 10003
  1. ; DIQ 2056
  1. ; GMPLUTL2 2741
  1. ; XUAF4 2171
  1. ;
  1. ; ------------ Get problems from VistA ------------
  1. ;
  1. EN(DFN,BEG,END,MAX,IFN) ; -- find patient's problems
  1. N NHIPROB,NHI,NHITM,NHICNT,X
  1. ;
  1. ; get one problem
  1. I $G(IFN) D EN1(IFN,.NHITM),XML(.NHITM) Q
  1. ;
  1. ; get all patient problems
  1. S DFN=+$G(DFN) Q:DFN<1
  1. S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999),NHICNT=0
  1. D LIST^GMPLUTL2(.NHIPROB,DFN,"") ;all problems
  1. S NHI=0 F S NHI=$O(NHIPROB(NHI)) Q:(NHI<1)!(NHICNT'<MAX) D
  1. . S X=$P(NHIPROB(NHI),U,5) I X,(X<BEG)!(X>END) Q ;onset
  1. . S X=+NHIPROB(NHI) K NHITM ;ien
  1. . D EN1(X,.NHITM),XML(.NHITM)
  1. . S NHICNT=NHICNT+1
  1. Q
  1. ;
  1. EN1(ID,PROB) ; -- return a problem in PROB("attribute")=value
  1. N NHPL,X,I,J K PROB
  1. S ID=+$G(ID) Q:ID<1 ;invalid ien
  1. D DETAIL^GMPLUTL2(ID,.NHPL) Q:'$D(NHPL) ;doesn't exist
  1. S PROB("id")=ID ;,PROB("lexiconID")=+X1 ;SNOMED?
  1. S PROB("name")=$G(NHPL("NARRATIVE"))
  1. S X=$G(NHPL("MODIFIED")) S:$L(X) PROB("updated")=$$DATE(X)
  1. S PROB("icd")=$G(NHPL("DIAGNOSIS"))
  1. S X=$G(NHPL("STATUS")) S:$L(X) PROB("status")=$E(X)
  1. S X=$G(NHPL("HISTORY")) S:$L(X) PROB("history")=$E(X)
  1. S X=$G(NHPL("PRIORITY")) S:$L(X) PROB("acuity")=$E(X)
  1. S X=$G(NHPL("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(NHPL("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(NHPL("SC")),X=$S(X="YES":1,X="NO":0,1:"")
  1. S:$L(X) PROB("sc")=X I $G(NHPL("EXPOSURE")) D ;ao^rad^pgulf^hnc^mst^cv
  1. . S I=0 F S I=$O(NHPL("EXPOSURE",I)) Q:I<1 D
  1. .. S X=$G(NHPL("EXPOSURE",I))
  1. .. S PROB("exposure",I)=$$EXP(X)
  1. S X=$G(NHPL("PROVIDER")) S:$L(X) PROB("provider")=$$VA200(X)_U_X
  1. S X=$$GET1^DIQ(9000011,ID_",",1.06) S:$L(X) PROB("service")=X
  1. S X=$G(NHPL("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^NHINV ;local stn#^name
  1. CMT ; comments
  1. Q:'$G(NHPL("COMMENT"))
  1. S I=0 F S I=$O(NHPL("COMMENT",I)) Q:I<1 D
  1. . S X=$G(NHPL("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. 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:"")
  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 @NHIN@(I)
  1. N ATT,I,X,Y,P,TAG
  1. D ADD("<problem>") S NHINTOTL=$G(NHINTOTL)+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^NHINV($P(X,U,2))
  1. ... S:$L($P(X,U,3)) Y=Y_"' commentText='"_$$ESC^NHINV($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^NHINV(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^NHINV($P(X,U,P))_"' "
  1. .. S Y=Y_"/>" D ADD(Y)
  1. D ADD("</problem>")
  1. Q
  1. ;
  1. ADD(X) ; Add a line @NHIN@(n)=X
  1. S NHINI=$G(NHINI)+1
  1. S @NHIN@(NHINI)=X
  1. Q