- BGP1PDL2 ; IHS/CMI/LAB - print ind 1 ;
- ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- ;
- ;this routine for Measure I14 ONLY
- I10 ;EP
- S BGPORXX=$P(^BGPINDB(BGPIC,12),U,6)
- D:'$G(BGPSUMON) H1 S BGPNODEN=1
- F BGPPC1=$P(^BGPINDB(BGPIC,12),U,6)_".1" D PI
- K BGPNODEN
- F BGPPC1=$P(^BGPINDB(BGPIC,12),U,6)_".2" D PI^BGP1PDL1
- Q
- I11 ;EP
- S BGPORXX=$P(^BGPINDB(BGPIC,12),U,6)
- D:'$G(BGPSUMON) H1 S BGPNODEN=1
- F BGPPC1=BGPORXX_".1" D PI
- S BGPNODEN=1
- F BGPPC1=BGPORXX_".2" D PI
- K BGPNODEN
- F BGPPC1=BGPORXX_".4" D PI^BGP1PDL1
- Q
- ISTI ;EP
- S BGPORXX=$P(^BGPINDB(BGPIC,12),U,6)
- D:'$G(BGPSUMON) H1 S BGPNODEN=1
- F BGPPC1=BGPORXX_".1",BGPORXX_".2",BGPORXX_".3" D PI
- S BGPNODEN=1
- F BGPPC1=BGPORXX_".4",BGPORXX_".5",BGPORXX_".6" D PI ;
- ;
- K BGPNODEN
- F BGPPC1=BGPORXX_".7",BGPORXX_".8",BGPORXX_".9" D PI^BGP1PDL1 ;
- ;
- F BGPPC1=BGPORXX_".10",BGPORXX_".11",BGPORXX_".12" D PI^BGP1PDL1 ;
- ;
- F BGPPC1=BGPORXX_".13",BGPORXX_".14",BGPORXX_".15" D PI^BGP1PDL1 ;
- ;
- F BGPPC1=BGPORXX_".16",BGPORXX_".17",BGPORXX_".18" D PI^BGP1PDL1 ;
- ;
- F BGPPC1=BGPORXX_".19",BGPORXX_".20",BGPORXX_".21" D PI^BGP1PDL1 ;
- ;
- ;USER POP
- D S(" ",1,1)
- S BGPNODEN=1
- F BGPPC1=BGPORXX_".22",BGPORXX_".23",BGPORXX_".24" D PI ;
- ;
- S BGPNODEN=1
- F BGPPC1=BGPORXX_".25",BGPORXX_".26",BGPORXX_".27" D PI ;
- K BGPNODEN
- F BGPPC1=BGPORXX_".28",BGPORXX_".29",BGPORXX_".30" D PI^BGP1PDL1 ;
- ;
- F BGPPC1=BGPORXX_".31",BGPORXX_".32",BGPORXX_".33" D PI^BGP1PDL1 ;
- ;
- F BGPPC1=BGPORXX_".34",BGPORXX_".35",BGPORXX_".36" D PI^BGP1PDL1 ;
- ;
- F BGPPC1=BGPORXX_".37",BGPORXX_".38",BGPORXX_".39" D PI^BGP1PDL1 ;
- ;
- F BGPPC1=BGPORXX_".40",BGPORXX_".41",BGPORXX_".42" D PI^BGP1PDL1 ;
- ;
- Q
- IPC ;EP
- S BGPORXX=$P(^BGPINDB(BGPIC,12),U,6)
- D:'$G(BGPSUMON) H1 S BGPNODEN=1
- F BGPPC1=BGPORXX_".1",BGPORXX_".2",BGPORXX_".3",BGPORXX_".4" D PI ;
- ;
- S BGPNODEN=1
- F BGPPC1=BGPORXX_".5",BGPORXX_".6",BGPORXX_".7",BGPORXX_".8" D PI ;
- S BGPORDP=$P(^BGPINDB(BGPIC,12),U,6) F BGPORDP1=9:1:17 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI^BGP1PDL1
- Q
- PI ;EP
- S BGPDENP=0
- K BGPDHOLD
- K BGPCYP,BGPBLP,BGPPRP
- S BGPPC2=0 F S BGPPC2=$O(^BGPINDBC("AB",BGPPC1,BGPPC2)) Q:BGPPC2="" S BGPPC=$O(^BGPINDBC("AB",BGPPC1,BGPPC2,0)) D PI1
- Q
- PI1 ;EP
- K BGPEXCT,BGPSDP,BGPSDPN,BGPSDPO,BGPSDPD
- Q:'$$CHECK^BGP1DP1E(BGPPC)
- ;get numerator value of measure and calc %
- S BGPDF=$P(^BGPINDBC(BGPPC,0),U,9)
- S BGPNP=$P(^DD(90545.03,BGPDF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
- S BGPCYD=$$V^BGP1DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP1DP1C(1,N,P)
- S BGPPRD=$$V^BGP1DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP1DP1C(2,N,P)
- S BGPBLD=$$V^BGP1DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP1DP1C(3,N,P)
- S BGPNF=$P(^BGPINDBC(BGPPC,0),U,9)
- S BGPNP=$P(^DD(90545.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
- D SETN
- I $P($G(^BGPINDBC(BGPPC,14)),U) D
- .S ^TMP($J,"SUMMARYDEL",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,14),U,5),0),U,2),$P(^BGPINDBC(BGPPC,14),U,6),BGPPC)=BGPCYN_U_BGPPRN_U_BGPBLN
- .Q:'$G(BGPAREAA)
- .S X=0 F S X=$O(BGPSDP(X)) Q:X'=+X D ;SDPX
- ..S ^TMP($J,"SUMMARYDEL DETAIL PAGE",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,14),U,5),0),U,2),$P(^BGPINDBC(BGPPC,14),U,6),BGPPC,X)=$P($G(BGPSDP(X,1)),U,2)_U_$P($G(BGPSDP(X,2)),U,2)_U_$P($G(BGPSDP(X,3)),U,2)_U_BGPCYN
- ;NON
- I $P($G(^BGPINDBC(BGPPC,15)),U) D
- .S ^TMP($J,"SUMMARYDEL NON",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,15),U,5),0),U,3),$P(^BGPINDBC(BGPPC,15),U,6),BGPPC)=BGPCYN_U_BGPPRN_U_BGPBLN
- .I $G(BGPAREAA) D ;SDPX
- ..S X=0 F S X=$O(BGPSDPN(X)) Q:X'=+X D ;SDPX
- ...S ^TMP($J,"SUMMARYDEL DETAIL PAGE NON",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,15),U,5),0),U,3),$P(^BGPINDBC(BGPPC,15),U,6),BGPPC,X)=$P($G(BGPSDPN(X,1)),U,2)_U_$P($G(BGPSDPN(X,2)),U,2)_U_$P($G(BGPSDPN(X,3)),U,2)_U_BGPCYN
- ;DEVEL
- I $P($G(^BGPINDBC(BGPPC,22)),U) D
- .S ^TMP($J,"SUMMARYDEL DEVEL",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,22),U,5),0),U,3),$P(^BGPINDBC(BGPPC,22),U,6),BGPPC)=BGPCYN_U_BGPPRN_U_BGPBLN
- .I $G(BGPAREAA) D ;SDPX
- ..S X=0 F S X=$O(BGPSDPD(X)) Q:X'=+X D ;SDPX
- ...S ^TMP($J,"SUMMARYDEL DETAIL PAGE DEVEL",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,22),U,5),0),U,3),$P(^BGPINDBC(BGPPC,22),U,6),BGPPC,X)=$P($G(BGPSDPD(X,1)),U,2)_U_$P($G(BGPSDPD(X,2)),U,2)_U_$P($G(BGPSDPD(X,3)),U,2)_U_BGPCYN
- ;OTHER
- I $P($G(^BGPINDBC(BGPPC,19)),U) D
- .S ^TMP($J,"SUMMARYDEL OTHER",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,19),U,5),0),U,3),$P(^BGPINDBC(BGPPC,19),U,6),BGPPC)=BGPCYN_U_BGPPRN_U_BGPBLN
- .I $G(BGPAREAA) D ;SDPX
- ..S X=0 F S X=$O(BGPSDPO(X)) Q:X'=+X D ;SDPX
- ...S ^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",$P(^BGPSCAT($P(^BGPINDBC(BGPPC,19),U,5),0),U,3),$P(^BGPINDBC(BGPPC,19),U,6),BGPPC,X)=$P($G(BGPSDPO(X,1)),U,2)_U_$P($G(BGPSDPO(X,2)),U,2)_U_$P($G(BGPSDPO(X,3)),U,2)_U_BGPCYN
- I BGPROT="D"!(BGPROT="B") D SETSUM^BGP1DP2
- S X=$P(^BGPINDBC(BGPPC,0),U,15)_" "_$P(^BGPINDBC(BGPPC,0),U,16)_" "_$P(^BGPINDBC(BGPPC,0),U,19) D S(X,1,1)
- D H2
- Q
- H2 ;
- S BGPX="",BGPX=BGPCYN,$P(BGPX,U,2)=$S(BGPCYP]"":$$SB($J(BGPCYP,5,1)),1:""),$P(BGPX,U,3)=BGPPRN,$P(BGPX,U,4)=$S(BGPPRP]"":$$SB($J(BGPPRP,5,1)),1:"")
- S $P(BGPX,U,5)=$$SB($J($$CALC(BGPCYN,BGPPRN),6)),$P(BGPX,U,6)=BGPBLN,$P(BGPX,U,7)=$S(BGPBLP]"":$$SB($J(BGPBLP,5,1)),1:"")
- S $P(BGPX,U,8)=$$SB($J($$CALC(BGPCYN,BGPBLN),6))
- D S(BGPX,,2)
- Q
- H1 ;EP
- S Y="REPORT" D S(Y,1,2)
- S Y=" " D S(Y,,3)
- S Y="PREV YR" D S(Y,,4)
- S Y=" " D S(Y,,5)
- S Y="CHG from" D S(Y,,6)
- S Y="BASE" D S(Y,,7)
- S Y=" " D S(Y,,8)
- S Y="CHG from" D S(Y,,9)
- S Y="PERIOD" D S(Y,1,2)
- S Y="PERIOD" D S(Y,,4)
- S Y="PREV YR " D S(Y,,6)
- S Y="PERIOD" D S(Y,,7)
- S Y="BASE " D S(Y,,9)
- Q
- C(X,X2,X3) ;
- D COMMA^%DTC
- Q X
- S(Y,F,P) ;set up array
- I '$G(F) S F=0
- S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
- I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
- S $P(^TMP($J,"BGPDEL",%),U,P)=Y
- Q
- CALC(N,O) ;ENTRY POINT
- NEW Z
- S Z=N-O,Z=$FN(Z,"+,",0)
- Q Z
- SB(X) ;EP - Strip leading and trailing blanks from X.
- X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)
- Q X
- SETN ;set numerator fields
- S BGPIIDEL=1,BGPNOSUM=1
- D SETN^BGP1DP1C
- K BGPNOSUM,BGPIIDEL
- S (BGPCYP,BGPPRP,BGPBLP)=""
- Q
- BGP1PDL2 ; IHS/CMI/LAB - print ind 1 ;
- +1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- +2 ;
- +3 ;this routine for Measure I14 ONLY
- I10 ;EP
- +1 SET BGPORXX=$PIECE(^BGPINDB(BGPIC,12),U,6)
- +2 IF '$GET(BGPSUMON)
- DO H1
- SET BGPNODEN=1
- +3 FOR BGPPC1=$PIECE(^BGPINDB(BGPIC,12),U,6)_".1"
- DO PI
- +4 KILL BGPNODEN
- +5 FOR BGPPC1=$PIECE(^BGPINDB(BGPIC,12),U,6)_".2"
- DO PI^BGP1PDL1
- +6 QUIT
- I11 ;EP
- +1 SET BGPORXX=$PIECE(^BGPINDB(BGPIC,12),U,6)
- +2 IF '$GET(BGPSUMON)
- DO H1
- SET BGPNODEN=1
- +3 FOR BGPPC1=BGPORXX_".1"
- DO PI
- +4 SET BGPNODEN=1
- +5 FOR BGPPC1=BGPORXX_".2"
- DO PI
- +6 KILL BGPNODEN
- +7 FOR BGPPC1=BGPORXX_".4"
- DO PI^BGP1PDL1
- +8 QUIT
- ISTI ;EP
- +1 SET BGPORXX=$PIECE(^BGPINDB(BGPIC,12),U,6)
- +2 IF '$GET(BGPSUMON)
- DO H1
- SET BGPNODEN=1
- +3 FOR BGPPC1=BGPORXX_".1",BGPORXX_".2",BGPORXX_".3"
- DO PI
- +4 SET BGPNODEN=1
- +5 ;
- FOR BGPPC1=BGPORXX_".4",BGPORXX_".5",BGPORXX_".6"
- DO PI
- +6 ;
- +7 KILL BGPNODEN
- +8 ;
- FOR BGPPC1=BGPORXX_".7",BGPORXX_".8",BGPORXX_".9"
- DO PI^BGP1PDL1
- +9 ;
- +10 ;
- FOR BGPPC1=BGPORXX_".10",BGPORXX_".11",BGPORXX_".12"
- DO PI^BGP1PDL1
- +11 ;
- +12 ;
- FOR BGPPC1=BGPORXX_".13",BGPORXX_".14",BGPORXX_".15"
- DO PI^BGP1PDL1
- +13 ;
- +14 ;
- FOR BGPPC1=BGPORXX_".16",BGPORXX_".17",BGPORXX_".18"
- DO PI^BGP1PDL1
- +15 ;
- +16 ;
- FOR BGPPC1=BGPORXX_".19",BGPORXX_".20",BGPORXX_".21"
- DO PI^BGP1PDL1
- +17 ;
- +18 ;USER POP
- +19 DO S(" ",1,1)
- +20 SET BGPNODEN=1
- +21 ;
- FOR BGPPC1=BGPORXX_".22",BGPORXX_".23",BGPORXX_".24"
- DO PI
- +22 ;
- +23 SET BGPNODEN=1
- +24 ;
- FOR BGPPC1=BGPORXX_".25",BGPORXX_".26",BGPORXX_".27"
- DO PI
- +25 KILL BGPNODEN
- +26 ;
- FOR BGPPC1=BGPORXX_".28",BGPORXX_".29",BGPORXX_".30"
- DO PI^BGP1PDL1
- +27 ;
- +28 ;
- FOR BGPPC1=BGPORXX_".31",BGPORXX_".32",BGPORXX_".33"
- DO PI^BGP1PDL1
- +29 ;
- +30 ;
- FOR BGPPC1=BGPORXX_".34",BGPORXX_".35",BGPORXX_".36"
- DO PI^BGP1PDL1
- +31 ;
- +32 ;
- FOR BGPPC1=BGPORXX_".37",BGPORXX_".38",BGPORXX_".39"
- DO PI^BGP1PDL1
- +33 ;
- +34 ;
- FOR BGPPC1=BGPORXX_".40",BGPORXX_".41",BGPORXX_".42"
- DO PI^BGP1PDL1
- +35 ;
- +36 QUIT
- IPC ;EP
- +1 SET BGPORXX=$PIECE(^BGPINDB(BGPIC,12),U,6)
- +2 IF '$GET(BGPSUMON)
- DO H1
- SET BGPNODEN=1
- +3 ;
- FOR BGPPC1=BGPORXX_".1",BGPORXX_".2",BGPORXX_".3",BGPORXX_".4"
- DO PI
- +4 ;
- +5 SET BGPNODEN=1
- +6 ;
- FOR BGPPC1=BGPORXX_".5",BGPORXX_".6",BGPORXX_".7",BGPORXX_".8"
- DO PI
- +7 SET BGPORDP=$PIECE(^BGPINDB(BGPIC,12),U,6)
- FOR BGPORDP1=9:1:17
- SET BGPPC1=BGPORDP_"."_BGPORDP1
- DO PI^BGP1PDL1
- +8 QUIT
- PI ;EP
- +1 SET BGPDENP=0
- +2 KILL BGPDHOLD
- +3 KILL BGPCYP,BGPBLP,BGPPRP
- +4 SET BGPPC2=0
- FOR
- SET BGPPC2=$ORDER(^BGPINDBC("AB",BGPPC1,BGPPC2))
- IF BGPPC2=""
- QUIT
- SET BGPPC=$ORDER(^BGPINDBC("AB",BGPPC1,BGPPC2,0))
- DO PI1
- +5 QUIT
- PI1 ;EP
- +1 KILL BGPEXCT,BGPSDP,BGPSDPN,BGPSDPO,BGPSDPD
- +2 IF '$$CHECK^BGP1DP1E(BGPPC)
- QUIT
- +3 ;get numerator value of measure and calc %
- +4 SET BGPDF=$PIECE(^BGPINDBC(BGPPC,0),U,9)
- +5 SET BGPNP=$PIECE(^DD(90545.03,BGPDF,0),U,4)
- SET N=$PIECE(BGPNP,";")
- SET P=$PIECE(BGPNP,";",2)
- +6 SET BGPCYD=$$V^BGP1DP1C(1,BGPRPT,N,P,1)
- IF $GET(BGPAREAA)
- DO SETEXA^BGP1DP1C(1,N,P)
- +7 SET BGPPRD=$$V^BGP1DP1C(2,BGPRPT,N,P,1)
- IF $GET(BGPAREAA)
- DO SETEXA^BGP1DP1C(2,N,P)
- +8 SET BGPBLD=$$V^BGP1DP1C(3,BGPRPT,N,P,1)
- IF $GET(BGPAREAA)
- DO SETEXA^BGP1DP1C(3,N,P)
- +9 SET BGPNF=$PIECE(^BGPINDBC(BGPPC,0),U,9)
- +10 SET BGPNP=$PIECE(^DD(90545.03,BGPNF,0),U,4)
- SET N=$PIECE(BGPNP,";")
- SET P=$PIECE(BGPNP,";",2)
- +11 DO SETN
- +12 IF $PIECE($GET(^BGPINDBC(BGPPC,14)),U)
- Begin DoDot:1
- +13 SET ^TMP($JOB,"SUMMARYDEL",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,14),U,5),0),U,2),$PIECE(^BGPINDBC(BGPPC,14),U,6),BGPPC)=BGPCYN_U_BGPPRN_U_BGPBLN
- +14 IF '$GET(BGPAREAA)
- QUIT
- +15 ;SDPX
- SET X=0
- FOR
- SET X=$ORDER(BGPSDP(X))
- IF X'=+X
- QUIT
- Begin DoDot:2
- +16 SET ^TMP($JOB,"SUMMARYDEL DETAIL PAGE",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,14),U,5),0),U,2),$PIECE(^BGPINDBC(BGPPC,14),U,6),BGPPC,X)=$PIECE($GET(BGPSDP(X,1)),U,2)_U_$PIECE($GET(BGPSDP(X,2)),U,2)_U_$PIECE($GET(BGPSDP(X,3)),U,2
- )_U_BGPCYN
- End DoDot:2
- End DoDot:1
- +17 ;NON
- +18 IF $PIECE($GET(^BGPINDBC(BGPPC,15)),U)
- Begin DoDot:1
- +19 SET ^TMP($JOB,"SUMMARYDEL NON",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,15),U,5),0),U,3),$PIECE(^BGPINDBC(BGPPC,15),U,6),BGPPC)=BGPCYN_U_BGPPRN_U_BGPBLN
- +20 ;SDPX
- IF $GET(BGPAREAA)
- Begin DoDot:2
- +21 ;SDPX
- SET X=0
- FOR
- SET X=$ORDER(BGPSDPN(X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +22 SET ^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,15),U,5),0),U,3),$PIECE(^BGPINDBC(BGPPC,15),U,6),BGPPC,X)=$PIECE($GET(BGPSDPN(X,1)),U,2)_U_$PIECE($GET(BGPSDPN(X,2)),U,2)_U_$PIECE($GET(BG
- PSDPN(X,3)),U,2)_U_BGPCYN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 ;DEVEL
- +24 IF $PIECE($GET(^BGPINDBC(BGPPC,22)),U)
- Begin DoDot:1
- +25 SET ^TMP($JOB,"SUMMARYDEL DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,22),U,5),0),U,3),$PIECE(^BGPINDBC(BGPPC,22),U,6),BGPPC)=BGPCYN_U_BGPPRN_U_BGPBLN
- +26 ;SDPX
- IF $GET(BGPAREAA)
- Begin DoDot:2
- +27 ;SDPX
- SET X=0
- FOR
- SET X=$ORDER(BGPSDPD(X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +28 SET ^TMP($JOB,"SUMMARYDEL DETAIL PAGE DEVEL",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,22),U,5),0),U,3),$PIECE(^BGPINDBC(BGPPC,22),U,6),BGPPC,X)=$PIECE($GET(BGPSDPD(X,1)),U,2)_U_$PIECE($GET(BGPSDPD(X,2)),U,2)_U_$PIECE($GET(
- BGPSDPD(X,3)),U,2)_U_BGPCYN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +29 ;OTHER
- +30 IF $PIECE($GET(^BGPINDBC(BGPPC,19)),U)
- Begin DoDot:1
- +31 SET ^TMP($JOB,"SUMMARYDEL OTHER",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,19),U,5),0),U,3),$PIECE(^BGPINDBC(BGPPC,19),U,6),BGPPC)=BGPCYN_U_BGPPRN_U_BGPBLN
- +32 ;SDPX
- IF $GET(BGPAREAA)
- Begin DoDot:2
- +33 ;SDPX
- SET X=0
- FOR
- SET X=$ORDER(BGPSDPO(X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +34 SET ^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",$PIECE(^BGPSCAT($PIECE(^BGPINDBC(BGPPC,19),U,5),0),U,3),$PIECE(^BGPINDBC(BGPPC,19),U,6),BGPPC,X)=$PIECE($GET(BGPSDPO(X,1)),U,2)_U_$PIECE($GET(BGPSDPO(X,2)),U,2)_U_$PIECE($GET(
- BGPSDPO(X,3)),U,2)_U_BGPCYN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +35 IF BGPROT="D"!(BGPROT="B")
- DO SETSUM^BGP1DP2
- +36 SET X=$PIECE(^BGPINDBC(BGPPC,0),U,15)_" "_$PIECE(^BGPINDBC(BGPPC,0),U,16)_" "_$PIECE(^BGPINDBC(BGPPC,0),U,19)
- DO S(X,1,1)
- +37 DO H2
- +38 QUIT
- H2 ;
- +1 SET BGPX=""
- SET BGPX=BGPCYN
- SET $PIECE(BGPX,U,2)=$SELECT(BGPCYP]"":$$SB($JUSTIFY(BGPCYP,5,1)),1:"")
- SET $PIECE(BGPX,U,3)=BGPPRN
- SET $PIECE(BGPX,U,4)=$SELECT(BGPPRP]"":$$SB($JUSTIFY(BGPPRP,5,1)),1:"")
- +2 SET $PIECE(BGPX,U,5)=$$SB($JUSTIFY($$CALC(BGPCYN,BGPPRN),6))
- SET $PIECE(BGPX,U,6)=BGPBLN
- SET $PIECE(BGPX,U,7)=$SELECT(BGPBLP]"":$$SB($JUSTIFY(BGPBLP,5,1)),1:"")
- +3 SET $PIECE(BGPX,U,8)=$$SB($JUSTIFY($$CALC(BGPCYN,BGPBLN),6))
- +4 DO S(BGPX,,2)
- +5 QUIT
- H1 ;EP
- +1 SET Y="REPORT"
- DO S(Y,1,2)
- +2 SET Y=" "
- DO S(Y,,3)
- +3 SET Y="PREV YR"
- DO S(Y,,4)
- +4 SET Y=" "
- DO S(Y,,5)
- +5 SET Y="CHG from"
- DO S(Y,,6)
- +6 SET Y="BASE"
- DO S(Y,,7)
- +7 SET Y=" "
- DO S(Y,,8)
- +8 SET Y="CHG from"
- DO S(Y,,9)
- +9 SET Y="PERIOD"
- DO S(Y,1,2)
- +10 SET Y="PERIOD"
- DO S(Y,,4)
- +11 SET Y="PREV YR "
- DO S(Y,,6)
- +12 SET Y="PERIOD"
- DO S(Y,,7)
- +13 SET Y="BASE "
- DO S(Y,,9)
- +14 QUIT
- C(X,X2,X3) ;
- +1 DO COMMA^%DTC
- +2 QUIT X
- S(Y,F,P) ;set up array
- +1 IF '$GET(F)
- SET F=0
- +2 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)+F
- SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
- +3 IF '$DATA(^TMP($JOB,"BGPDEL",%))
- SET ^TMP($JOB,"BGPDEL",%)=""
- +4 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=Y
- +5 QUIT
- CALC(N,O) ;ENTRY POINT
- +1 NEW Z
- +2 SET Z=N-O
- SET Z=$FNUMBER(Z,"+,",0)
- +3 QUIT Z
- SB(X) ;EP - Strip leading and trailing blanks from X.
- +1 XECUTE ^DD("FUNC",$ORDER(^DD("FUNC","B","STRIPBLANKS",0)),1)
- +2 QUIT X
- SETN ;set numerator fields
- +1 SET BGPIIDEL=1
- SET BGPNOSUM=1
- +2 DO SETN^BGP1DP1C
- +3 KILL BGPNOSUM,BGPIIDEL
- +4 SET (BGPCYP,BGPPRP,BGPBLP)=""
- +5 QUIT
