APCLPP2Q ; IHS/CMI/LAB - provider profile print ; 14 Apr 2014 12:33 PM
;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
;
;cmi/anch/maw 9/10/2007 code set versioning in PV,PROC,EM
;
PROC ;EP
I $Y>(IOSL-APCLNITM) D HEAD Q:APCLQUIT
K APCLDISP F X=1:1:APCLNITM S APCLDISP(X)=""
W !!,"The ",APCLNITM," leading Procedures that you",?40,"The ",APCLNITM," leading Education Topics that"
W !,"performed as Primary Provider ",?40,"you taught were:"
W !,"for the Visit were:"
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SURGPROCC",APCLX)) Q:APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SURGPROCC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SURGPROCC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..;S Z=$P(^ICD0(APCLY,0),U),$E(Z,8)=$E($P(^ICD0(APCLY,0),U,4),1,19),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 orig line
..S Z=$P($$ICDOP^ICDEX(APCLY,,,"I"),U,2),$E(Z,10)=$E($P($$ICDOP^ICDEX(APCLY,"","","I"),U,5),1,16),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 csv
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","PATEDC",APCLX)) Q:APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","PATEDC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","PATEDC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..S $P(APCLDISP(APCLC),U,4)=$E(APCLY,1,32)_U_APCLB
I $Y>(IOSL-APCLNITM) D HEAD Q:APCLQUIT
S APCLX=0 F S APCLX=$O(APCLDISP(APCLX)) Q:APCLX'=+APCLX!(APCLX>APCLNITM)!(APCLQUIT) D
.I $Y>(IOSL-3) D HEAD Q:APCLQUIT
.W !?1,$P(APCLDISP(APCLX),U) I $P(APCLDISP(APCLX),U,2)]"" W ?28,$$PAD($P(APCLDISP(APCLX),U,2),6)
.W ?41,$P(APCLDISP(APCLX),U,4) I $P(APCLDISP(APCLX),U,5)]"" W ?72,$$PAD($P(APCLDISP(APCLX),U,5),6)
Q:APCLQUIT
EM ;
I '$D(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","EMC")) G PV
I $Y>(IOSL-APCLNITM) D HEAD Q:APCLQUIT
K APCLDISP F X=1:1:APCLNITM S APCLDISP(X)=""
W !!,"The ",APCLNITM," Top Evaluation and Management CPT codes that you used as"
W !,"Primary Provider were:"
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","EMC",APCLX)) Q:APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","EMC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","EMC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..;S Z=$P(^ICPT(APCLY,0),U),$E(Z,8)=$E($P(^ICPT(APCLY,0),U,2),1,40),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 orig line
..S Z=$P($$CPT^ICPTCOD(APCLY),U,2),$E(Z,8)=$E($P($$CPT^ICPTCOD(APCLY),U,3),1,40),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 csv
I $Y>(IOSL-4) D HEAD Q:APCLQUIT
S APCLX=0 F S APCLX=$O(APCLDISP(APCLX)) Q:APCLX'=+APCLX!(APCLX>APCLNITM)!(APCLQUIT) D
.I $Y>(IOSL-3) D HEAD Q:APCLQUIT
.W !?1,$P(APCLDISP(APCLX),U) I $P(APCLDISP(APCLX),U,2)]"" W ?50,$$PAD($P(APCLDISP(APCLX),U,2),6)
Q:APCLQUIT
PV ;
I APCLDW13(APCLPRV)=0 G INHOSP
I $Y>(IOSL-5) D HEAD Q:APCLQUIT
W !!,"4 - Inpatient Workload: You were the Primary Provider for a total of ",$$C(APCLDW13(APCLPRV),0),!,"Hospitalizations during this time period."
K APCLDISP F X=1:1:5 S APCLDISP(X)=""
W !!,"The ",APCLNITM," leading Diagnoses (including",?40,"The ",APCLNITM," leading Procedures performed"
W !,"Primary and Secondary DX's) that",?40,"for visits on which you were"
W !,"that you identified were:",?40,"Provider for the Visit were:"
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTDXC",APCLX)) Q:APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTDXC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTDXC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..;S Z=$P(^ICD9(APCLY,0),U),$E(Z,8)=$E($P(^ICD9(APCLY,0),U,3),1,19),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/10/2007 orig line
..S Z=$P($$ICDDX^ICDEX(APCLY),U,2),$E(Z,10)=$E($P($$ICDDX^ICDEX(APCLY),U,4),1,16),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/10/2007 csv
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTSURGPROCC",APCLX)) Q:APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTSURGPROCC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTSURGPROCC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..;S Z=$P(^ICD0(APCLY,0),U),$E(Z,8)=$E($P(^ICD0(APCLY,0),U,4),1,19),$P(APCLDISP(APCLC),U,4)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 orig line
..S Z=$P($$ICDOP^ICDEX(APCLY,,,"I"),U,2),$E(Z,10)=$E($P($$ICDOP^ICDEX(APCLY,"","","I"),U,5),1,16),$P(APCLDISP(APCLC),U,4)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 csv
S APCLX=0 F S APCLX=$O(APCLDISP(APCLX)) Q:APCLX'=+APCLX!(APCLX>APCLNITM)!(APCLQUIT) D
.I $Y>(IOSL-3) D HEAD Q:APCLQUIT
.W !?1,$P(APCLDISP(APCLX),U) I $P(APCLDISP(APCLX),U,2)]"" W ?28,$$PAD($P(APCLDISP(APCLX),U,2),6)
.W ?41,$P(APCLDISP(APCLX),U,4) I $P(APCLDISP(APCLX),U,5)]"" W ?72,$$PAD($P(APCLDISP(APCLX),U,5),6)
INHOSP ;
W !!,"You made ",$$C(APCLDW14(APCLPRV),0)," In-Hospital Visits to patients hospitalized at your",!,"Service Unit's Hospital and ",$$C(APCLDW15(APCLPRV),0)," In-Hospital Visits to other sites."
Q
HEAD ;EP
G:'APCLPG HEAD1
K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT=1 Q
HEAD1 ;
I $D(IOF) W @IOF
S APCLPG=APCLPG+1
W !?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
W $$CTR("Provider Practice Description For "_APCLPRVN(APCLPRV)_", "_APCLPRVD(APCLPRV),80),!
W !?12,"For the Time Period: ",$$FMTE^XLFDT(APCLBD)," - ",$$FMTE^XLFDT(APCLED),!
Q
PER(N,D) ;return % of n/d
I 'D Q "0%"
NEW Z
S Z=N/D,Z=Z*100,Z=$J(Z,3,0)
Q $$STRIP^XLFSTR(Z," ")_"%"
C(X,X2,X3) ;
D COMMA^%DTC
Q $$STRIP^XLFSTR(X," ")
PAD(D,L) ; -- SUBRTN to pad length of data
; -- D=data L=length
S L=L-$L(D)
Q $E($$REPEAT^XLFSTR(" ",L),1,L)_D
;
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="End of Report. Press return",DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
;
APCLPP2Q ; IHS/CMI/LAB - provider profile print ; 14 Apr 2014 12:33 PM
+1 ;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;cmi/anch/maw 9/10/2007 code set versioning in PV,PROC,EM
+4 ;
PROC ;EP
+1 IF $Y>(IOSL-APCLNITM)
DO HEAD
IF APCLQUIT
QUIT
+2 KILL APCLDISP
FOR X=1:1:APCLNITM
SET APCLDISP(X)=""
+3 WRITE !!,"The ",APCLNITM," leading Procedures that you",?40,"The ",APCLNITM," leading Education Topics that"
+4 WRITE !,"performed as Primary Provider ",?40,"you taught were:"
+5 WRITE !,"for the Visit were:"
+6 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SURGPROCC",APCLX))
IF APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT)
QUIT
Begin DoDot:1
+7 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SURGPROCC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+8 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SURGPROCC",APCLX,APCLY)
+9 SET APCLB=$$C(APCLA,0)
+10 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+11 ;S Z=$P(^ICD0(APCLY,0),U),$E(Z,8)=$E($P(^ICD0(APCLY,0),U,4),1,19),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 orig line
+12 ;cmi/anch/maw 9/12/2007 csv
SET Z=$PIECE($$ICDOP^ICDEX(APCLY,,,"I"),U,2)
SET $EXTRACT(Z,10)=$EXTRACT($PIECE($$ICDOP^ICDEX(APCLY,"","","I"),U,5),1,16)
SET $PIECE(APCLDISP(APCLC),U)=Z_U_APCLB
End DoDot:2
End DoDot:1
+13 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","PATEDC",APCLX))
IF APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT)
QUIT
Begin DoDot:1
+14 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","PATEDC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+15 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","PATEDC",APCLX,APCLY)
+16 SET APCLB=$$C(APCLA,0)
+17 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+18 SET $PIECE(APCLDISP(APCLC),U,4)=$EXTRACT(APCLY,1,32)_U_APCLB
End DoDot:2
End DoDot:1
+19 IF $Y>(IOSL-APCLNITM)
DO HEAD
IF APCLQUIT
QUIT
+20 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLDISP(APCLX))
IF APCLX'=+APCLX!(APCLX>APCLNITM)!(APCLQUIT)
QUIT
Begin DoDot:1
+21 IF $Y>(IOSL-3)
DO HEAD
IF APCLQUIT
QUIT
+22 WRITE !?1,$PIECE(APCLDISP(APCLX),U)
IF $PIECE(APCLDISP(APCLX),U,2)]""
WRITE ?28,$$PAD($PIECE(APCLDISP(APCLX),U,2),6)
+23 WRITE ?41,$PIECE(APCLDISP(APCLX),U,4)
IF $PIECE(APCLDISP(APCLX),U,5)]""
WRITE ?72,$$PAD($PIECE(APCLDISP(APCLX),U,5),6)
End DoDot:1
+24 IF APCLQUIT
QUIT
EM ;
+1 IF '$DATA(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","EMC"))
GOTO PV
+2 IF $Y>(IOSL-APCLNITM)
DO HEAD
IF APCLQUIT
QUIT
+3 KILL APCLDISP
FOR X=1:1:APCLNITM
SET APCLDISP(X)=""
+4 WRITE !!,"The ",APCLNITM," Top Evaluation and Management CPT codes that you used as"
+5 WRITE !,"Primary Provider were:"
+6 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","EMC",APCLX))
IF APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT)
QUIT
Begin DoDot:1
+7 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","EMC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+8 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","EMC",APCLX,APCLY)
+9 SET APCLB=$$C(APCLA,0)
+10 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+11 ;S Z=$P(^ICPT(APCLY,0),U),$E(Z,8)=$E($P(^ICPT(APCLY,0),U,2),1,40),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 orig line
+12 ;cmi/anch/maw 9/12/2007 csv
SET Z=$PIECE($$CPT^ICPTCOD(APCLY),U,2)
SET $EXTRACT(Z,8)=$EXTRACT($PIECE($$CPT^ICPTCOD(APCLY),U,3),1,40)
SET $PIECE(APCLDISP(APCLC),U)=Z_U_APCLB
End DoDot:2
End DoDot:1
+13 IF $Y>(IOSL-4)
DO HEAD
IF APCLQUIT
QUIT
+14 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLDISP(APCLX))
IF APCLX'=+APCLX!(APCLX>APCLNITM)!(APCLQUIT)
QUIT
Begin DoDot:1
+15 IF $Y>(IOSL-3)
DO HEAD
IF APCLQUIT
QUIT
+16 WRITE !?1,$PIECE(APCLDISP(APCLX),U)
IF $PIECE(APCLDISP(APCLX),U,2)]""
WRITE ?50,$$PAD($PIECE(APCLDISP(APCLX),U,2),6)
End DoDot:1
+17 IF APCLQUIT
QUIT
PV ;
+1 IF APCLDW13(APCLPRV)=0
GOTO INHOSP
+2 IF $Y>(IOSL-5)
DO HEAD
IF APCLQUIT
QUIT
+3 WRITE !!,"4 - Inpatient Workload: You were the Primary Provider for a total of ",$$C(APCLDW13(APCLPRV),0),!,"Hospitalizations during this time period."
+4 KILL APCLDISP
FOR X=1:1:5
SET APCLDISP(X)=""
+5 WRITE !!,"The ",APCLNITM," leading Diagnoses (including",?40,"The ",APCLNITM," leading Procedures performed"
+6 WRITE !,"Primary and Secondary DX's) that",?40,"for visits on which you were"
+7 WRITE !,"that you identified were:",?40,"Provider for the Visit were:"
+8 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTDXC",APCLX))
IF APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT)
QUIT
Begin DoDot:1
+9 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTDXC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+10 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTDXC",APCLX,APCLY)
+11 SET APCLB=$$C(APCLA,0)
+12 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+13 ;S Z=$P(^ICD9(APCLY,0),U),$E(Z,8)=$E($P(^ICD9(APCLY,0),U,3),1,19),$P(APCLDISP(APCLC),U)=Z_U_APCLB ;cmi/anch/maw 9/10/2007 orig line
+14 ;cmi/anch/maw 9/10/2007 csv
SET Z=$PIECE($$ICDDX^ICDEX(APCLY),U,2)
SET $EXTRACT(Z,10)=$EXTRACT($PIECE($$ICDDX^ICDEX(APCLY),U,4),1,16)
SET $PIECE(APCLDISP(APCLC),U)=Z_U_APCLB
End DoDot:2
End DoDot:1
+15 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTSURGPROCC",APCLX))
IF APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT)
QUIT
Begin DoDot:1
+16 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTSURGPROCC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+17 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","INPTSURGPROCC",APCLX,APCLY)
+18 SET APCLB=$$C(APCLA,0)
+19 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+20 ;S Z=$P(^ICD0(APCLY,0),U),$E(Z,8)=$E($P(^ICD0(APCLY,0),U,4),1,19),$P(APCLDISP(APCLC),U,4)=Z_U_APCLB ;cmi/anch/maw 9/12/2007 orig line
+21 ;cmi/anch/maw 9/12/2007 csv
SET Z=$PIECE($$ICDOP^ICDEX(APCLY,,,"I"),U,2)
SET $EXTRACT(Z,10)=$EXTRACT($PIECE($$ICDOP^ICDEX(APCLY,"","","I"),U,5),1,16)
SET $PIECE(APCLDISP(APCLC),U,4)=Z_U_APCLB
End DoDot:2
End DoDot:1
+22 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLDISP(APCLX))
IF APCLX'=+APCLX!(APCLX>APCLNITM)!(APCLQUIT)
QUIT
Begin DoDot:1
+23 IF $Y>(IOSL-3)
DO HEAD
IF APCLQUIT
QUIT
+24 WRITE !?1,$PIECE(APCLDISP(APCLX),U)
IF $PIECE(APCLDISP(APCLX),U,2)]""
WRITE ?28,$$PAD($PIECE(APCLDISP(APCLX),U,2),6)
+25 WRITE ?41,$PIECE(APCLDISP(APCLX),U,4)
IF $PIECE(APCLDISP(APCLX),U,5)]""
WRITE ?72,$$PAD($PIECE(APCLDISP(APCLX),U,5),6)
End DoDot:1
INHOSP ;
+1 WRITE !!,"You made ",$$C(APCLDW14(APCLPRV),0)," In-Hospital Visits to patients hospitalized at your",!,"Service Unit's Hospital and ",$$C(APCLDW15(APCLPRV),0)," In-Hospital Visits to other sites."
+2 QUIT
HEAD ;EP
+1 IF 'APCLPG
GOTO HEAD1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=1
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 SET APCLPG=APCLPG+1
+3 WRITE !?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
+4 WRITE $$CTR("Provider Practice Description For "_APCLPRVN(APCLPRV)_", "_APCLPRVD(APCLPRV),80),!
+5 WRITE !?12,"For the Time Period: ",$$FMTE^XLFDT(APCLBD)," - ",$$FMTE^XLFDT(APCLED),!
+6 QUIT
PER(N,D) ;return % of n/d
+1 IF 'D
QUIT "0%"
+2 NEW Z
+3 SET Z=N/D
SET Z=Z*100
SET Z=$JUSTIFY(Z,3,0)
+4 QUIT $$STRIP^XLFSTR(Z," ")_"%"
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT $$STRIP^XLFSTR(X," ")
PAD(D,L) ; -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 SET L=L-$LENGTH(D)
+3 QUIT $EXTRACT($$REPEAT^XLFSTR(" ",L),1,L)_D
+4 ;
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="End of Report. Press return"
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
+3 ;
