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

BGP8DP1E.m

Go to the documentation of this file.
BGP8DP1E ;IHS/CMI/LAB - PRINT IND;
 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
 ;
SETDEV ;EP
 I $P($G(^BGPINDRC(BGPPC,22)),U),'$G(BGPNOSUM) D
 .S ^TMP($J,"SUMMARY DEVEL",$P(^BGPSCAT($P(^BGPINDRC(BGPPC,22),U,5),0),U,2),$P(^BGPINDRC(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(^BGPINDRC(BGPPC,22),U,5),0),U,2)
 ...S B=$P(^BGPINDRC(BGPPC,22),U,6)
 ...S ^TMP($J,"SUMMARY DETAIL PAGE DEVEL",$P(^BGPSCAT($P(^BGPINDRC(BGPPC,22),U,5),0),U,2),$P(^BGPINDRC(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(^BGPINDRC(BGPPC,22)),U),'$G(BGPNOSUM) D
 .S ^TMP($J,"SUMMARYDEL DEVEL",$P(^BGPSCAT($P(^BGPINDRC(BGPPC,22),U,5),0),U,2),$P(^BGPINDRC(BGPPC,22),U,6),BGPPC)=$$SB^BGP8DP1C($J(BGPCYP,5,1))_U_$$SB^BGP8DP1C($J(BGPPRP,5,1))_U_$$SB^BGP8DP1C($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(^BGPINDRC(BGPPC,22),U,5),0),U,2)
 ...S B=$P(^BGPINDRC(BGPPC,22),U,6)
 ...S ^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",A,B,BGPPC,X)=$$SB^BGP8DP1C($J($P($G(BGPSDPD(X,1)),U,3),5,1))_U_$$SB^BGP8DP1C($J($P($G(BGPSDPD(X,2)),U,3),5,1))_U_$$SB^BGP8DP1C($J($P($G(BGPSDPD(X,3)),U,3),5,1))_U_$$SB^BGP8DP1C($J(BGPCYP,5,1))
 Q
CHECK(I) ;EP
 I BGPRTYPE=1,$P(^BGPINDRC(I,0),U,5)'=1 Q ""
 I BGPRTYPE=1,$P(^BGPINDRC(I,0),U,4)="026.C.5" Q 1
 I BGPRTYPE=1,$P($G(^BGPINDRC(I,21)),U,6) Q ""
 I BGPRTYPE=7,$P($G(^BGPINDRC(I,12)),U,12)'=1 Q ""
 I BGPRTYPE=4,$P($G(^BGPINDRC(I,21)),U,2)=1 Q ""
 I BGPRTYPE=9,$P($G(^BGPINDRC(I,21)),U,6)'=1 Q ""
 I BGPRTYPE=2,$P($G(^BGPINDRC(I,11)),U,1)'=1 Q ""
 I BGPINDG="D",$P(^BGPINDRC(I,0),U,12)'=1 Q ""
 I BGPINDG="C",$P(^BGPINDRC(I,0),U,13)'=1 Q ""
 I BGPINDG="W",$P($G(^BGPINDRC(I,12)),U,2)'=1 Q ""
 I BGPINDG="E",$P($G(^BGPINDRC(I,12)),U,3)'=1 Q ""
 I BGPINDG="I",$P($G(^BGPINDRC(I,11)),U,1)'=1 Q ""
 I BGPINDG="P",$P($G(^BGPINDRC(I,11)),U,2)'=1 Q ""
 I BGPINDG="A",$P($G(^BGPINDRC(I,0)),U,23)'=1 Q ""
 Q 1