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

BGP7D3C.m

Go to the documentation of this file.
  1. BGP7D3C ; IHS/CMI/LAB - VARIOUS UTILS
  1. ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
  1. ;
  1. FIRSTPDX(P,BDATE,EDATE) ;EP
  1. NEW BGPG,G,Y,X,T,E,BGPR
  1. K BGPG
  1. S Y="BGPG("
  1. S BDATE=$G(BDATE)
  1. I BDATE="" S BDATE=$P(^DPT(P,0),U,3)
  1. S BGPR=""
  1. S X=P_"^FIRST DX [BGP PREGNANCY DIAGNOSES 2;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,Y)
  1. I $D(BGPG(1)) S BGPR=$P(BGPG(1),U)
  1. K BGPG
  1. S BGPG=$$FIRSTPRC^BGP7UTL1(P,"BGP PREGNANCY ICD PROCEDURES",BDATE,EDATE)
  1. I BGPG]"",$P(BGPG,U,3)<BGPR S BGPR=$P(BGPG,U,3)
  1. S X=$$FIRSTCPT^BGP7UTL1(P,"BGP PREGNANCY CPT CODES",BDATE,EDATE)
  1. I X,$P(X,U,1)<BGPR S BGPR=$P(X,U,1)
  1. Q BGPR
  1. LASTVD(P,BDATE,EDATE) ;EP
  1. I '$D(^AUPNVSIT("AC",P)) Q ""
  1. NEW VISIT
  1. S A="VISIT(",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(VISIT(1)) Q ""
  1. S (X,G)=0 F S X=$O(VISIT(X)) Q:X'=+X!(G) S V=$P(VISIT(X),U,5) D
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:'$D(^AUPNVPRV("AD",V))
  1. .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1. .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1. .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1. .S G=1
  1. .Q
  1. Q G