BGP9DP1E.m

BGP9DP1E ; IHS/CMI/LAB - print ind 1 21 Mar 2008 12:55 PM 01 Jul 2008 11:40 AM ; 

 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 ;

SETDEV ;EP

 I $P($G(^BGPINDNC(BGPPC,22)),U),'$G(BGPNOSUM) D

 .S ^TMP($J,"SUMMARY DEVEL",$P(^BGPSCAT($P(^BGPINDNC(BGPPC,22),U,5),0),U,2),$P(^BGPINDNC(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(^BGPINDNC(BGPPC,22),U,5),0),U,2)

 ...S B=$P(^BGPINDNC(BGPPC,22),U,6)

 ...S ^TMP($J,"SUMMARY DETAIL PAGE DEVEL",$P(^BGPSCAT($P(^BGPINDNC(BGPPC,22),U,5),0),U,2),$P(^BGPINDNC(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(^BGPINDNC(BGPPC,22)),U),'$G(BGPNOSUM) D

 .S ^TMP($J,"SUMMARYDEL DEVEL",$P(^BGPSCAT($P(^BGPINDNC(BGPPC,22),U,5),0),U,2),$P(^BGPINDNC(BGPPC,22),U,6),BGPPC)=$$SB^BGP9DP1C($J(BGPCYP,5,1))_U_$$SB^BGP9DP1C($J(BGPPRP,5,1))_U_$$SB^BGP9DP1C($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(^BGPINDNC(BGPPC,22),U,5),0),U,2)

 ...S B=$P(^BGPINDNC(BGPPC,22),U,6)

 ...S ^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",A,B,BGPPC,X)=$$SB^BGP9DP1C($J($P($G(BGPSDPD(X,1)),U,3),5,1))_U_$$SB^BGP9DP1C($J($P($G(BGPSDPD(X,2)),U,3),5,1))_U_$$SB^BGP9DP1C($J($P($G(BGPSDPD(X,3)),U,3),5,1))_U_$$SB^BGP9DP1C($J(BGPCYP,5,1))

 Q

BGP9DP1E  ; IHS/CMI/LAB - print ind 1 21 Mar 2008 12:55 PM 01 Jul 2008 11:40 AM ; 

 +1       ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 +2       ;

SETDEV    ;EP

 +1        IF $PIECE($GET(^BGPINDNC(BGPPC,22)),U)

               IF '$GET(BGPNOSUM)

                   Begin DoDot:1

 +2                    SET ^TMP($JOB,"SUMMARY DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDNC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDNC(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(^BGPINDNC(BGPPC,22),U,5),0),U,2)

 +6                                    SET B=$PIECE(^BGPINDNC(BGPPC,22),U,6)

 +7                                   SET ^TMP($JOB,"SUMMARY DETAIL PAGE DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDNC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDNC(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(^BGPINDNC(BGPPC,22)),U)

               IF '$GET(BGPNOSUM)

                   Begin DoDot:1

 +9                    SET ^TMP($JOB,"SUMMARYDEL DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDNC(BGPPC,22),U,5),0),U,2),$PIECE(^BGPINDNC(BGPPC,22),U,6),BGPPC)=$$SB^BGP9DP1C($JUSTIFY(BGPCYP,5,1))_U_$$SB^BGP9DP1C($JUSTIFY(BGPPRP,5,1))_U_$$SB^BGP9DP1C($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(^BGPINDNC(BGPPC,22),U,5),0),U,2)

 +13                                   SET B=$PIECE(^BGPINDNC(BGPPC,22),U,6)

 +14                                  SET ^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",A,B,BGPPC,X)=$$SB^BGP9DP1C($JUSTIFY($PIECE($GET(BGPSDPD(X,1)),U,3),5,1))_U_$$SB^BGP9DP1C($JUSTIFY(...

                                       ... $PIECE($GET(BGPSDPD(X,2)),U,3),5,1))_U_$$SB^BGP9DP1C($JUSTIFY($PIECE($GET(BGPSDPD(X,3)),U,3),5,1))_U_$$SB^BGP9DP1C($JUSTIFY(BGPCYP,5,1))

                                   End DoDot:3

                           End DoDot:2

                   End DoDot:1

 +15       QUIT