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

BGP2DP1E.m

Go to the documentation of this file.
BGP2DP1E ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM 01 Jul 2010 11:40 AM ;
 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
 ;
SETDEV ;EP
 I $P($G(^BGPINDWC(BGPPC,22)),U),'$G(BGPNOSUM) D
 .S ^TMP($J,"SUMMARY DEVEL",$P(^BGPSCAT($P(^BGPINDWC(BGPPC,22),U,5),0),U,2),$P(^BGPINDWC(BGPPC,22),U,6),BGPPC)=BGPCYP_U_BGPPRP_U_BGPBLP
 .I $G(BGPAREAA) D  ;SDPX
 ..S X=0 F  S X=$O(BGPSDPD(X)) Q:X'=+X  D  ;SDPX
 ...S A=$P(^BGPSCAT($P(^BGPINDWC(BGPPC,22),U,5),0),U,2)
 ...S B=$P(^BGPINDWC(BGPPC,22),U,6)
 ...S ^TMP($J,"SUMMARY DETAIL PAGE DEVEL",$P(^BGPSCAT($P(^BGPINDWC(BGPPC,22),U,5),0),U,2),$P(^BGPINDWC(BGPPC,22),U,6),BGPPC,X)=$P($G(BGPSDPD(X,1)),U,3)_U_$P($G(BGPSDPD(X,2)),U,3)_U_$P($G(BGPSDPD(X,3)),U,3)_U_$J(BGPCYP,5,1)
 I $P($G(^BGPINDWC(BGPPC,22)),U),'$G(BGPNOSUM) D
 .S ^TMP($J,"SUMMARYDEL DEVEL",$P(^BGPSCAT($P(^BGPINDWC(BGPPC,22),U,5),0),U,2),$P(^BGPINDWC(BGPPC,22),U,6),BGPPC)=$$SB^BGP2DP1C($J(BGPCYP,5,1))_U_$$SB^BGP2DP1C($J(BGPPRP,5,1))_U_$$SB^BGP2DP1C($J(BGPBLP,5,1))
 .I $G(BGPAREAA) D  ;SDPX
 ..S X=0 F  S X=$O(BGPSDPD(X)) Q:X'=+X  D  ;SDPX
 ...S A=$P(^BGPSCAT($P(^BGPINDWC(BGPPC,22),U,5),0),U,2)
 ...S B=$P(^BGPINDWC(BGPPC,22),U,6)
 ...S ^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",A,B,BGPPC,X)=$$SB^BGP2DP1C($J($P($G(BGPSDPD(X,1)),U,3),5,1))_U_$$SB^BGP2DP1C($J($P($G(BGPSDPD(X,2)),U,3),5,1))_U_$$SB^BGP2DP1C($J($P($G(BGPSDPD(X,3)),U,3),5,1))_U_$$SB^BGP2DP1C($J(BGPCYP,5,1))
 Q
CHECK(I) ;EP
 I BGPRTYPE=1,$P(^BGPINDWC(I,0),U,5)'=1 Q ""
 I BGPRTYPE=1,$P($G(^BGPINDWC(I,21)),U,6) Q ""
 I BGPRTYPE=7,$P($G(^BGPINDWC(I,12)),U,12)'=1 Q ""
 I BGPRTYPE=4,$P($G(^BGPINDWC(I,21)),U,2)=1 Q ""
 I BGPRTYPE=9,$P($G(^BGPINDWC(I,21)),U,6)'=1 Q ""
 I BGPINDW="D",$P(^BGPINDWC(I,0),U,12)'=1 Q ""
 I BGPINDW="C",$P(^BGPINDWC(I,0),U,13)'=1 Q ""
 I BGPINDW="W",$P($G(^BGPINDWC(I,12)),U,2)'=1 Q ""
 I BGPINDW="E",$P($G(^BGPINDWC(I,12)),U,3)'=1 Q ""
 I BGPINDW="I",$P($G(^BGPINDWC(I,11)),U,1)'=1 Q ""
 I BGPINDW="P",$P($G(^BGPINDWC(I,11)),U,2)'=1 Q ""
 I BGPINDW="A",$P($G(^BGPINDWC(I,0)),U,23)'=1 Q ""
 Q 1