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