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

VPRDPXAM.m

Go to the documentation of this file.
  1. VPRDPXAM ;SLC/MKB -- PCE V Exams ;8/2/11 15:29
  1. ;;1.0;VIRTUAL PATIENT RECORD;**1**;Sep 01, 2011;Build 38
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^AUPNVSIT 2028
  1. ; ^PXRMINDX 4290
  1. ; DILFD 2055
  1. ; PXPXRM 4250
  1. ; XUAF4 2171
  1. ;
  1. ; ------------ Get data from VistA ------------
  1. ;
  1. EN(DFN,BEG,END,MAX,IFN) ; -- find a patient's exams
  1. S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
  1. S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
  1. N VPRIDT,VPRN,VPRITM,VPRCNT
  1. ;
  1. ; get one exam
  1. I $G(IFN) D Q
  1. . N ITM,DATE K ^TMP("VPRPX",$J)
  1. . S ITM=0 F S ITM=$O(^PXRMINDX(9000010.13,"PI",+$G(DFN),ITM)) Q:ITM<1 D Q:$D(VPRITM)
  1. .. S DATE=0 F S DATE=$O(^PXRMINDX(9000010.13,"PI",+$G(DFN),ITM,DATE)) Q:DATE<1 I $D(^(DATE,IFN)) D Q
  1. ... S VPRIDT=9999999-DATE,^TMP("VPRPX",$J,VPRIDT,IFN)=ITM_U_DATE
  1. ... D EN1(IFN,.VPRITM),XML(.VPRITM)
  1. ;
  1. ; get all exams
  1. D SORT(DFN,BEG,END) S VPRCNT=0
  1. S VPRIDT=0 F S VPRIDT=$O(^TMP("VPRPX",$J,VPRIDT)) Q:VPRIDT<1 D Q:VPRCNT'<MAX
  1. . S VPRN=0 F S VPRN=$O(^TMP("VPRPX",$J,VPRIDT,VPRN)) Q:VPRN<1 D Q:VPRCNT'<MAX
  1. .. K VPRITM D EN1(VPRN,.VPRITM) Q:'$D(VPRITM)
  1. .. D XML(.VPRITM) S VPRCNT=VPRCNT+1
  1. K ^TMP("VPRPX",$J)
  1. Q
  1. ;
  1. SORT(DFN,START,STOP) ; -- build ^TMP("VPRPX",$J,9999999-DATE,DA)=ITM^DATE in range
  1. ; from ^PXRMINDX(9000010.13,"PI",DFN,ITM,DATE,DA)
  1. N ITM,DATE,DA,IDT K ^TMP("VPRPX",$J)
  1. S ITM=0 F S ITM=$O(^PXRMINDX(9000010.13,"PI",+$G(DFN),ITM)) Q:ITM<1 D
  1. . S DATE=0 F S DATE=$O(^PXRMINDX(9000010.13,"PI",+$G(DFN),ITM,DATE)) Q:DATE<1 D
  1. .. Q:DATE<START Q:DATE>STOP S IDT=9999999-DATE
  1. .. S DA=0 F S DA=$O(^PXRMINDX(9000010.13,"PI",+$G(DFN),ITM,DATE,DA)) Q:DA<1 S ^TMP("VPRPX",$J,IDT,DA)=ITM_U_DATE
  1. Q
  1. ;
  1. EN1(IEN,PCE) ; -- return an exam in PCE("attribute")=value
  1. ; from EN: expects ^TMP("VPRPX",$J,VPRIDT,IEN)=ITM^DATE
  1. N VPRF,TMP,VISIT,X0,FAC,LOC,X K PCE
  1. D VXAM^PXPXRM(IEN,.VPRF)
  1. S PCE("id")=IEN,X=$G(VPRF("VALUE"))
  1. S PCE("result")=$$EXTERNAL^DILFD(9000010.13,.04,,X)
  1. S TMP=$G(^TMP("VPRPX",$J,VPRIDT,IEN)),PCE("dateTime")=$P(TMP,U,2)
  1. S PCE("name")=$$EXTERNAL^DILFD(9000010.13,.01,,+TMP)
  1. S PCE("comment")=$G(VPRF("COMMENTS"))
  1. S VISIT=$G(VPRF("VISIT")),PCE("encounter")=VISIT
  1. S X0=$G(^AUPNVSIT(+VISIT,0))
  1. S FAC=+$P(X0,U,6),LOC=+$P(X0,U,22)
  1. S:FAC PCE("facility")=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
  1. S:'FAC PCE("facility")=$$FAC^VPRD(LOC)
  1. Q
  1. ;
  1. ; ------------ Return data to middle tier ------------
  1. ;
  1. XML(PCE) ; -- Return patient data as XML in @VPR@(n)
  1. ; as <element code='123' displayName='ABC' />
  1. N ATT,X,Y,I,ID
  1. D ADD("<exam>") S VPRTOTL=$G(VPRTOTL)+1
  1. S ATT="" F S ATT=$O(PCE(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
  1. . S X=$G(PCE(ATT)),Y="" Q:'$L(X)
  1. . I X'["^" S Y="<"_ATT_" value='"_$$ESC^VPRD(X)_"' />" Q
  1. . S Y="<"_ATT_" code='"_$P(X,U)_"' name='"_$$ESC^VPRD($P(X,U,2))_"' />"
  1. D ADD("</exam>")
  1. Q
  1. ;
  1. ADD(X) ; Add a line @VPR@(n)=X
  1. S VPRI=$G(VPRI)+1
  1. S @VPR@(VPRI)=X
  1. Q