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
BGP4DP1E ; IHS/CMI/LAB - print ind 1 21 Mar 2010 12:55 PM 01 Jul 2010 11:40 AM ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
SETDEV ;EP
+1 IF $PIECE($GET(^BGPINDJC(BGPPC,22)),U)
IF '$GET(BGPNOSUM)
Begin DoDot:1
+2 SET ^TMP($JOB,"SUMMARY DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDJC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDJC(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(^BGPINDJC(BGPPC,22),U,5),0),U,2)
+6 SET B=$PIECE(^BGPINDJC(BGPPC,22),U,6)
+7 SET ^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDJC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDJC(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(^BGPINDJC(BGPPC,22)),U)
IF '$GET(BGPNOSUM)
Begin DoDot:1
+9 SET ^TMP($JOB,"SUMMARYDEL DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDJC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDJC(BGPPC,22),U,6),BGPPC)=$$SB^BGP4DP1C($JUSTIFY(BGPCYP,5,1))_U_$$SB^BGP4DP1C($JUSTIFY(BGPPRP,5,1))_U_$$SB^BGP4DP1C($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(^BGPINDJC(BGPPC,22),U,5),0),U,2)
+13 SET B=$PIECE(^BGPINDJC(BGPPC,22),U,6)
+14 SET ^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",A,B,BGPPC,X)=$$SB^BGP4DP1C($JUSTIFY($PIECE($GET(BGPSDPD(X,1)),U,3),5,1))_U_$$SB^BGP4DP1C($JUSTIFY(...
... $PIECE($GET(BGPSDPD(X,2)),U,3),5,1))_U_$$SB^BGP4DP1C($JUSTIFY($PIECE($GET(BGPSDPD(X,3)),U,3),5,1))_U_$$SB^BGP4DP1C($JUSTIFY(BGPCYP,5,1))
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
CHECK(I) ;EP
+1 IF BGPRTYPE=1
IF $PIECE(^BGPINDJC(I,0),U,5)'=1
QUIT ""
+2 IF BGPRTYPE=1
IF $PIECE(^BGPINDJC(I,0),U,4)="026.C.5"
QUIT 1
+3 IF BGPRTYPE=1
IF $PIECE($GET(^BGPINDJC(I,21)),U,6)
QUIT ""
+4 IF BGPRTYPE=7
IF $PIECE($GET(^BGPINDJC(I,12)),U,12)'=1
QUIT ""
+5 IF BGPRTYPE=4
IF $PIECE($GET(^BGPINDJC(I,21)),U,2)=1
QUIT ""
+6 IF BGPRTYPE=9
IF $PIECE($GET(^BGPINDJC(I,21)),U,6)'=1
QUIT ""
+7 IF BGPINDJ="D"
IF $PIECE(^BGPINDJC(I,0),U,12)'=1
QUIT ""
+8 IF BGPINDJ="C"
IF $PIECE(^BGPINDJC(I,0),U,13)'=1
QUIT ""
+9 IF BGPINDJ="W"
IF $PIECE($GET(^BGPINDJC(I,12)),U,2)'=1
QUIT ""
+10 IF BGPINDJ="E"
IF $PIECE($GET(^BGPINDJC(I,12)),U,3)'=1
QUIT ""
+11 IF BGPINDJ="I"
IF $PIECE($GET(^BGPINDJC(I,11)),U,1)'=1
QUIT ""
+12 IF BGPINDJ="P"
IF $PIECE($GET(^BGPINDJC(I,11)),U,2)'=1
QUIT ""
+13 IF BGPINDJ="A"
IF $PIECE($GET(^BGPINDJC(I,0)),U,23)'=1
QUIT ""
+14 QUIT 1
