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

NHINVTIU.m

Go to the documentation of this file. 
  1. NHINVTIU ;SLC/MKB -- TIU extract
  1.  ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^SC(                         10040
  1.  ; ^VA(200                      10060
  1.  ; DIQ                           2056
  1.  ; TIUSRVLO                 2834,2865
  1.  ; TIUSRVR1                      2944
  1.  ;
  1.  ; ------------ Get documents from VistA ------------
  1.  ;
  1. EN(DFN,BEG,END,MAX,ID) ; -- find patient's documents
  1.  N NHITM,NHI,NHX,NHY,NHDAD
  1.  S DFN=+$G(DFN) Q:$G(DFN)<1
  1.  S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
  1.  ;
  1.  ; get one document
  1.  I $L($G(ID)),ID[";" D RPT^NHINVLRA(DFN,ID,.NHITM),XML(.NHITM) Q  ;Lab
  1.  I $G(ID),ID["-" D RPT^NHINVRA(DFN,ID,.NHITM),XML(.NHITM) Q  ;Radiology
  1.  I $G(ID) D  Q
  1.  . N SHOWADD S SHOWADD=1
  1.  . S NHX=ID_U_$$RESOLVE^TIUSRVLO(ID)
  1.  . D EN1(ID,.NHITM),XML(.NHITM)
  1.  ;
  1.  ; get all documents via
  1.  D CONTEXT^TIUSRVLO(.NHY,3,1,DFN,BEG,END,,MAX,,1)
  1.  S NHI=0 F  S NHI=$O(@NHY@(NHI)) Q:NHI<1  D
  1.  . S NHX=$G(@NHY@(NHI)),IFN=+NHX
  1.  . K NHITM D EN1(IFN,.NHITM)
  1.  . D:$D(NHITM) XML(.NHITM)
  1.  Q
  1.  ;
  1. EN1(IEN,DOC) ; -- return a document in DOC("attribute")=value
  1.  ;  Expects DFN, NHX=IEN ^ $$RESOLVE^TIUSRVLO(IEN)
  1.  N X,NAME,NHINX,ES,I K DOC
  1.  S IEN=+$G(IEN) Q:IEN<1  ;invalid ien
  1.  Q:"UNKNOWN"[$P($G(NHX),U,2)  ;null or invalid
  1.  S DOC("id")=IEN,NAME=$P(NHX,U,2),DOC("localTitle")=NAME
  1.  I $P(NHX,U,14),$P(NAME," ")="Addendum" D  Q
  1.  . N DATE,PARENT K DOC
  1.  . S DATE=$P(NHX,U,3),PARENT=$P(NHX,U,14)
  1.  . I DATE,PARENT>1 S NHDAD(PARENT,DATE)=NHX
  1.  S X=$$GET1^DIQ(8925,IEN_",",".01:1501") S:$L(X) DOC("nationalTitle")=X
  1.  S X=$$GET1^DIQ(8925,IEN_",",".01:1501:99.99") S:$L(X) DOC("nationalTitleCode")=X
  1.  S X=$$GET1^DIQ(8925,IEN_",",.04) S:$L(X) DOC("documentClass")=X
  1.  S DOC("referenceDateTime")=$P(NHX,U,3)
  1.  S X=$P(NHX,U,6) D  ;S:$L(X) DOC("location")=X
  1.  . N LOC S LOC=$S($L(X):+$O(^SC("B",X,0)),1:0)
  1.  . S DOC("facility")=$$FAC^NHINV(LOC)
  1.  S X=$P(NHX,U,7) S:$L(X) DOC("status")=X
  1.  S:$L($P(NHX,U,12)) DOC("subject")=$P(NHX,U,12)
  1.  ; X=$S($P(NHX,U,13)[">":"C",$P(NHX,U,13)["<":"I",1:"") ;componentType
  1.  S DOC("encounter")=$$GET1^DIQ(8925,IEN_",",.03,"I") ;$$VSTR(IEN)
  1.  S DOC("content")=$$TEXT(IEN)
  1.  ; providers &/or signatures
  1.  S X=$P(NHX,U,5),I=0 S:X I=I+1,DOC("clinician",I)=+X_U_$P(X,";",3)_"^A" ;author
  1.  D GETS^DIQ(8925,IEN_",","1501;1502;1507;1508","IE","NHINX")
  1.  M ES=NHINX(8925,IEN_",") I ES(1501,"I") D
  1.  . S I=I+1
  1.  . S DOC("clinician",I)=ES(1502,"I")_U_ES(1502,"E")_"^S^"_ES(1501,"I")_U_$$SIG(ES(1502,"I"))
  1.  I ES(1507,"I") D  ; cosigner
  1.  . S I=I+1
  1.  . S DOC("clinician",I)=ES(1508,"I")_U_ES(1508,"E")_"^C^"_ES(1507,"I")_U_$$SIG(ES(1508,"I"))
  1.  Q
  1.  ;
  1. VSTR(DA) ; -- get visit string for document DA
  1.  ;  Expects DFN, NHX = IEN ^ $$RESOLVE^TIUSRVLO(IEN)
  1.  N VDT,VTYP,VLOC,Y
  1.  S VDT=$P($P(NHX,U,8),";",2)
  1.  S VTYP=$$GET1^DIQ(8925,DA_",",.13)
  1.  S VLOC=$$GET1^DIQ(8925,DA_",",1211,"I")
  1.  S Y=VLOC_";"_VDT_";"_VTYP
  1.  Q Y
  1.  ;
  1. SIG(X) ; -- Return Signature Block Name_Title
  1.  N X20,Y S X20=$G(^VA(200,+$G(X),20))
  1.  S Y=$P(X20,U,2)_" "_$P(X20,U,3)
  1.  Q Y
  1.  ;
  1. RPT(NHY,IFN) ; -- Return text of document in @NHY@(n)
  1.  D TGET^TIUSRVR1(.NHY,IFN)
  1.  Q
  1.  ;
  1. TEXT(IFN) ; -- Return document IFN as a text string
  1.  N I,Y,NHY S IFN=+$G(IFN),Y=""
  1.  I IFN D
  1.  . D TGET^TIUSRVR1(.NHY,IFN)
  1.  . S I=0 F  S I=$O(@NHY@(I)) Q:I<1  S Y=Y_$S($L(Y):$C(13,10),1:"")_@NHY@(I)
  1.  Q Y
  1.  ;
  1.  ; ------------ Return data to middle tier ------------
  1.  ;
  1. XML(DOC) ; -- Return patient documents as XML
  1.  N ATT,X,Y,NAMES,TYPE
  1.  D ADD("<document>") S NHINTOTL=$G(NHINTOTL)+1
  1.  S ATT="" F  S ATT=$O(DOC(ATT)) Q:ATT=""  D  D:$L(Y) ADD(Y)
  1.  . I $O(DOC(ATT,0)) D  S Y="" Q  ;multiples
  1.  .. D ADD("<"_ATT_"s>")
  1.  .. S I=0 F  S I=$O(DOC(ATT,I)) Q:I<1  D
  1.  ... S X=$G(DOC(ATT,I)),NAMES=""
  1.  ... I ATT="clinician" S NAMES="code^name^role^dateTime^signature^Z"
  1.  ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
  1.  .. D ADD("</"_ATT_"s>")
  1.  . S X=$G(DOC(ATT)),Y="" Q:'$L(X)
  1.  . I ATT="content" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
  1.  . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
  1.  . I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
  1.  D ADD("</document>")
  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^NHINV($P(X,U,P))_"' "
  1.  Q STR
  1.  ;
  1. ADD(X) ; Add a line @NHIN@(n)=X
  1.  S NHINI=$G(NHINI)+1
  1.  S @NHIN@(NHINI)=X
  1.  Q