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

BGP4DP1E.m

Go to the documentation of this file.
BGP4DP1E ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM 01 Jul 2010 11:40 AM ;
 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
 ;
SETDEV ;EP
 I $P($G(^BGPINDJC(BGPPC,22)),U),'$G(BGPNOSUM) D
 .S ^TMP($J,"SUMMARY DEVEL",$P(^BGPSCAT($P(^BGPINDJC(BGPPC,22),U,5),0),U,2),$P(^BGPINDJC(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(^BGPINDJC(BGPPC,22),U,5),0),U,2)
 ...S B=$P(^BGPINDJC(BGPPC,22),U,6)
 ...S ^TMP($J,"SUMMARY DETAIL PAGE DEVEL",$P(^BGPSCAT($P(^BGPINDJC(BGPPC,22),U,5),0),U,2),$P(^BGPINDJC(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(^BGPINDJC(BGPPC,22)),U),'$G(BGPNOSUM) D
 .S ^TMP($J,"SUMMARYDEL DEVEL",$P(^BGPSCAT($P(^BGPINDJC(BGPPC,22),U,5),0),U,2),$P(^BGPINDJC(BGPPC,22),U,6),BGPPC)=$$SB^BGP4DP1C($J(BGPCYP,5,1))_U_$$SB^BGP4DP1C($J(BGPPRP,5,1))_U_$$SB^BGP4DP1C($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(^BGPINDJC(BGPPC,22),U,5),0),U,2)
 ...S B=$P(^BGPINDJC(BGPPC,22),U,6)
 ...S ^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",A,B,BGPPC,X)=$$SB^BGP4DP1C($J($P($G(BGPSDPD(X,1)),U,3),5,1))_U_$$SB^BGP4DP1C($J($P($G(BGPSDPD(X,2)),U,3),5,1))_U_$$SB^BGP4DP1C($J($P($G(BGPSDPD(X,3)),U,3),5,1))_U_$$SB^BGP4DP1C($J(BGPCYP,5,1))
 Q
CHECK(I) ;EP
 I BGPRTYPE=1,$P(^BGPINDJC(I,0),U,5)'=1 Q ""
 I BGPRTYPE=1,$P(^BGPINDJC(I,0),U,4)="026.C.5" Q 1
 I BGPRTYPE=1,$P($G(^BGPINDJC(I,21)),U,6) Q ""
 I BGPRTYPE=7,$P($G(^BGPINDJC(I,12)),U,12)'=1 Q ""
 I BGPRTYPE=4,$P($G(^BGPINDJC(I,21)),U,2)=1 Q ""
 I BGPRTYPE=9,$P($G(^BGPINDJC(I,21)),U,6)'=1 Q ""
 I BGPINDJ="D",$P(^BGPINDJC(I,0),U,12)'=1 Q ""
 I BGPINDJ="C",$P(^BGPINDJC(I,0),U,13)'=1 Q ""
 I BGPINDJ="W",$P($G(^BGPINDJC(I,12)),U,2)'=1 Q ""
 I BGPINDJ="E",$P($G(^BGPINDJC(I,12)),U,3)'=1 Q ""
 I BGPINDJ="I",$P($G(^BGPINDJC(I,11)),U,1)'=1 Q ""
 I BGPINDJ="P",$P($G(^BGPINDJC(I,11)),U,2)'=1 Q ""
 I BGPINDJ="A",$P($G(^BGPINDJC(I,0)),U,23)'=1 Q ""
 Q 1