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