VPRSDAHX ;SLC/MKB -- SDA Hx utilities ;7/29/22 14:11
;;1.0;VIRTUAL PATIENT RECORD;**30**;Sep 01, 2011;Build 9
;;Per VHA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^AUPNVSIT 2028
; ^AUTTHF 4295
; ^PXRMINDX 4290
; PXPXRM 4250
; WVRPCVPR, ^TMP("WVPREGST" 7199
;
;
; Queries called from GET^DDE, returns DLIST(#)=ien
; Expects context variables DFN, DSTRT, DSTOP, DMAX
;
HFM ; -- get V Health Factors, for Family History
N ITEM,DATE,DA,X,VPRN S VPRN=0
S ITEM=0 F S ITEM=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),ITEM)) Q:ITEM<1 D Q:VPRN'<DMAX
. S X=$P($G(^AUTTHF(+ITEM,0)),U) I X'["FAMILY HISTORY",X'["FAMILY HX" Q
. S DATE=DSTRT F S DATE=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),ITEM,DATE)) Q:DATE<1!(DATE>DSTOP) D Q:VPRN'<DMAX
.. S DA=0 F S DA=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),ITEM,DATE,DA)) Q:DA<1 S VPRN=VPRN+1,DLIST(VPRN)=DA_U_ITEM Q:VPRN'<DMAX
Q
;
HFS ; -- get V Health Factors, for Social History
N ITEM,DATE,DA,VPRN S VPRN=0
S ITEM=0 F S ITEM=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),ITEM)) Q:ITEM<1 I $$SOCHIST(ITEM) D Q:VPRN'<DMAX
. S DATE=DSTRT F S DATE=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),ITEM,DATE)) Q:DATE<1!(DATE>DSTOP) D Q:VPRN'<DMAX
.. S DA=0 F S DA=$O(^PXRMINDX(9000010.23,"PI",+$G(DFN),ITEM,DATE,DA)) Q:DA<1 S VPRN=VPRN+1,DLIST(VPRN)=DA_U_ITEM Q:VPRN'<DMAX
Q
SOCHIST(IEN) ; -- find social history factors
N X S X=$P($G(^AUTTHF(+IEN,0)),U)
I (X["TOBACCO")!(X["SMOK") Q 1
;I (X["LIVES")!(X["LIVING") Q 1
;I (X["RELIGIO")!(X["SPIRIT") Q 1
Q 0
;
;
HF1 ; -- get info for single HF record [ID Action]
; Expects/updates DIEN = #9000010.23 ien
; Returns VPRVST = #9000010 ien
; VPRVST0 = Visit zero node
; VPRHF array
K VPRHF D:$$ZERO^VPRENC("HF",+DIEN) VHF^PXPXRM(+DIEN,.VPRHF)
S VPRVST=+$G(VPRHF("VISIT")),VPRVST0=$G(^AUPNVSIT(+VPRVST,0))
S VPRHF=DIEN,DIEN=+DIEN
Q
;
WVPLQ ; -- Women's Health Pregnancy Log [Query]
; Query called from GET^DDE, returns DLIST(1)=DFN if data
; Expects context variables DFN, DSTRT, DSTOP, DMAX
;
K ^TMP("WVPREGST",$J)
D BASELINE^WVRPCVPR(DFN)
S:$D(^TMP("WVPREGST",$J,"BASELINE")) DLIST(1)=DFN
;S:$G(^TMP("WVPREGST",$J,"BASELINE","TO TIME"))'<$$FMADD^XLFDT(DT,-14) DLIST(1)=DFN
Q
;
WVPL1(IEN) ; -- set up pregnancy API array (IEN will be DFN)
; Returns VPRPREG array to entity
I $G(IEN)<1 S DDEOUT=1 Q
D:'$D(^TMP("WVPREGST",$J,"BASELINE")) BASELINE^WVRPCVPR(IEN)
I '$D(^TMP("WVPREGST",$J,"BASELINE")) S DDEOUT=1 Q
M VPRPREG=^TMP("WVPREGST",$J,"BASELINE")
S DFN=IEN,IEN=$G(^TMP("WVPREGST",$J,"BASELINE","EXTERNAL ID"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRSDAHX 2809 printed Sep 23, 2025@20:22:14 Page 2
VPRSDAHX ;SLC/MKB -- SDA Hx utilities ;7/29/22 14:11
+1 ;;1.0;VIRTUAL PATIENT RECORD;**30**;Sep 01, 2011;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^AUPNVSIT 2028
+7 ; ^AUTTHF 4295
+8 ; ^PXRMINDX 4290
+9 ; PXPXRM 4250
+10 ; WVRPCVPR, ^TMP("WVPREGST" 7199
+11 ;
+12 ;
+13 ; Queries called from GET^DDE, returns DLIST(#)=ien
+14 ; Expects context variables DFN, DSTRT, DSTOP, DMAX
+15 ;
HFM ; -- get V Health Factors, for Family History
+1 NEW ITEM,DATE,DA,X,VPRN
SET VPRN=0
+2 SET ITEM=0
FOR
SET ITEM=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),ITEM))
if ITEM<1
QUIT
Begin DoDot:1
+3 SET X=$PIECE($GET(^AUTTHF(+ITEM,0)),U)
IF X'["FAMILY HISTORY"
IF X'["FAMILY HX"
QUIT
+4 SET DATE=DSTRT
FOR
SET DATE=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),ITEM,DATE))
if DATE<1!(DATE>DSTOP)
QUIT
Begin DoDot:2
+5 SET DA=0
FOR
SET DA=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),ITEM,DATE,DA))
if DA<1
QUIT
SET VPRN=VPRN+1
SET DLIST(VPRN)=DA_U_ITEM
if VPRN'<DMAX
QUIT
End DoDot:2
if VPRN'<DMAX
QUIT
End DoDot:1
if VPRN'<DMAX
QUIT
+6 QUIT
+7 ;
HFS ; -- get V Health Factors, for Social History
+1 NEW ITEM,DATE,DA,VPRN
SET VPRN=0
+2 SET ITEM=0
FOR
SET ITEM=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),ITEM))
if ITEM<1
QUIT
IF $$SOCHIST(ITEM)
Begin DoDot:1
+3 SET DATE=DSTRT
FOR
SET DATE=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),ITEM,DATE))
if DATE<1!(DATE>DSTOP)
QUIT
Begin DoDot:2
+4 SET DA=0
FOR
SET DA=$ORDER(^PXRMINDX(9000010.23,"PI",+$GET(DFN),ITEM,DATE,DA))
if DA<1
QUIT
SET VPRN=VPRN+1
SET DLIST(VPRN)=DA_U_ITEM
if VPRN'<DMAX
QUIT
End DoDot:2
if VPRN'<DMAX
QUIT
End DoDot:1
if VPRN'<DMAX
QUIT
+5 QUIT
SOCHIST(IEN) ; -- find social history factors
+1 NEW X
SET X=$PIECE($GET(^AUTTHF(+IEN,0)),U)
+2 IF (X["TOBACCO")!(X["SMOK")
QUIT 1
+3 ;I (X["LIVES")!(X["LIVING") Q 1
+4 ;I (X["RELIGIO")!(X["SPIRIT") Q 1
+5 QUIT 0
+6 ;
+7 ;
HF1 ; -- get info for single HF record [ID Action]
+1 ; Expects/updates DIEN = #9000010.23 ien
+2 ; Returns VPRVST = #9000010 ien
+3 ; VPRVST0 = Visit zero node
+4 ; VPRHF array
+5 KILL VPRHF
if $$ZERO^VPRENC("HF",+DIEN)
DO VHF^PXPXRM(+DIEN,.VPRHF)
+6 SET VPRVST=+$GET(VPRHF("VISIT"))
SET VPRVST0=$GET(^AUPNVSIT(+VPRVST,0))
+7 SET VPRHF=DIEN
SET DIEN=+DIEN
+8 QUIT
+9 ;
WVPLQ ; -- Women's Health Pregnancy Log [Query]
+1 ; Query called from GET^DDE, returns DLIST(1)=DFN if data
+2 ; Expects context variables DFN, DSTRT, DSTOP, DMAX
+3 ;
+4 KILL ^TMP("WVPREGST",$JOB)
+5 DO BASELINE^WVRPCVPR(DFN)
+6 if $DATA(^TMP("WVPREGST",$JOB,"BASELINE"))
SET DLIST(1)=DFN
+7 ;S:$G(^TMP("WVPREGST",$J,"BASELINE","TO TIME"))'<$$FMADD^XLFDT(DT,-14) DLIST(1)=DFN
+8 QUIT
+9 ;
WVPL1(IEN) ; -- set up pregnancy API array (IEN will be DFN)
+1 ; Returns VPRPREG array to entity
+2 IF $GET(IEN)<1
SET DDEOUT=1
QUIT
+3 if '$DATA(^TMP("WVPREGST",$JOB,"BASELINE"))
DO BASELINE^WVRPCVPR(IEN)
+4 IF '$DATA(^TMP("WVPREGST",$JOB,"BASELINE"))
SET DDEOUT=1
QUIT
+5 MERGE VPRPREG=^TMP("WVPREGST",$JOB,"BASELINE")
+6 SET DFN=IEN
SET IEN=$GET(^TMP("WVPREGST",$JOB,"BASELINE","EXTERNAL ID"))
+7 QUIT
