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