BGP1DP1E ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM 01 Jul 2010 11:40 AM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
SETDEV ;EP
I $P($G(^BGPINDBC(BGPPC,22)),U),'$G(BGPNOSUM) D
.S ^TMP($J,"SUMMARY DEVEL",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,22),U,5),0),U,2),$P(^BGPINDBC(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(^BGPINDBC(BGPPC,22),U,5),0),U,2)
...S B=$P(^BGPINDBC(BGPPC,22),U,6)
...S ^TMP($J,"SUMMARY DETAIL PAGE DEVEL",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,22),U,5),0),U,2),$P(^BGPINDBC(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(^BGPINDBC(BGPPC,22)),U),'$G(BGPNOSUM) D
.S ^TMP($J,"SUMMARYDEL DEVEL",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,22),U,5),0),U,2),$P(^BGPINDBC(BGPPC,22),U,6),BGPPC)=$$SB^BGP1DP1C($J(BGPCYP,5,1))_U_$$SB^BGP1DP1C($J(BGPPRP,5,1))_U_$$SB^BGP1DP1C($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(^BGPINDBC(BGPPC,22),U,5),0),U,2)
...S B=$P(^BGPINDBC(BGPPC,22),U,6)
...S ^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",A,B,BGPPC,X)=$$SB^BGP1DP1C($J($P($G(BGPSDPD(X,1)),U,3),5,1))_U_$$SB^BGP1DP1C($J($P($G(BGPSDPD(X,2)),U,3),5,1))_U_$$SB^BGP1DP1C($J($P($G(BGPSDPD(X,3)),U,3),5,1))_U_$$SB^BGP1DP1C($J(BGPCYP,5,1))
Q
CHECK(I) ;EP
I BGPRTYPE=1,$P(^BGPINDBC(I,0),U,5)'=1 Q ""
I BGPRTYPE=1,$P($G(^BGPINDBC(I,21)),U,6) Q ""
I BGPRTYPE=7,$P($G(^BGPINDBC(I,12)),U,12)'=1 Q ""
I BGPRTYPE=4,$P($G(^BGPINDBC(I,21)),U,2)=1 Q ""
I BGPRTYPE=9,$P($G(^BGPINDBC(I,21)),U,6)'=1 Q ""
I BGPINDB="D",$P(^BGPINDBC(I,0),U,12)'=1 Q ""
I BGPINDB="C",$P(^BGPINDBC(I,0),U,13)'=1 Q ""
I BGPINDB="W",$P($G(^BGPINDBC(I,12)),U,2)'=1 Q ""
I BGPINDB="E",$P($G(^BGPINDBC(I,12)),U,3)'=1 Q ""
I BGPINDB="I",$P($G(^BGPINDBC(I,11)),U,1)'=1 Q ""
I BGPINDB="P",$P($G(^BGPINDBC(I,11)),U,2)'=1 Q ""
Q 1
BGP1DP1E ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM 01 Jul 2010 11:40 AM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
SETDEV ;EP
+1 IF $PIECE($GET(^BGPINDBC(BGPPC,22)),U)
IF '$GET(BGPNOSUM)
Begin DoDot:1
+2 SET ^TMP($JOB,"SUMMARY DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDBC(BGPPC,22),U,6),BGPPC)=BGPCYP_U_BGPPRP_U_BGPBLP
+3 ;SDPX
IF $GET(BGPAREAA)
Begin DoDot:2
+4 ;SDPX
SET X=0
FOR
SET X=$ORDER(BGPSDPD(X))
IF X'=+X
QUIT
Begin DoDot:3
+5 SET A=$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,22),U,5),0),U,2)
+6 SET B=$PIECE(^BGPINDBC(BGPPC,22),U,6)
+7 SET ^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDBC(BGPPC,22),U,6),BGPPC,X)=$PIECE($GET(BGPSDPD(X,1)),U,3)_U_$PIECE($GET(BGPSDPD(X,2)),U,3)_U_$PIECE(...
... $GET(BGPSDPD(X,3)),U,3)_U_$JUSTIFY(BGPCYP,5,1)
End DoDot:3
End DoDot:2
End DoDot:1
+8 IF $PIECE($GET(^BGPINDBC(BGPPC,22)),U)
IF '$GET(BGPNOSUM)
Begin DoDot:1
+9 SET ^TMP($JOB,"SUMMARYDEL DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDBC(BGPPC,22),U,6),BGPPC)=$$SB^BGP1DP1C($JUSTIFY(BGPCYP,5,1))_U_$$SB^BGP1DP1C($JUSTIFY(BGPPRP,5,1))_U_$$SB^BGP1DP1C($JUSTIFY(BGPBL
P,5,1))
+10 ;SDPX
IF $GET(BGPAREAA)
Begin DoDot:2
+11 ;SDPX
SET X=0
FOR
SET X=$ORDER(BGPSDPD(X))
IF X'=+X
QUIT
Begin DoDot:3
+12 SET A=$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,22),U,5),0),U,2)
+13 SET B=$PIECE(^BGPINDBC(BGPPC,22),U,6)
+14 SET ^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",A,B,BGPPC,X)=$$SB^BGP1DP1C($JUSTIFY($PIECE($GET(BGPSDPD(X,1)),U,3),5,1))_U_$$SB^BGP1DP1C($JUSTIFY(...
... $PIECE($GET(BGPSDPD(X,2)),U,3),5,1))_U_$$SB^BGP1DP1C($JUSTIFY($PIECE($GET(BGPSDPD(X,3)),U,3),5,1))_U_$$SB^BGP1DP1C($JUSTIFY(BGPCYP,5,1))
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
CHECK(I) ;EP
+1 IF BGPRTYPE=1
IF $PIECE(^BGPINDBC(I,0),U,5)'=1
QUIT ""
+2 IF BGPRTYPE=1
IF $PIECE($GET(^BGPINDBC(I,21)),U,6)
QUIT ""
+3 IF BGPRTYPE=7
IF $PIECE($GET(^BGPINDBC(I,12)),U,12)'=1
QUIT ""
+4 IF BGPRTYPE=4
IF $PIECE($GET(^BGPINDBC(I,21)),U,2)=1
QUIT ""
+5 IF BGPRTYPE=9
IF $PIECE($GET(^BGPINDBC(I,21)),U,6)'=1
QUIT ""
+6 IF BGPINDB="D"
IF $PIECE(^BGPINDBC(I,0),U,12)'=1
QUIT ""
+7 IF BGPINDB="C"
IF $PIECE(^BGPINDBC(I,0),U,13)'=1
QUIT ""
+8 IF BGPINDB="W"
IF $PIECE($GET(^BGPINDBC(I,12)),U,2)'=1
QUIT ""
+9 IF BGPINDB="E"
IF $PIECE($GET(^BGPINDBC(I,12)),U,3)'=1
QUIT ""
+10 IF BGPINDB="I"
IF $PIECE($GET(^BGPINDBC(I,11)),U,1)'=1
QUIT ""
+11 IF BGPINDB="P"
IF $PIECE($GET(^BGPINDBC(I,11)),U,2)'=1
QUIT ""
+12 QUIT 1
