VPRDPXHF ;SLC/MKB -- PCE Health Factors ;8/2/11 15:29
;;1.0;VIRTUAL PATIENT RECORD;**1**;Sep 01, 2011;Build 38
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^AUPNVSIT 2028
; ^AUTTHF 4295
; ^PXRMINDX 4290
; DILFD 2055
; DIQ 2056
; PXPXRM 4250
; XUAF4 2171
;
; ------------ Get data from VistA ------------
;
EN(DFN,BEG,END,MAX,IFN) ; -- find a patient's health factors
S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
N VPRIDT,VPRN,VPRITM,VPRCNT
;
; get one health factor
I $G(IFN) D Q
. N HF,DATE K ^TMP("VPRHF",$J)
. S HF=0 F S HF=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),HF)) Q:HF<1 D Q:$D(VPRITM)
.. S DATE=0 F S DATE=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),HF,DATE)) Q:DATE<1 I $D(^(DATE,IFN)) D Q
... S VPRIDT=9999999-DATE,^TMP("VPRHF",$J,VPRIDT,IFN)=HF_U_DATE
... D EN1(IFN,.VPRITM),XML(.VPRITM)
;
; get all health factors
D SORT(DFN,BEG,END) S VPRCNT=0
S VPRIDT=0 F S VPRIDT=$O(^TMP("VPRHF",$J,VPRIDT)) Q:VPRIDT<1 D Q:VPRCNT'<MAX
. S VPRN=0 F S VPRN=$O(^TMP("VPRHF",$J,VPRIDT,VPRN)) Q:VPRN<1 D Q:VPRCNT'<MAX
.. K VPRITM D EN1(VPRN,.VPRITM) Q:'$D(VPRITM)
.. D XML(.VPRITM) S VPRCNT=VPRCNT+1
K ^TMP("VPRHF",$J)
Q
;
SORT(DFN,START,STOP) ; -- build ^TMP("VPRHF",$J,9999999-DATE,DA)=HF^DATE in range
; from ^PXRMINDX(9000010.23,"PI",DFN,HF,DATE,DA)
N HF,DATE,DA,IDT K ^TMP("VPRHF",$J)
S HF=0 F S HF=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),HF)) Q:HF<1 D
. S DATE=0 F S DATE=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),HF,DATE)) Q:DATE<1 D
.. Q:DATE<START Q:DATE>STOP S IDT=9999999-DATE
.. S DA=0 F S DA=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),HF,DATE,DA)) Q:DA<1 S ^TMP("VPRHF",$J,IDT,DA)=HF_U_DATE
Q
;
EN1(IEN,HF) ; -- return a health factor in HF("attribute")=value
; from EN: expects ^TMP("VPRHF",$J,VPRIDT,IEN)=HF^DATE
N VPRF,TMP,VISIT,X0,FAC,LOC,X K HF
D VHF^PXPXRM(IEN,.VPRF)
S HF("id")=IEN,HF("severity")=$G(VPRF("VALUE"))
S TMP=$G(^TMP("VPRHF",$J,VPRIDT,IEN)),HF("recorded")=$P(TMP,U,2)
S HF("name")=$$EXTERNAL^DILFD(9000010.23,.01,,+TMP)
S HF("comment")=$G(VPRF("COMMENTS"))
S VISIT=$G(VPRF("VISIT")),HF("encounter")=VISIT
S X0=$G(^AUPNVSIT(+VISIT,0))
S FAC=+$P(X0,U,6),LOC=+$P(X0,U,22)
S:FAC HF("facility")=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
S:'FAC HF("facility")=$$FAC^VPRD(LOC)
S X=$$GET1^DIQ(9999999.64,+TMP_",",.03,"I")
S:X HF("category")=X_U_$$GET1^DIQ(9999999.64,+TMP_",",.03)
Q
;
; ------------ Return data to middle tier ------------
;
XML(HF) ; -- Return patient data as XML in @VPR@(n)
; as <element code='123' displayName='ABC' />
N ATT,X,Y,I,ID
D ADD("<factor>") S VPRTOTL=$G(VPRTOTL)+1
S ATT="" F S ATT=$O(HF(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
. S X=$G(HF(ATT)),Y="" Q:'$L(X)
. I X'["^" S Y="<"_ATT_" value='"_$$ESC^VPRD(X)_"' />" Q
. S Y="<"_ATT_" code='"_$P(X,U)_"' name='"_$$ESC^VPRD($P(X,U,2))_"' />"
D ADD("</factor>")
Q
;
ADD(X) ; Add a line @VPR@(n)=X
S VPRI=$G(VPRI)+1
S @VPR@(VPRI)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDPXHF 3299 printed Dec 13, 2024@02:45 Page 2
VPRDPXHF ;SLC/MKB -- PCE Health Factors ;8/2/11 15:29
+1 ;;1.0;VIRTUAL PATIENT RECORD;**1**;Sep 01, 2011;Build 38
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^AUPNVSIT 2028
+7 ; ^AUTTHF 4295
+8 ; ^PXRMINDX 4290
+9 ; DILFD 2055
+10 ; DIQ 2056
+11 ; PXPXRM 4250
+12 ; XUAF4 2171
+13 ;
+14 ; ------------ Get data from VistA ------------
+15 ;
EN(DFN,BEG,END,MAX,IFN) ; -- find a patient's health factors
+1 ;invalid patient
SET DFN=+$GET(DFN)
if DFN<1
QUIT
+2 SET BEG=$GET(BEG,1410101)
SET END=$GET(END,4141015)
SET MAX=$GET(MAX,9999)
+3 NEW VPRIDT,VPRN,VPRITM,VPRCNT
+4 ;
+5 ; get one health factor
+6 IF $GET(IFN)
Begin DoDot:1
+7 NEW HF,DATE
KILL ^TMP("VPRHF",$JOB)
+8 SET HF=0
FOR
SET HF=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),HF))
if HF<1
QUIT
Begin DoDot:2
+9 SET DATE=0
FOR
SET DATE=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),HF,DATE))
if DATE<1
QUIT
IF $DATA(^(DATE,IFN))
Begin DoDot:3
+10 SET VPRIDT=9999999-DATE
SET ^TMP("VPRHF",$JOB,VPRIDT,IFN)=HF_U_DATE
+11 DO EN1(IFN,.VPRITM)
DO XML(.VPRITM)
End DoDot:3
QUIT
End DoDot:2
if $DATA(VPRITM)
QUIT
End DoDot:1
QUIT
+12 ;
+13 ; get all health factors
+14 DO SORT(DFN,BEG,END)
SET VPRCNT=0
+15 SET VPRIDT=0
FOR
SET VPRIDT=$ORDER(^TMP("VPRHF",$JOB,VPRIDT))
if VPRIDT<1
QUIT
Begin DoDot:1
+16 SET VPRN=0
FOR
SET VPRN=$ORDER(^TMP("VPRHF",$JOB,VPRIDT,VPRN))
if VPRN<1
QUIT
Begin DoDot:2
+17 KILL VPRITM
DO EN1(VPRN,.VPRITM)
if '$DATA(VPRITM)
QUIT
+18 DO XML(.VPRITM)
SET VPRCNT=VPRCNT+1
End DoDot:2
if VPRCNT'<MAX
QUIT
End DoDot:1
if VPRCNT'<MAX
QUIT
+19 KILL ^TMP("VPRHF",$JOB)
+20 QUIT
+21 ;
SORT(DFN,START,STOP) ; -- build ^TMP("VPRHF",$J,9999999-DATE,DA)=HF^DATE in range
+1 ; from ^PXRMINDX(9000010.23,"PI",DFN,HF,DATE,DA)
+2 NEW HF,DATE,DA,IDT
KILL ^TMP("VPRHF",$JOB)
+3 SET HF=0
FOR
SET HF=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),HF))
if HF<1
QUIT
Begin DoDot:1
+4 SET DATE=0
FOR
SET DATE=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),HF,DATE))
if DATE<1
QUIT
Begin DoDot:2
+5 if DATE<START
QUIT
if DATE>STOP
QUIT
SET IDT=9999999-DATE
+6 SET DA=0
FOR
SET DA=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),HF,DATE,DA))
if DA<1
QUIT
SET ^TMP("VPRHF",$JOB,IDT,DA)=HF_U_DATE
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
EN1(IEN,HF) ; -- return a health factor in HF("attribute")=value
+1 ; from EN: expects ^TMP("VPRHF",$J,VPRIDT,IEN)=HF^DATE
+2 NEW VPRF,TMP,VISIT,X0,FAC,LOC,X
KILL HF
+3 DO VHF^PXPXRM(IEN,.VPRF)
+4 SET HF("id")=IEN
SET HF("severity")=$GET(VPRF("VALUE"))
+5 SET TMP=$GET(^TMP("VPRHF",$JOB,VPRIDT,IEN))
SET HF("recorded")=$PIECE(TMP,U,2)
+6 SET HF("name")=$$EXTERNAL^DILFD(9000010.23,.01,,+TMP)
+7 SET HF("comment")=$GET(VPRF("COMMENTS"))
+8 SET VISIT=$GET(VPRF("VISIT"))
SET HF("encounter")=VISIT
+9 SET X0=$GET(^AUPNVSIT(+VISIT,0))
+10 SET FAC=+$PIECE(X0,U,6)
SET LOC=+$PIECE(X0,U,22)
+11 if FAC
SET HF("facility")=$$STA^XUAF4(FAC)_U_$PIECE($$NS^XUAF4(FAC),U)
+12 if 'FAC
SET HF("facility")=$$FAC^VPRD(LOC)
+13 SET X=$$GET1^DIQ(9999999.64,+TMP_",",.03,"I")
+14 if X
SET HF("category")=X_U_$$GET1^DIQ(9999999.64,+TMP_",",.03)
+15 QUIT
+16 ;
+17 ; ------------ Return data to middle tier ------------
+18 ;
XML(HF) ; -- Return patient data as XML in @VPR@(n)
+1 ; as <element code='123' displayName='ABC' />
+2 NEW ATT,X,Y,I,ID
+3 DO ADD("<factor>")
SET VPRTOTL=$GET(VPRTOTL)+1
+4 SET ATT=""
FOR
SET ATT=$ORDER(HF(ATT))
if ATT=""
QUIT
Begin DoDot:1
+5 SET X=$GET(HF(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+6 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^VPRD(X)_"' />"
QUIT
+7 SET Y="<"_ATT_" code='"_$PIECE(X,U)_"' name='"_$$ESC^VPRD($PIECE(X,U,2))_"' />"
End DoDot:1
if $LENGTH(Y)
DO ADD(Y)
+8 DO ADD("</factor>")
+9 QUIT
+10 ;
ADD(X) ; Add a line @VPR@(n)=X
+1 SET VPRI=$GET(VPRI)+1
+2 SET @VPR@(VPRI)=X
+3 QUIT
