BGP4DBPR ; IHS/CMI/LAB - IHS gpra print 03 Jul 2010 6:26 AM ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
;
PRINT ;
I $O(BGPDESGP(0)) D Q ;desg provider print
.S BGPQUIT=""
.S BGPXX2=0 F S BGPXX2=$O(BGPDESGP(BGPXX2)) Q:BGPXX2'=+BGPXX2!(BGPQUIT) D
..Q:$G(BGPAREAA)
..Q:BGPROT="D" ;only delimited so don't bother with print
..S BGPRPT=$P(BGPDESGP(BGPXX2),U,1)
..S BGPDELF=$P(BGPDESGP(BGPXX2),U,2)
..S BGPDESGP=BGPXX2
..K ^TMP($J)
..K BGPDELIM
..S BGPIOSL=$S($G(BGPGUI):55,1:$G(IOSL))
..S ^TMP($J,"BGPDEL",0)=0
..S BGPQUIT=""
..S BGPPTYPE="P"
..S BGPQHDR=0
..D ^BGP4DH
..I BGPQHDR S BGPQUIT=1 D KITM Q
..S BGPGPG=0
..S BGPQUIT=""
..D PRINT1
..K ^TMP($J)
..Q
.;NOW DO DELIMITED IF NEEDED
.I BGPROT="P" D KITM Q
.S BGPQUIT=""
.I '$D(BGPGUI) D ^%ZISC ;close printer device
.S BGPXX2=0 F S BGPXX2=$O(BGPDESGP(BGPXX2)) Q:BGPXX2'=+BGPXX2!(BGPQUIT) D
..Q:$G(BGPAREAA)
..S BGPRPT=$P(BGPDESGP(BGPXX2),U,1)
..S BGPDELF=$P(BGPDESGP(BGPXX2),U,2)
..S BGPDESGP=BGPXX2
..K ^TMP($J)
..K BGPDELIM
..S BGPIOSL=$S($G(BGPGUI):55,1:$G(IOSL))
..S ^TMP($J,"BGPDEL",0)=0
..S BGPQUIT=""
..S BGPPTYPE="D"
..S BGPQHDR=0
..W:$D(IOF) @IOF
..D ^BGP4DH
..I BGPQHDR S BGPQUIT=1 D KITM Q
..S BGPGPG=0
..S BGPQUIT=""
..D PRINT1
..D SAVEDEL^BGP4PDL ;D ^BGP4PDL ;create ^tmp of delimited report
..S BGPIFTR=1
..K ^XTMP("BGP4D",BGPJ,BGPH)
..K ^XTMP("BGP4DNP",BGPJ,BGPH)
..K ^XTMP("BGP28CPL",BGPJ,BGPH)
..K ^TMP($J)
..Q
PRINTN ;EP
K ^TMP($J)
S BGPIOSL=$S($G(BGPGUI):55,1:$G(IOSL))
S BGPQUIT=""
S ^TMP($J,"BGPDEL",0)=0
S BGPIFTR=""
I BGPROT="D" G DEL
S BGPPTYPE="P"
S BGPQHDR=0
D ^BGP4DH ;LORI
I BGPQHDR D KITM Q
S BGPGPG=0
S BGPQUIT=""
D PRINT1
K ^TMP($J)
I BGPROT="P" D KITM Q
;
DEL ;create delimited output file
I '$D(BGPGUI) D ^%ZISC ;close printer device
K ^TMP($J)
S ^TMP($J,"BGPDEL",0)=0
S BGPQHDR=0
S BGPPTYPE="D"
D ^BGP4DH
S BGPGPG=0
S BGPQUIT=""
D PRINT1
D SAVEDEL^BGP4PDL ;D ^BGP4PDL ;create ^tmp of delimited report
S BGPIFTR=1
K ^XTMP("BGP4D",BGPJ,BGPH)
K ^XTMP("BGP4DNP",BGPJ,BGPH)
K ^XTMP("BGP28CPL",BGPJ,BGPH)
K ^TMP($J)
Q
W(V,C,F,M,P,T) ;EP
I $G(F)="" S F=1
I $G(C)="" S C=0
I $G(P)="" S P=1
I $G(T)="" S T=0
I M="P" D Q
.;I $Y>(BGPIOSL-2) D EOP W:$D(IOF) @IOF
.NEW X
.F X=1:1:F W !
.I C W $$CJ^XLFSTR(V,80)
.I 'C W ?T,V
;set up array
I '$G(F) S F=0
NEW %,Z
S Z=""
S %=$P(^TMP($J,"BGPDEL",0),U)
F Z=1:1:F S %=%+1 S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",0),U)=%
I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",%),U,P)=V
Q
;
WTITLE(I) ;EP - write title line
NEW T,X,Y,S
S T=$P(^BGPINDJ(I,0),U,3)
I BGPPTYPE="P",$L(T)<81 D W(T,0,1,BGPPTYPE),W("",0,1,BGPPTYPE) Q ; W !,T,! Q
I BGPPTYPE="D" D W(T,0,1,BGPPTYPE),W("",0,1,BGPPTYPE) Q
F X=$E(T,1,80)
S S=""
F Y=80:-1:1 Q:S S I=$E(X,Y) I I=" " S S=Y
D W^BGP4DP($E(T,1,S),0,1,BGPPTYPE) ;W !,$E(T,1,S)
D W^BGP4DP($E(T,(S+1),$L(T)),0,1,BGPPTYPE),W("",0,1,BGPPTYPE) ;W !,$E(T,(S+1),$L(T)),!
Q
ANYDEV() ;
NEW X,G,Y
S G=0
S X=0 F S X=$O(BGPINDL(X)) Q:X'=+X S Y=0 F S Y=$O(BGPINDL(X,Y)) Q:Y'=+Y I $P(^BGPNPLJ(Y,0),U,7)=9 S G=1
Q G
ALLDEV() ;
NEW X,G,Y
S G=1
S X=0 F S X=$O(BGPINDL(X)) Q:X'=+X S Y=0 F S Y=$O(BGPINDL(X,Y)) Q:Y'=+Y I $P(^BGPNPLJ(Y,0),U,7)=1 S G=0
Q G
PRINT1 ;EP
;if in NGR or GPU now print gpra dev measures and divider page
NEW BGPPC,BGPORD
I BGPPTYPE="P" D HEADER^BGP4DPH
D W^BGP4DP($S($G(BGPAREAA):"AREA AGGREGATE ",1:"")_"Dashboard Report - "_$P(^DIC(4,$S($G(BGPISITE):BGPISITE,1:DUZ(2)),0),U,1),1,2,BGPPTYPE)
D W^BGP4DP(" ",0,1,BGPPTYPE)
D COLHDR
S BGPORD=0
S Y=$O(^BGPCTRL("B",2014,0))
S Y=$P(^BGPCTRL(Y,0),U,8)
S BGPPERY=$$FMDIFF^XLFDT(DT,Y)
S BGPPERY=BGPPERY/365,BGPPERY=BGPPERY*100,BGPPERY=BGPPERY+.5,BGPPERY=$J(BGPPERY,3,0),BGPPERY=$$STRIP^XLFSTR(BGPPERY," ")
F S BGPORD=$O(^BGPINDJC("ADASH",BGPORD)) Q:BGPORD'=+BGPORD!(BGPQUIT) D
.S BGPPC=0 F S BGPPC=$O(^BGPINDJC("ADASH",BGPORD,BGPPC)) Q:BGPPC'=+BGPPC!(BGPQUIT) D
..;GET VALUES FOR PREVIOUS YEAR, CURRENT YEAR, GET DENOM VALUE FOR 2014
..S BGPDF=$P(^BGPINDJC(BGPPC,0),U,8)
..;get denom value
..S BGPNP=$P(^DD(90552.03,BGPDF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
..S BGPCYD=$$V^BGP4DP1C(1,BGPRPT,N,P,1,1)
..S BGPPRD=$$V^BGP4DP1C(2,BGPRPT,N,P,1,1)
..;get numerator values
..S BGPNF=$P(^BGPINDJC(BGPPC,0),U,9)
..S BGPNP=$P(^DD(90552.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
..D SETN
..;now figure out out # needed and on track status
..I '$P($G(^BGPINDJC(BGPPC,23)),U,3) D
...S BGPGOAL="",BGPGOAL=$P($G(^BGPINDJC(BGPPC,14)),U,8)
...I BGPGOAL'="Baseline" S BGPGOAL=+BGPGOAL
...S BGPNEG=$P($G(^BGPINDJC(BGPPC,23)),U,5)
...I BGPGOAL="Baseline" S BGPNEED="N/A",BGPOT="N/A" Q
...S BGPOT=""
...S BGPGG=BGPGOAL/100
...S BGPNEED1=BGPGG*BGPCYD,BGPNEED1=BGPNEED1+.9,BGPNEED1=$P(BGPNEED1,".")
...S BGPCYPER=BGPCYP/100
...S BGPNEED2=BGPCYPER*BGPCYD,BGPNEED2=BGPNEED2+.9,BGPNEED2=$P(BGPNEED2,".") ;;;
...S BGPNEED=BGPNEED1-BGPNEED2
...I BGPNEG S BGPNEED=BGPNEED2-BGPNEED1
...;S BGPNEED=BGPNEED+.5,BGPNEED=$P(BGPNEED,".",1)
...I BGPGG S BGPCOLG=BGPCYPER/BGPGG,BGPCOLG=BGPCOLG*100 I 1
...E S BGPCOLG=0.0
...I 'BGPNEG,BGPCOLG'<100 S BGPOT="ON TRACK" Q
...I BGPNEG,BGPCOLG'>100 S BGPOT="ON TRACK" Q
...I 'BGPNEG,BGPCOLG'<BGPPERY S BGPOT="WITHIN RANGE" Q
...I BGPNEG,BGPCOLG'>BGPPERY S BGPOT="WITHIN RANGE" Q
...S BGPOT="NOT ON TRACK"
..I $P($G(^BGPINDJC(BGPPC,23)),U,3) D
...S BGPGOAL="",BGPGOAL=$P($G(^BGPINDJC(BGPPC,14)),U,8)
...I BGPGOAL'="Baseline" S BGPGOAL=+BGPGOAL
...S BGPNEG=$P($G(^BGPINDJC(BGPPC,23)),U,5)
...I BGPGOAL="Baseline" S BGPNEED="N/A",BGPOT="N/A" Q
...S BGPOT=""
...S BGPGP=$P($G(^BGPINDJC(BGPPC,23)),U,4)
...S BGPGG=BGPGP/100
...;S BGPNGA=BGPGG*BGPPRN
...S BGPTN=BGPPRN*(1+BGPGG)
...S BGPTN=BGPTN+.9,BGPTN=$P(BGPTN,".")
...S BGPNEED=BGPTN-BGPCYN
...I BGPNEED<1 S BGPOT="ON TRACK" Q
...S G=BGPCYN/BGPTN
...I G'<BGPPERY S BGPOT="WITHIN RANGE" Q
...S BGPOT="NOT ON TRACK"
N ..;write out values for this measure
..I BGPPTYPE="P" I $Y>(IOSL-4) D HEADER^BGP4DPH Q:BGPQUIT D COLHDR
..I $P($G(^BGPINDJC(BGPPC,23)),U,1) D W^BGP4DP(" ",0,1,BGPPTYPE)
..D W^BGP4DP($P($G(^BGPINDJC(BGPPC,23)),U,2),0,1,BGPPTYPE,1,0)
..I $P($G(^BGPINDJC(BGPPC,23)),U,6)]"" D W^BGP4DP($P($G(^BGPINDJC(BGPPC,23)),U,6),0,1,BGPPTYPE,1,0)
..I BGPPTYPE="D" D
...D W^BGP4DP($S('$P(^BGPINDJC(BGPPC,23),U,3):BGPGOAL,1:+BGPTN),0,0,BGPPTYPE,2,30)
...I '$P(^BGPINDJC(BGPPC,23),U,3) D
....D W^BGP4DP($S(BGPPTYPE="D":$$SB($J(BGPPRP,5,1)),1:$J(BGPPRP,5,1)),0,0,BGPPTYPE,3,39)
....D W^BGP4DP(BGPCYN,0,0,BGPPTYPE,4,47)
....D W^BGP4DP(BGPCYD,0,0,BGPPTYPE,5,55)
....D W^BGP4DP($S(BGPPTYPE="D":$$SB($J(BGPCYP,5,1)),1:$J(BGPCYP,5,1)),0,0,BGPPTYPE,6,47)
....D W^BGP4DP($S(BGPNEED="N/A":BGPNEED,BGPNEED>0:BGPNEED,1:0),0,0,BGPPTYPE,7,65)
...I $P(^BGPINDJC(BGPPC,23),U,3) D
....D W^BGP4DP($S(BGPPTYPE="D":BGPPRN,1:BGPPRN),0,0,BGPPTYPE,3,39)
....D W^BGP4DP($S(BGPPTYPE="D":BGPCYN,1:BGPCYN),0,0,BGPPTYPE,4,47)
....D W^BGP4DP(BGPCYN,0,0,BGPPTYPE,6,55)
....D W^BGP4DP($S(BGPNEED="N/A":BGPNEED,BGPNEED>0:BGPNEED,1:0),0,0,BGPPTYPE,7,65)
...;D W^BGP4DP(BGPOT,0,0,BGPPTYPE,8,75)
..I BGPPTYPE="P" D
...D W^BGP4DP($S('$P(^BGPINDJC(BGPPC,23),U,3):$J(BGPGOAL,8),1:$$LBLK(+BGPTN,7)),0,0,BGPPTYPE,2,28)
...I '$P(^BGPINDJC(BGPPC,23),U,3) D
....D W^BGP4DP($S(BGPPTYPE="D":$$SB($J(BGPPRP,5,1)),1:$J(BGPPRP,5,1)),0,0,BGPPTYPE,3,40)
....D W^BGP4DP($$C(BGPCYN,0,8),0,0,BGPPTYPE,4,50)
....D W^BGP4DP($$C(BGPCYD,0,8),0,0,BGPPTYPE,5,60)
....D W^BGP4DP($S(BGPPTYPE="D":$$SB($J(BGPCYP,5,1)),1:$J(BGPCYP,5,1)),0,0,BGPPTYPE,6,70)
....D W^BGP4DP("# Needed to Achieve Target: "_$S(BGPNEED="N/A":BGPNEED,BGPNEED>0:$S(BGPNEG:"-",1:"")_BGPNEED,1:0),0,1,BGPPTYPE,0,5)
...I $P(^BGPINDJC(BGPPC,23),U,3) D
....D W^BGP4DP($S(BGPPTYPE="D":BGPPRN,1:$$C(BGPPRN,0,8)),0,0,BGPPTYPE,3,40)
....D W^BGP4DP($S(BGPPTYPE="D":BGPCYN,1:$$C(BGPCYN,0,8)),0,0,BGPPTYPE,4,50)
....D W^BGP4DP(BGPCYN,0,0,BGPPTYPE,7,70)
....D W^BGP4DP("# Needed to Achieve Target: "_$S(BGPNEED="N/A":BGPNEED,BGPNEED>0:BGPNEED,1:0),0,1,BGPPTYPE,,5)
...;D W^BGP4DP(BGPOT,0,0,BGPPTYPE,0,40)
..D W^BGP4DP(" ",0,1,BGPPTYPE)
I BGPPTYPE="P" D W^BGP4DP("*Results reflect services provided as of the date this report was run or the ",0,1,BGPPTYPE) D W^BGP4DP("report period end date, whichever is earlier",0,1,BGPPTYPE)
I BGPPTYPE="D" D W^BGP4DP("*Results reflect services provided as of the date this report was run or the report period end date, whichever is earlier",0,1,BGPPTYPE)
D W^BGP4DP(" ",0,1,BGPPTYPE)
Q
SETN ;EP - set numerator fields
S BGPCYN=$$V^BGP4DP1C(1,BGPRPT,N,P,2)
S BGPPRN=$$V^BGP4DP1C(2,BGPRPT,N,P,2)
S BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"0.0")
S BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"0.0")
Q
COLHDR ;
I BGPPTYPE="D" D Q
.I '$G(BGPAREAA) D W^BGP4DP("National 2014 Target",0,1,BGPPTYPE,2)
.I $G(BGPAREAA) D W^BGP4DP("National 2014 Target",0,1,BGPPTYPE,2)
.D W^BGP4DP($$FMTE^XLFDT(BGPDASHP)_" Final",0,0,BGPPTYPE,3)
.D W^BGP4DP("Numerator",0,0,BGPPTYPE,4)
.D W^BGP4DP("Denominator",0,0,BGPPTYPE,5)
.D W^BGP4DP($$FMTE^XLFDT(BGPDASHY)_"*",0,0,BGPPTYPE,6)
.D W^BGP4DP("# Needed to Achieve Target",0,0,BGPPTYPE,7)
.;
D W^BGP4DP("National"_$S('$G(BGPAREAA):"",1:""),0,1,BGPPTYPE,2,30)
D W^BGP4DP(2014,0,1,BGPPTYPE,2,30)
D W^BGP4DP($$FMTE^XLFDT(BGPDASHP),0,0,BGPPTYPE,3,40)
D W^BGP4DP("Denom-",0,0,BGPPTYPE,,60)
D W^BGP4DP($$FMTE^XLFDT(BGPDASHY)_"*",0,0,BGPPTYPE,,70)
D W^BGP4DP("Target",0,1,BGPPTYPE,,30)
D W^BGP4DP("Final",0,0,BGPPTYPE,,40)
D W^BGP4DP("Numerator",0,0,BGPPTYPE,,50)
D W^BGP4DP("inator",0,0,BGPPTYPE,,60)
D W^BGP4DP("(Current)",0,0,BGPPTYPE,,70)
D W^BGP4DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
Q
WP ;
K ^UTILITY($J,"W")
S BGPZ=0,BGPLCNT=0
S DIWL=1,DIWR=80,DIWF="",BGPZ=0 F S BGPZ=$O(^BGPINDJ(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
.S BGPLCNT=BGPLCNT+1
.S X=^BGPINDJ(BGPIC,BGPNODE,BGPY,1,BGPZ,0) S:BGPLCNT=1 X=" - "_X D ^DIWP
.Q
WPS ;
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z D
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP4DPH Q:BGPQUIT
.D W^BGP4DP(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),X
Q
PRINT2 ;
Q
KITM ;
K ^TMP($J)
K ^XTMP("BGP4D",BGPJ,BGPH)
K ^XTMP("BGP4DNP",BGPJ,BGPH)
K ^XTMP("BGP28CPL",BGPJ,BGPH)
Q
EXIT ;
Q:BGPPTYPE'="P"
I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO",DIR("A")="End of report. Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
SB(X) ;EP - Strip leading and trailing blanks from X.
NEW %
X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)
Q X
AREA ;EP - AREA DASHBOARD PRINT
K ^TMP($J)
S BGPIOSL=$S($G(BGPGUI):55,1:IOSL)
S BGPGPG=0
S BGPQUIT=""
S BGPIFTR=""
S ^TMP($J,"BGPDEL",0)=0
S BGPPTYPE="P"
I BGPROT="D" G DELA
D AREACP^BGP4DH1
S BGPQUIT="",BGPGPG=0,BGPRPT=0
D PRINT1
Q:BGPQUIT
I $G(BGPAREAA) K BGPAREAA D INDSITE S BGPAREAA=1
S BGPIFTR=1
Q:BGPROT="P"
DELA ;create delimited output file
S BGPQUIT="",BGPGPG=0,BGPRPT=0,BGPIFTR=""
D ^%ZISC ;close printer device
K ^TMP($J)
;D ^BGP4PDL ;create ^tmp of delimited report
S ^TMP($J,"BGPDEL",0)=0
S BGPPTYPE="D",BGPQUIT=0
D AREACP^BGP4DH
S BGPQUIT="",BGPGPG=0,BGPRPT=0
D PRINT1
I $G(BGPAREAA) K BGPAREAA D INDSITE S BGPAREAA=1
D SAVEDEL^BGP4PDL ;D ^BGP4PDL ;create ^tmp of delimited report
S BGPIFTR=1
K ^TMP($J)
Q
INDSITE ;
S BGPRPT=0 F S BGPRPT=$O(BGPSUL(BGPRPT)) Q:BGPRPT'=+BGPRPT!(BGPQUIT) D
.S BGPISITE=$P(^BGPGPDCJ(BGPRPT,0),U,9),BGPISITE=$O(^AUTTLOC("C",BGPISITE,0))
.D PRINT1
.Q
Q
LBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
Q V
BGP4DBPR ; IHS/CMI/LAB - IHS gpra print 03 Jul 2010 6:26 AM ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
+3 ;
PRINT ;
+1 ;desg provider print
IF $ORDER(BGPDESGP(0))
Begin DoDot:1
+2 SET BGPQUIT=""
+3 SET BGPXX2=0
FOR
SET BGPXX2=$ORDER(BGPDESGP(BGPXX2))
IF BGPXX2'=+BGPXX2!(BGPQUIT)
QUIT
Begin DoDot:2
+4 IF $GET(BGPAREAA)
QUIT
+5 ;only delimited so don't bother with print
IF BGPROT="D"
QUIT
+6 SET BGPRPT=$PIECE(BGPDESGP(BGPXX2),U,1)
+7 SET BGPDELF=$PIECE(BGPDESGP(BGPXX2),U,2)
+8 SET BGPDESGP=BGPXX2
+9 KILL ^TMP($JOB)
+10 KILL BGPDELIM
+11 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:$GET(IOSL))
+12 SET ^TMP($JOB,"BGPDEL",0)=0
+13 SET BGPQUIT=""
+14 SET BGPPTYPE="P"
+15 SET BGPQHDR=0
+16 DO ^BGP4DH
+17 IF BGPQHDR
SET BGPQUIT=1
DO KITM
QUIT
+18 SET BGPGPG=0
+19 SET BGPQUIT=""
+20 DO PRINT1
+21 KILL ^TMP($JOB)
+22 QUIT
End DoDot:2
+23 ;NOW DO DELIMITED IF NEEDED
+24 IF BGPROT="P"
DO KITM
QUIT
+25 SET BGPQUIT=""
+26 ;close printer device
IF '$DATA(BGPGUI)
DO ^%ZISC
+27 SET BGPXX2=0
FOR
SET BGPXX2=$ORDER(BGPDESGP(BGPXX2))
IF BGPXX2'=+BGPXX2!(BGPQUIT)
QUIT
Begin DoDot:2
+28 IF $GET(BGPAREAA)
QUIT
+29 SET BGPRPT=$PIECE(BGPDESGP(BGPXX2),U,1)
+30 SET BGPDELF=$PIECE(BGPDESGP(BGPXX2),U,2)
+31 SET BGPDESGP=BGPXX2
+32 KILL ^TMP($JOB)
+33 KILL BGPDELIM
+34 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:$GET(IOSL))
+35 SET ^TMP($JOB,"BGPDEL",0)=0
+36 SET BGPQUIT=""
+37 SET BGPPTYPE="D"
+38 SET BGPQHDR=0
+39 IF $DATA(IOF)
WRITE @IOF
+40 DO ^BGP4DH
+41 IF BGPQHDR
SET BGPQUIT=1
DO KITM
QUIT
+42 SET BGPGPG=0
+43 SET BGPQUIT=""
+44 DO PRINT1
+45 ;D ^BGP4PDL ;create ^tmp of delimited report
DO SAVEDEL^BGP4PDL
+46 SET BGPIFTR=1
+47 KILL ^XTMP("BGP4D",BGPJ,BGPH)
+48 KILL ^XTMP("BGP4DNP",BGPJ,BGPH)
+49 KILL ^XTMP("BGP28CPL",BGPJ,BGPH)
+50 KILL ^TMP($JOB)
+51 QUIT
End DoDot:2
End DoDot:1
QUIT
PRINTN ;EP
+1 KILL ^TMP($JOB)
+2 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:$GET(IOSL))
+3 SET BGPQUIT=""
+4 SET ^TMP($JOB,"BGPDEL",0)=0
+5 SET BGPIFTR=""
+6 IF BGPROT="D"
GOTO DEL
+7 SET BGPPTYPE="P"
+8 SET BGPQHDR=0
+9 ;LORI
DO ^BGP4DH
+10 IF BGPQHDR
DO KITM
QUIT
+11 SET BGPGPG=0
+12 SET BGPQUIT=""
+13 DO PRINT1
+14 KILL ^TMP($JOB)
+15 IF BGPROT="P"
DO KITM
QUIT
+16 ;
DEL ;create delimited output file
+1 ;close printer device
IF '$DATA(BGPGUI)
DO ^%ZISC
+2 KILL ^TMP($JOB)
+3 SET ^TMP($JOB,"BGPDEL",0)=0
+4 SET BGPQHDR=0
+5 SET BGPPTYPE="D"
+6 DO ^BGP4DH
+7 SET BGPGPG=0
+8 SET BGPQUIT=""
+9 DO PRINT1
+10 ;D ^BGP4PDL ;create ^tmp of delimited report
DO SAVEDEL^BGP4PDL
+11 SET BGPIFTR=1
+12 KILL ^XTMP("BGP4D",BGPJ,BGPH)
+13 KILL ^XTMP("BGP4DNP",BGPJ,BGPH)
+14 KILL ^XTMP("BGP28CPL",BGPJ,BGPH)
+15 KILL ^TMP($JOB)
+16 QUIT
W(V,C,F,M,P,T) ;EP
+1 IF $GET(F)=""
SET F=1
+2 IF $GET(C)=""
SET C=0
+3 IF $GET(P)=""
SET P=1
+4 IF $GET(T)=""
SET T=0
+5 IF M="P"
Begin DoDot:1
+6 ;I $Y>(BGPIOSL-2) D EOP W:$D(IOF) @IOF
+7 NEW X
+8 FOR X=1:1:F
WRITE !
+9 IF C
WRITE $$CJ^XLFSTR(V,80)
+10 IF 'C
WRITE ?T,V
End DoDot:1
QUIT
+11 ;set up array
+12 IF '$GET(F)
SET F=0
+13 NEW %,Z
+14 SET Z=""
+15 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)
+16 FOR Z=1:1:F
SET %=%+1
SET ^TMP($JOB,"BGPDEL",%)=""
+17 SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
+18 IF '$DATA(^TMP($JOB,"BGPDEL",%))
SET ^TMP($JOB,"BGPDEL",%)=""
+19 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=V
+20 QUIT
+21 ;
WTITLE(I) ;EP - write title line
+1 NEW T,X,Y,S
+2 SET T=$PIECE(^BGPINDJ(I,0),U,3)
+3 ; W !,T,! Q
IF BGPPTYPE="P"
IF $LENGTH(T)<81
DO W(T,0,1,BGPPTYPE)
DO W("",0,1,BGPPTYPE)
QUIT
+4 IF BGPPTYPE="D"
DO W(T,0,1,BGPPTYPE)
DO W("",0,1,BGPPTYPE)
QUIT
+5 FOR X=$EXTRACT(T,1,80)
+6 SET S=""
+7 FOR Y=80:-1:1
IF S
QUIT
SET I=$EXTRACT(X,Y)
IF I=" "
SET S=Y
+8 ;W !,$E(T,1,S)
DO W^BGP4DP($EXTRACT(T,1,S),0,1,BGPPTYPE)
+9 ;W !,$E(T,(S+1),$L(T)),!
DO W^BGP4DP($EXTRACT(T,(S+1),$LENGTH(T)),0,1,BGPPTYPE)
DO W("",0,1,BGPPTYPE)
+10 QUIT
ANYDEV() ;
+1 NEW X,G,Y
+2 SET G=0
+3 SET X=0
FOR
SET X=$ORDER(BGPINDL(X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(BGPINDL(X,Y))
IF Y'=+Y
QUIT
IF $PIECE(^BGPNPLJ(Y,0),U,7)=9
SET G=1
+4 QUIT G
ALLDEV() ;
+1 NEW X,G,Y
+2 SET G=1
+3 SET X=0
FOR
SET X=$ORDER(BGPINDL(X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(BGPINDL(X,Y))
IF Y'=+Y
QUIT
IF $PIECE(^BGPNPLJ(Y,0),U,7)=1
SET G=0
+4 QUIT G
PRINT1 ;EP
+1 ;if in NGR or GPU now print gpra dev measures and divider page
+2 NEW BGPPC,BGPORD
+3 IF BGPPTYPE="P"
DO HEADER^BGP4DPH
+4 DO W^BGP4DP($SELECT($GET(BGPAREAA):"AREA AGGREGATE ",1:"")_"Dashboard Report - "_$PIECE(^DIC(4,$SELECT($GET(BGPISITE):BGPISITE,1:DUZ(2)),0),U,1),1,2,BGPPTYPE)
+5 DO W^BGP4DP(" ",0,1,BGPPTYPE)
+6 DO COLHDR
+7 SET BGPORD=0
+8 SET Y=$ORDER(^BGPCTRL("B",2014,0))
+9 SET Y=$PIECE(^BGPCTRL(Y,0),U,8)
+10 SET BGPPERY=$$FMDIFF^XLFDT(DT,Y)
+11 SET BGPPERY=BGPPERY/365
SET BGPPERY=BGPPERY*100
SET BGPPERY=BGPPERY+.5
SET BGPPERY=$JUSTIFY(BGPPERY,3,0)
SET BGPPERY=$$STRIP^XLFSTR(BGPPERY," ")
+12 FOR
SET BGPORD=$ORDER(^BGPINDJC("ADASH",BGPORD))
IF BGPORD'=+BGPORD!(BGPQUIT)
QUIT
Begin DoDot:1
+13 SET BGPPC=0
FOR
SET BGPPC=$ORDER(^BGPINDJC("ADASH",BGPORD,BGPPC))
IF BGPPC'=+BGPPC!(BGPQUIT)
QUIT
Begin DoDot:2
+14 ;GET VALUES FOR PREVIOUS YEAR, CURRENT YEAR, GET DENOM VALUE FOR 2014
+15 SET BGPDF=$PIECE(^BGPINDJC(BGPPC,0),U,8)
+16 ;get denom value
+17 SET BGPNP=$PIECE(^DD(90552.03,BGPDF,0),U,4)
SET N=$PIECE(BGPNP,";")
SET P=$PIECE(BGPNP,";",2)
+18 SET BGPCYD=$$V^BGP4DP1C(1,BGPRPT,N,P,1,1)
+19 SET BGPPRD=$$V^BGP4DP1C(2,BGPRPT,N,P,1,1)
+20 ;get numerator values
+21 SET BGPNF=$PIECE(^BGPINDJC(BGPPC,0),U,9)
+22 SET BGPNP=$PIECE(^DD(90552.03,BGPNF,0),U,4)
SET N=$PIECE(BGPNP,";")
SET P=$PIECE(BGPNP,";",2)
+23 DO SETN
+24 ;now figure out out # needed and on track status
+25 IF '$PIECE($GET(^BGPINDJC(BGPPC,23)),U,3)
Begin DoDot:3
+26 SET BGPGOAL=""
SET BGPGOAL=$PIECE($GET(^BGPINDJC(BGPPC,14)),U,8)
+27 IF BGPGOAL'="Baseline"
SET BGPGOAL=+BGPGOAL
+28 SET BGPNEG=$PIECE($GET(^BGPINDJC(BGPPC,23)),U,5)
+29 IF BGPGOAL="Baseline"
SET BGPNEED="N/A"
SET BGPOT="N/A"
QUIT
+30 SET BGPOT=""
+31 SET BGPGG=BGPGOAL/100
+32 SET BGPNEED1=BGPGG*BGPCYD
SET BGPNEED1=BGPNEED1+.9
SET BGPNEED1=$PIECE(BGPNEED1,".")
+33 SET BGPCYPER=BGPCYP/100
+34 ;;;
SET BGPNEED2=BGPCYPER*BGPCYD
SET BGPNEED2=BGPNEED2+.9
SET BGPNEED2=$PIECE(BGPNEED2,".")
+35 SET BGPNEED=BGPNEED1-BGPNEED2
+36 IF BGPNEG
SET BGPNEED=BGPNEED2-BGPNEED1
+37 ;S BGPNEED=BGPNEED+.5,BGPNEED=$P(BGPNEED,".",1)
+38 IF BGPGG
SET BGPCOLG=BGPCYPER/BGPGG
SET BGPCOLG=BGPCOLG*100
IF 1
+39 IF '$TEST
SET BGPCOLG=0.0
+40 IF 'BGPNEG
IF BGPCOLG'<100
SET BGPOT="ON TRACK"
QUIT
+41 IF BGPNEG
IF BGPCOLG'>100
SET BGPOT="ON TRACK"
QUIT
+42 IF 'BGPNEG
IF BGPCOLG'<BGPPERY
SET BGPOT="WITHIN RANGE"
QUIT
+43 IF BGPNEG
IF BGPCOLG'>BGPPERY
SET BGPOT="WITHIN RANGE"
QUIT
+44 SET BGPOT="NOT ON TRACK"
End DoDot:3
+45 IF $PIECE($GET(^BGPINDJC(BGPPC,23)),U,3)
Begin DoDot:3
+46 SET BGPGOAL=""
SET BGPGOAL=$PIECE($GET(^BGPINDJC(BGPPC,14)),U,8)
+47 IF BGPGOAL'="Baseline"
SET BGPGOAL=+BGPGOAL
+48 SET BGPNEG=$PIECE($GET(^BGPINDJC(BGPPC,23)),U,5)
+49 IF BGPGOAL="Baseline"
SET BGPNEED="N/A"
SET BGPOT="N/A"
QUIT
+50 SET BGPOT=""
+51 SET BGPGP=$PIECE($GET(^BGPINDJC(BGPPC,23)),U,4)
+52 SET BGPGG=BGPGP/100
+53 ;S BGPNGA=BGPGG*BGPPRN
+54 SET BGPTN=BGPPRN*(1+BGPGG)
+55 SET BGPTN=BGPTN+.9
SET BGPTN=$PIECE(BGPTN,".")
+56 SET BGPNEED=BGPTN-BGPCYN
+57 IF BGPNEED<1
SET BGPOT="ON TRACK"
QUIT
+58 SET G=BGPCYN/BGPTN
+59 IF G'<BGPPERY
SET BGPOT="WITHIN RANGE"
QUIT
+60 SET BGPOT="NOT ON TRACK"
End DoDot:3
N ;write out values for this measure
+1 IF BGPPTYPE="P"
IF $Y>(IOSL-4)
DO HEADER^BGP4DPH
IF BGPQUIT
QUIT
DO COLHDR
+2 IF $PIECE($GET(^BGPINDJC(BGPPC,23)),U,1)
DO W^BGP4DP(" ",0,1,BGPPTYPE)
+3 DO W^BGP4DP($PIECE($GET(^BGPINDJC(BGPPC,23)),U,2),0,1,BGPPTYPE,1,0)
+4 IF $PIECE($GET(^BGPINDJC(BGPPC,23)),U,6)]""
DO W^BGP4DP($PIECE($GET(^BGPINDJC(BGPPC,23)),U,6),0,1,BGPPTYPE,1,0)
+5 IF BGPPTYPE="D"
Begin DoDot:3
+6 DO W^BGP4DP($SELECT('$PIECE(^BGPINDJC(BGPPC,23),U,3):BGPGOAL,1:+BGPTN),0,0,BGPPTYPE,2,30)
+7 IF '$PIECE(^BGPINDJC(BGPPC,23),U,3)
Begin DoDot:4
+8 DO W^BGP4DP($SELECT(BGPPTYPE="D":$$SB($JUSTIFY(BGPPRP,5,1)),1:$JUSTIFY(BGPPRP,5,1)),0,0,BGPPTYPE,3,39)
+9 DO W^BGP4DP(BGPCYN,0,0,BGPPTYPE,4,47)
+10 DO W^BGP4DP(BGPCYD,0,0,BGPPTYPE,5,55)
+11 DO W^BGP4DP($SELECT(BGPPTYPE="D":$$SB($JUSTIFY(BGPCYP,5,1)),1:$JUSTIFY(BGPCYP,5,1)),0,0,BGPPTYPE,6,47)
+12 DO W^BGP4DP($SELECT(BGPNEED="N/A":BGPNEED,BGPNEED>0:BGPNEED,1:0),0,0,BGPPTYPE,7,65)
End DoDot:4
+13 IF $PIECE(^BGPINDJC(BGPPC,23),U,3)
Begin DoDot:4
+14 DO W^BGP4DP($SELECT(BGPPTYPE="D":BGPPRN,1:BGPPRN),0,0,BGPPTYPE,3,39)
+15 DO W^BGP4DP($SELECT(BGPPTYPE="D":BGPCYN,1:BGPCYN),0,0,BGPPTYPE,4,47)
+16 DO W^BGP4DP(BGPCYN,0,0,BGPPTYPE,6,55)
+17 DO W^BGP4DP($SELECT(BGPNEED="N/A":BGPNEED,BGPNEED>0:BGPNEED,1:0),0,0,BGPPTYPE,7,65)
End DoDot:4
+18 ;D W^BGP4DP(BGPOT,0,0,BGPPTYPE,8,75)
End DoDot:3
+19 IF BGPPTYPE="P"
Begin DoDot:3
+20 DO W^BGP4DP($SELECT('$PIECE(^BGPINDJC(BGPPC,23),U,3):$JUSTIFY(BGPGOAL,8),1:$$LBLK(+BGPTN,7)),0,0,BGPPTYPE,2,28)
+21 IF '$PIECE(^BGPINDJC(BGPPC,23),U,3)
Begin DoDot:4
+22 DO W^BGP4DP($SELECT(BGPPTYPE="D":$$SB($JUSTIFY(BGPPRP,5,1)),1:$JUSTIFY(BGPPRP,5,1)),0,0,BGPPTYPE,3,40)
+23 DO W^BGP4DP($$C(BGPCYN,0,8),0,0,BGPPTYPE,4,50)
+24 DO W^BGP4DP($$C(BGPCYD,0,8),0,0,BGPPTYPE,5,60)
+25 DO W^BGP4DP($SELECT(BGPPTYPE="D":$$SB($JUSTIFY(BGPCYP,5,1)),1:$JUSTIFY(BGPCYP,5,1)),0,0,BGPPTYPE,6,70)
+26 DO W^BGP4DP("# Needed to Achieve Target: "_$SELECT(BGPNEED="N/A":BGPNEED,BGPNEED>0:$SELECT(BGPNEG:"-",1:"")_BGPNEED,1:0),0,1,BGPPTYPE,0,5)
End DoDot:4
+27 IF $PIECE(^BGPINDJC(BGPPC,23),U,3)
Begin DoDot:4
+28 DO W^BGP4DP($SELECT(BGPPTYPE="D":BGPPRN,1:$$C(BGPPRN,0,8)),0,0,BGPPTYPE,3,40)
+29 DO W^BGP4DP($SELECT(BGPPTYPE="D":BGPCYN,1:$$C(BGPCYN,0,8)),0,0,BGPPTYPE,4,50)
+30 DO W^BGP4DP(BGPCYN,0,0,BGPPTYPE,7,70)
+31 DO W^BGP4DP("# Needed to Achieve Target: "_$SELECT(BGPNEED="N/A":BGPNEED,BGPNEED>0:BGPNEED,1:0),0,1,BGPPTYPE,,5)
End DoDot:4
+32 ;D W^BGP4DP(BGPOT,0,0,BGPPTYPE,0,40)
End DoDot:3
+33 DO W^BGP4DP(" ",0,1,BGPPTYPE)
End DoDot:2
End DoDot:1
+34 IF BGPPTYPE="P"
DO W^BGP4DP("*Results reflect services provided as of the date this report was run or the ",0,1,BGPPTYPE)
DO W^BGP4DP("report period end date, whichever is earlier",0,1,BGPPTYPE)
+35 IF BGPPTYPE="D"
DO W^BGP4DP("*Results reflect services provided as of the date this report was run or the report period end date, whichever is earlier",0,1,BGPPTYPE)
+36 DO W^BGP4DP(" ",0,1,BGPPTYPE)
+37 QUIT
SETN ;EP - set numerator fields
+1 SET BGPCYN=$$V^BGP4DP1C(1,BGPRPT,N,P,2)
+2 SET BGPPRN=$$V^BGP4DP1C(2,BGPRPT,N,P,2)
+3 SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"0.0")
+4 SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"0.0")
+5 QUIT
COLHDR ;
+1 IF BGPPTYPE="D"
Begin DoDot:1
+2 IF '$GET(BGPAREAA)
DO W^BGP4DP("National 2014 Target",0,1,BGPPTYPE,2)
+3 IF $GET(BGPAREAA)
DO W^BGP4DP("National 2014 Target",0,1,BGPPTYPE,2)
+4 DO W^BGP4DP($$FMTE^XLFDT(BGPDASHP)_" Final",0,0,BGPPTYPE,3)
+5 DO W^BGP4DP("Numerator",0,0,BGPPTYPE,4)
+6 DO W^BGP4DP("Denominator",0,0,BGPPTYPE,5)
+7 DO W^BGP4DP($$FMTE^XLFDT(BGPDASHY)_"*",0,0,BGPPTYPE,6)
+8 DO W^BGP4DP("# Needed to Achieve Target",0,0,BGPPTYPE,7)
+9 ;
End DoDot:1
QUIT
+10 DO W^BGP4DP("National"_$SELECT('$GET(BGPAREAA):"",1:""),0,1,BGPPTYPE,2,30)
+11 DO W^BGP4DP(2014,0,1,BGPPTYPE,2,30)
+12 DO W^BGP4DP($$FMTE^XLFDT(BGPDASHP),0,0,BGPPTYPE,3,40)
+13 DO W^BGP4DP("Denom-",0,0,BGPPTYPE,,60)
+14 DO W^BGP4DP($$FMTE^XLFDT(BGPDASHY)_"*",0,0,BGPPTYPE,,70)
+15 DO W^BGP4DP("Target",0,1,BGPPTYPE,,30)
+16 DO W^BGP4DP("Final",0,0,BGPPTYPE,,40)
+17 DO W^BGP4DP("Numerator",0,0,BGPPTYPE,,50)
+18 DO W^BGP4DP("inator",0,0,BGPPTYPE,,60)
+19 DO W^BGP4DP("(Current)",0,0,BGPPTYPE,,70)
+20 DO W^BGP4DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+21 QUIT
WP ;
+1 KILL ^UTILITY($JOB,"W")
+2 SET BGPZ=0
SET BGPLCNT=0
+3 SET DIWL=1
SET DIWR=80
SET DIWF=""
SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDJ(BGPIC,BGPNODE,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:1
+4 SET BGPLCNT=BGPLCNT+1
+5 SET X=^BGPINDJ(BGPIC,BGPNODE,BGPY,1,BGPZ,0)
IF BGPLCNT=1
SET X=" - "_X
DO ^DIWP
+6 QUIT
End DoDot:1
WPS ;
+1 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
Begin DoDot:1
+2 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGP4DPH
IF BGPQUIT
QUIT
+3 DO W^BGP4DP(^UTILITY($JOB,"W",DIWL,Z,0),0,1,BGPPTYPE)
End DoDot:1
+4 KILL DIWL,DIWR,DIWF,Z
+5 KILL ^UTILITY($JOB,"W"),X
+6 QUIT
PRINT2 ;
+1 QUIT
KITM ;
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("BGP4D",BGPJ,BGPH)
+3 KILL ^XTMP("BGP4DNP",BGPJ,BGPH)
+4 KILL ^XTMP("BGP28CPL",BGPJ,BGPH)
+5 QUIT
EXIT ;
+1 IF BGPPTYPE'="P"
QUIT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
SET DIR("A")="End of report. Press ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
SB(X) ;EP - Strip leading and trailing blanks from X.
+1 NEW %
+2 XECUTE ^DD("FUNC",$ORDER(^DD("FUNC","B","STRIPBLANKS",0)),1)
+3 QUIT X
AREA ;EP - AREA DASHBOARD PRINT
+1 KILL ^TMP($JOB)
+2 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:IOSL)
+3 SET BGPGPG=0
+4 SET BGPQUIT=""
+5 SET BGPIFTR=""
+6 SET ^TMP($JOB,"BGPDEL",0)=0
+7 SET BGPPTYPE="P"
+8 IF BGPROT="D"
GOTO DELA
+9 DO AREACP^BGP4DH1
+10 SET BGPQUIT=""
SET BGPGPG=0
SET BGPRPT=0
+11 DO PRINT1
+12 IF BGPQUIT
QUIT
+13 IF $GET(BGPAREAA)
KILL BGPAREAA
DO INDSITE
SET BGPAREAA=1
+14 SET BGPIFTR=1
+15 IF BGPROT="P"
QUIT
DELA ;create delimited output file
+1 SET BGPQUIT=""
SET BGPGPG=0
SET BGPRPT=0
SET BGPIFTR=""
+2 ;close printer device
DO ^%ZISC
+3 KILL ^TMP($JOB)
+4 ;D ^BGP4PDL ;create ^tmp of delimited report
+5 SET ^TMP($JOB,"BGPDEL",0)=0
+6 SET BGPPTYPE="D"
SET BGPQUIT=0
+7 DO AREACP^BGP4DH
+8 SET BGPQUIT=""
SET BGPGPG=0
SET BGPRPT=0
+9 DO PRINT1
+10 IF $GET(BGPAREAA)
KILL BGPAREAA
DO INDSITE
SET BGPAREAA=1
+11 ;D ^BGP4PDL ;create ^tmp of delimited report
DO SAVEDEL^BGP4PDL
+12 SET BGPIFTR=1
+13 KILL ^TMP($JOB)
+14 QUIT
INDSITE ;
+1 SET BGPRPT=0
FOR
SET BGPRPT=$ORDER(BGPSUL(BGPRPT))
IF BGPRPT'=+BGPRPT!(BGPQUIT)
QUIT
Begin DoDot:1
+2 SET BGPISITE=$PIECE(^BGPGPDCJ(BGPRPT,0),U,9)
SET BGPISITE=$ORDER(^AUTTLOC("C",BGPISITE,0))
+3 DO PRINT1
+4 QUIT
End DoDot:1
+5 QUIT
LBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=" "_V
+3 QUIT V
