APCLPP2P ; IHS/CMI/LAB - provider profile print ;
;;2.0;IHS PCC SUITE;**2,7,10,11**;MAY 14, 2009;Build 58
;
;cmi/anch/maw 9/10/2007 code set versioning in PV
;
START ;
S APCLPG=0,APCLQUIT=""
S APCLNITM=$S(APCLLSV="S":5,1:10)
S APCLPRV=0 F S APCLPRV=$O(APCLPROV(APCLPRV)) Q:APCLPRV'=+APCLPRV!(APCLQUIT) D PRN
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLPP2",APCLJOB,APCLBTH)
K APCLQUIT
Q
PRN ;
D HEAD Q:APCLQUIT
W !,"1 - Designated Primary Care Provider Panel",!
W !,"You are the Designated Primary Care Provider for ",$$C(APCLDPPT(APCLPRV),0)," patients. In this"
W !,"time period you have provided services (any type) to ",$$C(APCLDPPS(APCLPRV),0)," (",$$PER(APCLDPPS(APCLPRV),APCLDPPT(APCLPRV)),") patients"
W !,"from your Designated Primary Care Provider Panel."
W !!,"In this time period, you provided ambulatory services at least twice to ",$$C(APCLDP2V(APCLPRV),0)
W !,"patients who have no Designated Primary Care Provider identified."
W !!,"2 - Demographics and Workload for All Patients Served (Any Type of Service)"
I $Y>(IOSL-4) D HEAD Q:APCLQUIT
W !!,"In this time period you have provided services (any type) to ",$$C(APCLDW1(APCLPRV),0)," patients. "
W !,$$C(APCLDW2(APCLPRV),0)," (",$$PER(APCLDW2(APCLPRV),APCLDW1(APCLPRV)),") are from your Designated Primary Provider Panel. ",$$C(APCLDW3(APCLPRV),0)," (",$$PER(APCLDW3(APCLPRV),APCLDW1(APCLPRV)),") are"
I $Y>(IOSL-4) D HEAD Q:APCLQUIT
I $Y>(IOSL-4) D HEAD Q:APCLQUIT
W !,"not from your Designated Primary Care Provider Panel."
I $Y>(IOSL-4) D HEAD Q:APCLQUIT
W !!,$$PER(APCLDW4(APCLPRV),APCLDW1(APCLPRV))," of your patients were Male, ",$$PER(APCLDW5(APCLPRV),APCLDW1(APCLPRV))," Female, and ",$$PER(APCLDW51(APCLPRV),APCLDW1(APCLPRV))," Unknown Gender."
I $Y>(IOSL-4) D HEAD Q:APCLQUIT
W !!,$$PER(APCLDW6(APCLPRV),APCLDW1(APCLPRV))," were 18 and under; ",$$PER(APCLDW7(APCLPRV),APCLDW1(APCLPRV))," were 19-49; "
W $$PER(APCLDW8(APCLPRV),APCLDW1(APCLPRV))," were 50-64; and ",$$PER(APCLDW9(APCLPRV),APCLDW1(APCLPRV))," were 65 and over."
I $Y>(IOSL-3) D HEAD Q:APCLQUIT
COMM ;communities
I $Y>(IOSL-APCLNITM) D HEAD Q:APCLQUIT
K APCLDISP F X=1:1:APCLNITM S APCLDISP(X)=""
W !!,"The leading residences for your ",?40,"The leading tribes represented",!,"patients are:",?40,"among your patients are:"
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","COMMC",APCLX)) Q:APCLX'=+APCLX!(APCLC>4)!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","COMMC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","COMMC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..S Z=$$PER(APCLA,APCLDW1(APCLPRV))
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..S $P(APCLDISP(APCLC),U)=$E(APCLY,1,20)_U_APCLB_U_Z
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","TRIBEC",APCLX)) Q:APCLX'=+APCLX!(APCLC>4)!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","TRIBEC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","TRIBEC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..S Z=$$PER(APCLA,APCLDW1(APCLPRV))
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..S $P(APCLDISP(APCLC),U,4)=$E(APCLY,1,22)_U_APCLB_U_Z
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 ?22,$$PAD($P(APCLDISP(APCLX),U,2),6),?29,$J($P(APCLDISP(APCLX),U,3),4,0),"%"
.W ?41,$P(APCLDISP(APCLX),U,4) I $P(APCLDISP(APCLX),U,5)]"" W ?66,$$PAD($P(APCLDISP(APCLX),U,5),6),?73,$J($P(APCLDISP(APCLX),U,6),4,0),"%"
Q:APCLQUIT
W !!,"Of these services, ",$$C(APCLTCR(APCLPRV),0)," (",$$PER(APCLTCR(APCLPRV),APCLDW1(APCLPRV))
W ") were chart reviews and ",$$C(APCLTTEL(APCLPRV),0)," (",$$PER(APCLTTEL(APCLPRV),APCLDW1(APCLPRV)),") were",!,"telecommunications services."
I $Y>(IOSL-4) D HEAD Q:APCLQUIT
AMB ;
W !!,"3 - Ambulatory Workload: You had a total of ",$$C(APCLDW10(APCLPRV),0)," ambulatory visits during",!
W "this time period. You were the Primary Provider for ",$$C(APCLDW11(APCLPRV),0)," visits (",$$PER(APCLDW11(APCLPRV),APCLDW10(APCLPRV)),") and"
W !,"Secondary Provider for ",$$C(APCLDW12(APCLPRV),0)," visits (",$$PER(APCLDW12(APCLPRV),APCLDW10(APCLPRV)),")."
LOCSC ;
I $Y>(IOSL-8) D HEAD Q:APCLQUIT
W !!,"Your services were provided at the",?40,"Your services included the following",!,"following locations:",?40,"Service Categories:"
K APCLDISP F X=1:1:APCLNITM S APCLDISP(X)=""
;tally up top 4 locations and other.
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX)) Q:APCLX'=+APCLX!(APCLC>3)!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT)!(APCLC>3) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY)
..K ^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..S Z=$$PER(APCLA,APCLDW10(APCLPRV))
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..S $P(APCLDISP(APCLC),U)=$E(APCLY,1,20)_U_APCLB_U_Z
S APCLTOTH="",APCLX=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX)) Q:APCLX'=+APCLX D
.S APCLY=0 F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY)) Q:APCLY=""!(APCLY>3) S APCLTOTH(APCLPRV)=APCLTOTH(APCLPRV)+^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY)
I APCLTOTH(APCLPRV) S APCLDISP(5)="OTHER"_U_$$C(APCLTOTH(APCLPRV),0)_U_$$PER(APCLTOTH(APCLPRV),APCLDW10(APCLPRV))
SC ;
S (APCLX,APCLC)=0 F S APCLX=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SCC",APCLX)) Q:APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SCC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SCC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..S Z=$$PER(APCLA,APCLDW10(APCLPRV))
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..S $P(APCLDISP(APCLC),U,4)=$E(APCLY,1,22)_U_APCLB_U_Z
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 ?22,$$PAD($P(APCLDISP(APCLX),U,2),6),?29,$J($P(APCLDISP(APCLX),U,3),4,0),"%"
.W ?41,$P(APCLDISP(APCLX),U,4) I $P(APCLDISP(APCLX),U,5)]"" W ?66,$$PAD($P(APCLDISP(APCLX),U,5),6),?73,$J($P(APCLDISP(APCLX),U,6),4,0),"%"
Q:APCLQUIT
PV ;
I $Y>(IOSL-APCLNITM) D HEAD Q:APCLQUIT
K APCLDISP F X=1:1:APCLNITM S APCLDISP(X)=""
W !!,"The ",APCLNITM," leading Purposes of Visit",?40,"The ",APCLNITM," leading Medications you"
W !,"(including Primary and Secondary POV's)",?40,"prescribed or refilled as Primary"
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","OUTDXC",APCLX)) Q:APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","OUTDXC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","OUTDXC",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","RXC",APCLX)) Q:APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT) D
.S APCLY="" F S APCLY=$O(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","RXC",APCLX,APCLY)) Q:APCLY=""!(APCLQUIT) D
..S APCLC=APCLC+1 S APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","RXC",APCLX,APCLY)
..S APCLB=$$C(APCLA,0)
..I '$D(APCLDISP(APCLC)) S APCLDISP(APCLC)=""
..S $P(APCLDISP(APCLC),U,4)=$E(APCLY,1,30)_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-APCLNITM) 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
D PROC^APCLPP2Q
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),!
I $G(APCLSEAT) W $$CTR("Search Template of Patients Used: "_$P(^DIBT(APCLSEAT,0),U)),!
I APCLEXCL W !,"** Please Note that certain diagnoses codes have been excluded",!,"from the list of purpose of visits.",!
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 APCLPRV.
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
;
APCLPP2P ; IHS/CMI/LAB - provider profile print ;
+1 ;;2.0;IHS PCC SUITE;**2,7,10,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;cmi/anch/maw 9/10/2007 code set versioning in PV
+4 ;
START ;
+1 SET APCLPG=0
SET APCLQUIT=""
+2 SET APCLNITM=$SELECT(APCLLSV="S":5,1:10)
+3 SET APCLPRV=0
FOR
SET APCLPRV=$ORDER(APCLPROV(APCLPRV))
IF APCLPRV'=+APCLPRV!(APCLQUIT)
QUIT
DO PRN
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLPP2",APCLJOB,APCLBTH)
+3 KILL APCLQUIT
+4 QUIT
PRN ;
+1 DO HEAD
IF APCLQUIT
QUIT
+2 WRITE !,"1 - Designated Primary Care Provider Panel",!
+3 WRITE !,"You are the Designated Primary Care Provider for ",$$C(APCLDPPT(APCLPRV),0)," patients. In this"
+4 WRITE !,"time period you have provided services (any type) to ",$$C(APCLDPPS(APCLPRV),0)," (",$$PER(APCLDPPS(APCLPRV),APCLDPPT(APCLPRV)),") patients"
+5 WRITE !,"from your Designated Primary Care Provider Panel."
+6 WRITE !!,"In this time period, you provided ambulatory services at least twice to ",$$C(APCLDP2V(APCLPRV),0)
+7 WRITE !,"patients who have no Designated Primary Care Provider identified."
+8 WRITE !!,"2 - Demographics and Workload for All Patients Served (Any Type of Service)"
+9 IF $Y>(IOSL-4)
DO HEAD
IF APCLQUIT
QUIT
+10 WRITE !!,"In this time period you have provided services (any type) to ",$$C(APCLDW1(APCLPRV),0)," patients. "
+11 WRITE !,$$C(APCLDW2(APCLPRV),0)," (",$$PER(APCLDW2(APCLPRV),APCLDW1(APCLPRV)),") are from your Designated Primary Provider Panel. ",$$C(APCLDW3(APCLPRV),0)," (",$$PER(APCLDW3(APCLPRV),APCLDW1(APCLPRV)),") are"
+12 IF $Y>(IOSL-4)
DO HEAD
IF APCLQUIT
QUIT
+13 IF $Y>(IOSL-4)
DO HEAD
IF APCLQUIT
QUIT
+14 WRITE !,"not from your Designated Primary Care Provider Panel."
+15 IF $Y>(IOSL-4)
DO HEAD
IF APCLQUIT
QUIT
+16 WRITE !!,$$PER(APCLDW4(APCLPRV),APCLDW1(APCLPRV))," of your patients were Male, ",$$PER(APCLDW5(APCLPRV),APCLDW1(APCLPRV))," Female, and ",$$PER(APCLDW51(APCLPRV),APCLDW1(APCLPRV))," Unknown Gender."
+17 IF $Y>(IOSL-4)
DO HEAD
IF APCLQUIT
QUIT
+18 WRITE !!,$$PER(APCLDW6(APCLPRV),APCLDW1(APCLPRV))," were 18 and under; ",$$PER(APCLDW7(APCLPRV),APCLDW1(APCLPRV))," were 19-49; "
+19 WRITE $$PER(APCLDW8(APCLPRV),APCLDW1(APCLPRV))," were 50-64; and ",$$PER(APCLDW9(APCLPRV),APCLDW1(APCLPRV))," were 65 and over."
+20 IF $Y>(IOSL-3)
DO HEAD
IF APCLQUIT
QUIT
COMM ;communities
+1 IF $Y>(IOSL-APCLNITM)
DO HEAD
IF APCLQUIT
QUIT
+2 KILL APCLDISP
FOR X=1:1:APCLNITM
SET APCLDISP(X)=""
+3 WRITE !!,"The leading residences for your ",?40,"The leading tribes represented",!,"patients are:",?40,"among your patients are:"
+4 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","COMMC",APCLX))
IF APCLX'=+APCLX!(APCLC>4)!(APCLQUIT)
QUIT
Begin DoDot:1
+5 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","COMMC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+6 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","COMMC",APCLX,APCLY)
+7 SET APCLB=$$C(APCLA,0)
+8 SET Z=$$PER(APCLA,APCLDW1(APCLPRV))
+9 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+10 SET $PIECE(APCLDISP(APCLC),U)=$EXTRACT(APCLY,1,20)_U_APCLB_U_Z
End DoDot:2
End DoDot:1
+11 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","TRIBEC",APCLX))
IF APCLX'=+APCLX!(APCLC>4)!(APCLQUIT)
QUIT
Begin DoDot:1
+12 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","TRIBEC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+13 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","TRIBEC",APCLX,APCLY)
+14 SET APCLB=$$C(APCLA,0)
+15 SET Z=$$PER(APCLA,APCLDW1(APCLPRV))
+16 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+17 SET $PIECE(APCLDISP(APCLC),U,4)=$EXTRACT(APCLY,1,22)_U_APCLB_U_Z
End DoDot:2
End DoDot:1
+18 IF $Y>(IOSL-4)
DO HEAD
IF APCLQUIT
QUIT
+19 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLDISP(APCLX))
IF APCLX'=+APCLX!(APCLX>APCLNITM)!(APCLQUIT)
QUIT
Begin DoDot:1
+20 IF $Y>(IOSL-3)
DO HEAD
IF APCLQUIT
QUIT
+21 WRITE !?1,$PIECE(APCLDISP(APCLX),U)
IF $PIECE(APCLDISP(APCLX),U,2)]""
WRITE ?22,$$PAD($PIECE(APCLDISP(APCLX),U,2),6),?29,$JUSTIFY($PIECE(APCLDISP(APCLX),U,3),4,0),"%"
+22 WRITE ?41,$PIECE(APCLDISP(APCLX),U,4)
IF $PIECE(APCLDISP(APCLX),U,5)]""
WRITE ?66,$$PAD($PIECE(APCLDISP(APCLX),U,5),6),?73,$JUSTIFY($PIECE(APCLDISP(APCLX),U,6),4,0),"%"
End DoDot:1
+23 IF APCLQUIT
QUIT
+24 WRITE !!,"Of these services, ",$$C(APCLTCR(APCLPRV),0)," (",$$PER(APCLTCR(APCLPRV),APCLDW1(APCLPRV))
+25 WRITE ") were chart reviews and ",$$C(APCLTTEL(APCLPRV),0)," (",$$PER(APCLTTEL(APCLPRV),APCLDW1(APCLPRV)),") were",!,"telecommunications services."
+26 IF $Y>(IOSL-4)
DO HEAD
IF APCLQUIT
QUIT
AMB ;
+1 WRITE !!,"3 - Ambulatory Workload: You had a total of ",$$C(APCLDW10(APCLPRV),0)," ambulatory visits during",!
+2 WRITE "this time period. You were the Primary Provider for ",$$C(APCLDW11(APCLPRV),0)," visits (",$$PER(APCLDW11(APCLPRV),APCLDW10(APCLPRV)),") and"
+3 WRITE !,"Secondary Provider for ",$$C(APCLDW12(APCLPRV),0)," visits (",$$PER(APCLDW12(APCLPRV),APCLDW10(APCLPRV)),")."
LOCSC ;
+1 IF $Y>(IOSL-8)
DO HEAD
IF APCLQUIT
QUIT
+2 WRITE !!,"Your services were provided at the",?40,"Your services included the following",!,"following locations:",?40,"Service Categories:"
+3 KILL APCLDISP
FOR X=1:1:APCLNITM
SET APCLDISP(X)=""
+4 ;tally up top 4 locations and other.
+5 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX))
IF APCLX'=+APCLX!(APCLC>3)!(APCLQUIT)
QUIT
Begin DoDot:1
+6 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)!(APCLC>3)
QUIT
Begin DoDot:2
+7 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY)
+8 KILL ^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY)
+9 SET APCLB=$$C(APCLA,0)
+10 SET Z=$$PER(APCLA,APCLDW10(APCLPRV))
+11 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+12 SET $PIECE(APCLDISP(APCLC),U)=$EXTRACT(APCLY,1,20)_U_APCLB_U_Z
End DoDot:2
End DoDot:1
+13 SET APCLTOTH=""
SET APCLX=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+14 SET APCLY=0
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY))
IF APCLY=""!(APCLY>3)
QUIT
SET APCLTOTH(APCLPRV)=APCLTOTH(APCLPRV)+^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","LOCC",APCLX,APCLY)
End DoDot:1
+15 IF APCLTOTH(APCLPRV)
SET APCLDISP(5)="OTHER"_U_$$C(APCLTOTH(APCLPRV),0)_U_$$PER(APCLTOTH(APCLPRV),APCLDW10(APCLPRV))
SC ;
+1 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SCC",APCLX))
IF APCLX'=+APCLX!(APCLC>(APCLNITM-1))!(APCLQUIT)
QUIT
Begin DoDot:1
+2 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SCC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+3 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","SCC",APCLX,APCLY)
+4 SET APCLB=$$C(APCLA,0)
+5 SET Z=$$PER(APCLA,APCLDW10(APCLPRV))
+6 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+7 SET $PIECE(APCLDISP(APCLC),U,4)=$EXTRACT(APCLY,1,22)_U_APCLB_U_Z
End DoDot:2
End DoDot:1
+8 IF $Y>(IOSL-APCLNITM)
DO HEAD
IF APCLQUIT
QUIT
+9 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLDISP(APCLX))
IF APCLX'=+APCLX!(APCLX>APCLNITM)!(APCLQUIT)
QUIT
Begin DoDot:1
+10 IF $Y>(IOSL-3)
DO HEAD
IF APCLQUIT
QUIT
+11 WRITE !?1,$PIECE(APCLDISP(APCLX),U)
IF $PIECE(APCLDISP(APCLX),U,2)]""
WRITE ?22,$$PAD($PIECE(APCLDISP(APCLX),U,2),6),?29,$JUSTIFY($PIECE(APCLDISP(APCLX),U,3),4,0),"%"
+12 WRITE ?41,$PIECE(APCLDISP(APCLX),U,4)
IF $PIECE(APCLDISP(APCLX),U,5)]""
WRITE ?66,$$PAD($PIECE(APCLDISP(APCLX),U,5),6),?73,$JUSTIFY($PIECE(APCLDISP(APCLX),U,6),4,0),"%"
End DoDot:1
+13 IF APCLQUIT
QUIT
PV ;
+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 Purposes of Visit",?40,"The ",APCLNITM," leading Medications you"
+4 WRITE !,"(including Primary and Secondary POV's)",?40,"prescribed or refilled as Primary"
+5 WRITE !,"that you identified were:",?40,"Provider for the Visit were:"
+6 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","OUTDXC",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","OUTDXC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+8 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","OUTDXC",APCLX,APCLY)
+9 SET APCLB=$$C(APCLA,0)
+10 IF '$DATA(APCLDISP(APCLC))
SET APCLDISP(APCLC)=""
+11 ;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
+12 ;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
+13 SET (APCLX,APCLC)=0
FOR
SET APCLX=$ORDER(^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","RXC",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","RXC",APCLX,APCLY))
IF APCLY=""!(APCLQUIT)
QUIT
Begin DoDot:2
+15 SET APCLC=APCLC+1
SET APCLA=^XTMP("APCLPP2",APCLJOB,APCLBTH,"RP",APCLPRV,"REPORT","RXC",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,30)_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-APCLNITM)
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
+25 DO PROC^APCLPP2Q
+26 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 IF $GET(APCLSEAT)
WRITE $$CTR("Search Template of Patients Used: "_$PIECE(^DIBT(APCLSEAT,0),U)),!
+7 IF APCLEXCL
WRITE !,"** Please Note that certain diagnoses codes have been excluded",!,"from the list of purpose of visits.",!
+8 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 APCLPRV.
+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 ;
