APCLCPT1 ; IHS/CMI/LAB - list CPT CODES BY PROVIDER ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;EP
INFORM ;
W !,$$CTR($$USR)
W !,$$LOC()
W !!,$$CTR("TALLY OF CPT CODES BY PROVIDER",80)
W !!,"This report will tally the all CPT codes entered by provider."
W !,"You will be able to specify the date range; whether to include"
W !,"outpatient (ambulatory, day surgery, observation), inpatient visits"
W !,"or both; tally cpts codes by primary provider only or primary"
W !,"and secondary provider; and whether to include only visits to"
W !,"one facility, a service unit or to patients who are members"
W !,"of a particular tribe."
W !!,"PLEASE NOTE: If you choose both primary and secondary providers"
W !," the following logic will be applied:"
W !," If you use the CPE mnemonic or the CPT code is entered"
W !," through EHR the CPT code will be linked to the encounter"
W !," provider documented. If there is no encounter provider"
W !," documented then the CPT code will be tallied under each"
W !," provider on that visit thus the counts will include the"
W !," same CPT code multiple times."
W !
D EOJ
DATES K APCLED,APCLBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
D ^DIR Q:Y<1 S APCLBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
D ^DIR Q:Y<1 S APCLED=Y
;
I APCLED<APCLBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
;
PS ;
S APCLPRIM=""
S DIR(0)="SO^P:Primary Provider Only;A:All Providers (Primary and Secondary)",DIR("A")="Report should include"
S DIR("?")="If you wish to count only the primary provider of service enter a 'P'. To include ALL providers enter an 'A'." D ^DIR K DIR
G:$D(DIRUT) DATES
S APCLPRIM=Y
SC ;
S APCLOI=""
S DIR(0)="SO^O:Outpatient Visits (ambulatory, day surgery, observation);I:Inpatient;B:Both",DIR("A")="Report should include",DIR("B")="B"
S DIR("?")="If you wish to count only the primary provider of service enter a 'P'. To include ALL providers enter an 'A'." D ^DIR K DIR
G:$D(DIRUT) PS
S APCLOI=Y
FAC ;
S APCLLOCT=""
S DIR(0)="S^S:One Service Unit;L:One Location/Facility;T:One Tribe;A:All visits",DIR("A")="Include Visits to"
S DIR("A")="Enter a code indicating which visits are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
G:$D(DIRUT) SC
S APCLLOCT=Y
K APCLQ
D @APCLLOCT
I $D(APCLQ) W !!,"none selected" G SC
OUTP ;type of output, printed or excel delimited
K APCLQ
D PT
I $D(APCLQ) W !!,"no output type selected." G FAC
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G OUTP
K IOP,%ZIS I APCLROT="D",APCLDELT="F" D NODEV,XIT Q
W !! S %ZIS=$S(APCLDELT'="S":"PQM",1:"PM") D ^%ZIS
I $D(IO("Q")) G TSKMN
DRIVER ;
D PROC
U IO
D PRINT
D ^%ZISC
D XIT
Q
;
NODEV1 ;
D PROC
D PRINT
D ^%ZISC
D XIT
Q
TSKMN ;EP ENTRY POINT FROM TASKMAN
S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
K ZTSAVE S ZTSAVE("APCL*")=""
S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCLCPT1",ZTDTH="",ZTDESC="CPT PROVIDER TALLY" D ^%ZTLOAD D XIT Q
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^APCLCPT1",XBRX="XIT^APCLCPT1",XBNS="APCL"
D ^XBDBQUE
Q
;
XIT ;
D ^%ZISC
D EN^XBVK("APCL")
K DIRUT,DUOUT,DIR,DOD
K DIADD,DLAYGO
D KILL^AUPNPAT
K X,X1,X2,X3,X4,X5,X6
K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
K N,N1,N2,N3,N4,N5,N6
K BD,ED
D ^XBFMK
Q
EOJ ;
D EN^XBVK("APCL")
D ^XBFMK
Q
PROC ;
S APCLH=$H,APCLJ=$J
K ^XTMP("APCLCPT1",APCLJ,APCLH)
D XTMP^APCLOSUT("APCLCPT1","CPT BY PROVIDER REPORT")
; Run by visit date
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
Q
V1 ;
S APCLVIEN="" F S APCLVIEN=$O(^AUPNVSIT("B",APCLODAT,APCLVIEN)) Q:APCLVIEN'=+APCLVIEN D PROC1
Q
PROC1 ;
Q:'$D(^AUPNVSIT(APCLVIEN,0))
S APCLVREC=^AUPNVSIT(APCLVIEN,0)
Q:'$P(APCLVREC,U,9) ;no dep entries
Q:$P(APCLVREC,U,11) ;deleted
S DFN=$P(APCLVREC,U,5)
Q:DFN=""
Q:'$D(^DPT(DFN,0))
Q:'$D(^AUPNPAT(DFN,0))
Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
S X=$P(APCLVREC,U,7)
Q:X=""
Q:"AIHSO"'[X
I APCLOI="O",X'="A",X'="S",X'="O" Q ;want only outpt and it's not a A,O or S
I APCLOI="I",X'="H",X'="I" Q ;want inpatient only
S X=$P(^AUPNVSIT(APCLVIEN,0),U,6) Q:X=""
I APCLLOCT="L" Q:X'=APCLLOC
I APCLLOCT="S" Q:$P(^AUTTLOC(X,0),U,5)'=APCLSU ;not correct su
I APCLLOCT="T" Q:$$TRIBE^AUPNPAT(DFN,"I")'=APCLTRIB ;not correct tribe
;get e&m and loop through V CPT
K AUPNCPT
S X=$$CPT^AUPNCPT(APCLVIEN)
Q:'$D(AUPNCPT)
S APCLX=0 F S APCLX=$O(AUPNCPT(APCLX)) Q:APCLX'=+APCLX D
.S APCLC=$P(AUPNCPT(APCLX),U)
.S APCLN=$P(AUPNCPT(APCLX),U,2)
.S APCLF=$P(AUPNCPT(APCLX),U,4)
.S APCLI=$P(AUPNCPT(APCLX),U,5)
.S APCLQ=1 I $P(AUPNCPT(APCLX),U,4)=9000010.18 S I=$P(AUPNCPT(APCLX),U,5) I $P($G(^AUPNVCPT(I,0)),U,16)>1 S APCLQ=$P(^AUPNVCPT(I,0),U,16) ;reset quantity if necessary
.;get providers for this cpt code
.K APCLPROV
.S P="",Q=""
.I APCLF=9000010.08 D I P,'Q S APCLPROV(P)="" G SETP
..S P=$P(^AUPNVPRC(APCLI,0),U,11)
..Q:P
..S P=$P($G(^AUPNVPRC(APCLI,12)),U,4)
..Q:'P
..I APCLPRIM="P",P'=$$PRIMPROV^APCLV($P(^AUPNVPRC(APCLI,0),U,3),"I") S Q=1 ;don't want this cpt or provider as it isn't the primary provider
.I APCLF=9000010.22 D I P,'Q S APCLPROV(P)="" G SETP
..S P=$P($G(^AUPNVRAD(APCLI,12)),U,4)
..Q:'P
..I APCLPRIM="P",P'=$$PRIMPROV^APCLV($P(^AUPNVRAD(APCLI,0),U,3),"I") S Q=1 ;don't want this cpt or provider as it isn't the primary provider
.I APCLF=9000010.18 D I P,'Q S APCLPROV(P)="" G SETP
..S P=$P($G(^AUPNVCPT(APCLI,12)),U,4)
..Q:'P
..I APCLPRIM="P",P'=$$PRIMPROV^APCLV($P(^AUPNVCPT(APCLI,0),U,3),"I") S Q=1 ;don't want this cpt or provider as it isn't the primary provider
.;
.;check all provider since none documented in the v file
.S APCLY=0 F S APCLY=$O(^AUPNVPRV("AD",APCLVIEN,APCLY)) Q:APCLY'=+APCLY D
..Q:'$D(^AUPNVPRV(APCLY,0))
..I APCLPRIM="P",$P(^AUPNVPRV(APCLY,0),U,4)'="P" Q
..S APCLPROV($P(^AUPNVPRV(APCLY,0),U))=""
.I '$D(APCLPROV),$P(APCLVREC,U,7)="I" D ;get providers from the H visit
..S V=$P(APCLVREC,U,12)
..Q:V=""
..S APCLY=0 F S APCLY=$O(^AUPNVPRV("AD",V,APCLY)) Q:APCLY'=+APCLY D
...Q:'$D(^AUPNVPRV(APCLY,0))
...I APCLPRIM="P",$P(^AUPNVPRV(APCLY,0),U,4)'="P" Q
...S APCLPROV($P(^AUPNVPRV(APCLY,0),U))=""
SETP .;
.S APCLY=0 F S APCLY=$O(APCLPROV(APCLY)) Q:APCLY'=+APCLY D
..S APCLPN=$P($G(^VA(200,APCLY,0)),U) I APCLPN="" S APCLPN="????????"
..S APCLDISC=$$VAL^XBDIQ1(200,APCLY,53.5) I APCLDISC="" S APCLDISC="?????"
..D SET
.I '$D(APCLPROV) S APCLPN="NO PROVIDER ENTERED, UNKNOWN",APCLDISC="?????",APCLY=9999999 D SET
.Q
Q
SET ;
I "AOS"[$P(APCLVREC,U,7) S ^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLY,APCLDISC,"OUTPATIENT",APCLC,APCLN)=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLY,APCLDISC,"OUTPATIENT",APCLC,APCLN))+APCLQ
I "HI"[$P(APCLVREC,U,7) S ^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLY,APCLDISC,"INPATIENT",APCLC,APCLN)=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLY,APCLDISC,"INPATIENT",APCLC,APCLN))+APCLQ
I "AOS"[$P(APCLVREC,U,7) S ^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLY,APCLDISC)=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLY,APCLDISC))+1
I "HI"[$P(APCLVREC,U,7) S ^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLY,APCLDISC)=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLY,APCLDISC))+1
Q:$D(^XTMP("APCLCPT1",APCLJ,APCLH,"DFN",APCLPN,APCLY,APCLDISC,DFN))
S ^XTMP("APCLCPT1",APCLJ,APCLH,"DFN",APCLPN,APCLY,APCLDISC,DFN)=""
S ^XTMP("APCLCPT1",APCLJ,APCLH,"PATIENTS",APCLPN,APCLY,APCLDISC)=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"PATIENTS",APCLPN,APCLY,APCLDISC))+1
Q
PRINT ;
I APCLROT="D" G DEL
D PRINT1
I APCLROT'="B" D DONE Q
DEL ;create delimited output file
D ^%ZISC ;close printer device
K ^TMP($J)
D ^APCLCPTD ;create ^tmp of delimited report
K ^TMP($J)
D DONE
Q
PRINT1 ;EP - called from xbdbque
S APCLPG=0 K APCLQUIT
I '$D(^XTMP("APCLCPT1",APCLJ,APCLH)) D HEADER W !!,"No data to report.",! G DONE
S APCLPN="" F S APCLPN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN)) Q:APCLPN=""!($D(APCLQUIT)) D
.S APCLPIEN=0 F S APCLPIEN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN)) Q:APCLPIEN'=+APCLPIEN!($D(APCLQUIT)) D
..D HEADER
..W !!,"Provider Name",?55,"Discipline"
..S APCLDISC=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,""))
..W !,APCLPN,?55,APCLDISC
..I APCLOI="B"!(APCLOI="O") D
...D AMBHDR
...S APCLY="" F S APCLY=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY)) Q:APCLY=""!($D(APCLQUIT)) D
....I $Y>(IOSL-5) D HEADER,AMBHDR
....S APCLN="" F S APCLN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN)) Q:APCLN=""!($D(APCLQUIT)) D PRNO
..;INPATIENT
..I APCLOI="B"!(APCLOI="I") D
...I $Y>(IOSL-5) D HEADER
...D INPHDR
...S APCLY="" F S APCLY=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY)) Q:APCLY=""!($D(APCLQUIT)) D
....I $Y>(IOSL-5) D HEADER,INPHDR
....S APCLN="" F S APCLN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN)) Q:APCLN=""!($D(APCLQUIT)) D PRNI
..;TOTALS
..I $Y>(IOSL-8) D HEADER
..I APCLOI="B"!(APCLOI="O") D
...S APCLCNT=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLPIEN,APCLDISC))
...W !!,"Total Outpatient Visits: ",$$PAD($$C(APCLCNT,0,7),7)
..I APCLOI="B"!(APCLOI="I") D
...S APCLCNT=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLPIEN,APCLDISC))
...W !!,"Total Inpatient Services: ",$$PAD($$C(APCLCNT,0,7),7)
..W !!,"Total Patients: ",$$PAD($$C(APCLCNT,0,7),7)
.Q
Q
PRNO ;
I $Y>(IOSL-2) D HEADER
S APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN)
W !,APCLY,?11,APCLN,?55,$$PAD($$C(APCLCNT,0,7),7)
Q
PRNI ;
I $Y>(IOSL-2) D HEADER
S APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN)
W !,APCLY,?11,APCLN,?55,$$PAD($$C(APCLCNT,0,7),7)
Q
AMBHDR ;
W !!,"Ambulatory/Outpatient Services:"
W !!,"CPT Code",?11,"CPT Narrative",?50,"# Subtotaled by CPT"
Q
INPHDR ;
W !!,"Inpatient Services:"
W !!,"CPT Code",?11,"CPT Narrative",?50,"# Subtotaled by CPT"
Q
G:'APCLPG HEADER1
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="" Q
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
W !,$$CTR("*** CPT Code by Provider Report ***",80),!
S X="Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
Q
DONE ;
K ^XTMP("APCLCPT1",APCLJ,APCLH)
;D EOP
Q
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:IO'=IO(0)
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
W !
S DIR("A")="End of Report. Press Enter",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")
;----------
A ;
Q
L ;one location
S APCLLOC=""
S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S APCLLOC=+Y
Q
S ;
S APCLSU=""
S DIC="^AUTTSU(",DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S APCLSU=+Y
Q
T ;
S APCLTRIB=""
S DIC="^AUTTTRI(",DIC(0)="AEMQ",DIC("A")="Which TRIBE: " D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S APCLTRIB=+Y
Q
PT ;EP
S (APCLROT,APCLDELT,APCLDELF)=""
W !!,"Please choose an output type. For an explanation of the delimited",!,"file please see the user manual.",!
S DIR(0)="S^P:Print Report on Printer or Screen;D:Create Delimited output file (for use in Excel);B:Both a Printed Report and Delimited File",DIR("A")="Select an Output Option",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S APCLQ="" Q
S APCLROT=Y
Q:APCLROT="P"
S APCLDELF="",APCLDELT=""
W !!,"You have selected to create a delimited output file. You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"
W !,"you can do a file capture. Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!
S DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to a file in pub",DIR("A")="Select output type",DIR("B")="S" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PT
S APCLDELT=Y
Q:APCLDELT="S"
S DIR(0)="F^1:40",DIR("A")="Enter a filename for the delimited output (no more than 40 characters)" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PT
S APCLDELF=Y
S APCLHDIR=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:$G(^XTV(8989.3,1,"DEV")))
I $G(APCLHDIR)="" S APCLHDIR="/usr/spool/uucppublic/"
W !!,"When the report is finished your delimited output will be found in the",!,APCLHDIR," directory. The filename will be ",APCLDELF,".txt",!
Q
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
APCLCPT1 ; IHS/CMI/LAB - list CPT CODES BY PROVIDER ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;EP
INFORM ;
+1 WRITE !,$$CTR($$USR)
+2 WRITE !,$$LOC()
+3 WRITE !!,$$CTR("TALLY OF CPT CODES BY PROVIDER",80)
+4 WRITE !!,"This report will tally the all CPT codes entered by provider."
+5 WRITE !,"You will be able to specify the date range; whether to include"
+6 WRITE !,"outpatient (ambulatory, day surgery, observation), inpatient visits"
+7 WRITE !,"or both; tally cpts codes by primary provider only or primary"
+8 WRITE !,"and secondary provider; and whether to include only visits to"
+9 WRITE !,"one facility, a service unit or to patients who are members"
+10 WRITE !,"of a particular tribe."
+11 WRITE !!,"PLEASE NOTE: If you choose both primary and secondary providers"
+12 WRITE !," the following logic will be applied:"
+13 WRITE !," If you use the CPE mnemonic or the CPT code is entered"
+14 WRITE !," through EHR the CPT code will be linked to the encounter"
+15 WRITE !," provider documented. If there is no encounter provider"
+16 WRITE !," documented then the CPT code will be tallied under each"
+17 WRITE !," provider on that visit thus the counts will include the"
+18 WRITE !," same CPT code multiple times."
+19 WRITE !
+20 DO EOJ
DATES KILL APCLED,APCLBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Visit Date"
+2 DO ^DIR
IF Y<1
QUIT
SET APCLBD=Y
+3 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Visit Date"
+4 DO ^DIR
IF Y<1
QUIT
SET APCLED=Y
+5 ;
+6 IF APCLED<APCLBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+8 ;
PS ;
+1 SET APCLPRIM=""
+2 SET DIR(0)="SO^P:Primary Provider Only;A:All Providers (Primary and Secondary)"
SET DIR("A")="Report should include"
+3 SET DIR("?")="If you wish to count only the primary provider of service enter a 'P'. To include ALL providers enter an 'A'."
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO DATES
+5 SET APCLPRIM=Y
SC ;
+1 SET APCLOI=""
+2 SET DIR(0)="SO^O:Outpatient Visits (ambulatory, day surgery, observation);I:Inpatient;B:Both"
SET DIR("A")="Report should include"
SET DIR("B")="B"
+3 SET DIR("?")="If you wish to count only the primary provider of service enter a 'P'. To include ALL providers enter an 'A'."
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO PS
+5 SET APCLOI=Y
FAC ;
+1 SET APCLLOCT=""
+2 SET DIR(0)="S^S:One Service Unit;L:One Location/Facility;T:One Tribe;A:All visits"
SET DIR("A")="Include Visits to"
+3 SET DIR("A")="Enter a code indicating which visits are of interest"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
GOTO SC
+5 SET APCLLOCT=Y
+6 KILL APCLQ
+7 DO @APCLLOCT
+8 IF $DATA(APCLQ)
WRITE !!,"none selected"
GOTO SC
OUTP ;type of output, printed or excel delimited
+1 KILL APCLQ
+2 DO PT
+3 IF $DATA(APCLQ)
WRITE !!,"no output type selected."
GOTO FAC
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO OUTP
+3 KILL IOP,%ZIS
IF APCLROT="D"
IF APCLDELT="F"
DO NODEV
DO XIT
QUIT
+4 WRITE !!
SET %ZIS=$SELECT(APCLDELT'="S":"PQM",1:"PM")
DO ^%ZIS
+5 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO PROC
+2 USE IO
+3 DO PRINT
+4 DO ^%ZISC
+5 DO XIT
+6 QUIT
+7 ;
NODEV1 ;
+1 DO PROC
+2 DO PRINT
+3 DO ^%ZISC
+4 DO XIT
+5 QUIT
TSKMN ;EP ENTRY POINT FROM TASKMAN
+1 SET ZTIO=$SELECT($DATA(ION):ION,1:IO)
IF $DATA(IOST)#2
IF IOST]""
SET ZTIO=ZTIO_";"_IOST
+2 IF $GET(IO("DOC"))]""
SET ZTIO=ZTIO_";"_$GET(IO("DOC"))
+3 IF $DATA(IOM)#2
IF IOM
SET ZTIO=ZTIO_";"_IOM
IF $DATA(IOSL)#2
IF IOSL
SET ZTIO=ZTIO_";"_IOSL
+4 KILL ZTSAVE
SET ZTSAVE("APCL*")=""
+5 SET ZTCPU=$GET(IOCPU)
SET ZTRTN="DRIVER^APCLCPT1"
SET ZTDTH=""
SET ZTDESC="CPT PROVIDER TALLY"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^APCLCPT1"
SET XBRX="XIT^APCLCPT1"
SET XBNS="APCL"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
XIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("APCL")
+3 KILL DIRUT,DUOUT,DIR,DOD
+4 KILL DIADD,DLAYGO
+5 DO KILL^AUPNPAT
+6 KILL X,X1,X2,X3,X4,X5,X6
+7 KILL A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
+8 KILL N,N1,N2,N3,N4,N5,N6
+9 KILL BD,ED
+10 DO ^XBFMK
+11 QUIT
EOJ ;
+1 DO EN^XBVK("APCL")
+2 DO ^XBFMK
+3 QUIT
PROC ;
+1 SET APCLH=$HOROLOG
SET APCLJ=$JOB
+2 KILL ^XTMP("APCLCPT1",APCLJ,APCLH)
+3 DO XTMP^APCLOSUT("APCLCPT1","CPT BY PROVIDER REPORT")
+4 ; Run by visit date
+5 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
+6 SET APCLODAT=APCLSD_".9999"
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
+7 QUIT
V1 ;
+1 SET APCLVIEN=""
FOR
SET APCLVIEN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVIEN))
IF APCLVIEN'=+APCLVIEN
QUIT
DO PROC1
+2 QUIT
PROC1 ;
+1 IF '$DATA(^AUPNVSIT(APCLVIEN,0))
QUIT
+2 SET APCLVREC=^AUPNVSIT(APCLVIEN,0)
+3 ;no dep entries
IF '$PIECE(APCLVREC,U,9)
QUIT
+4 ;deleted
IF $PIECE(APCLVREC,U,11)
QUIT
+5 SET DFN=$PIECE(APCLVREC,U,5)
+6 IF DFN=""
QUIT
+7 IF '$DATA(^DPT(DFN,0))
QUIT
+8 IF '$DATA(^AUPNPAT(DFN,0))
QUIT
+9 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+10 SET X=$PIECE(APCLVREC,U,7)
+11 IF X=""
QUIT
+12 IF "AIHSO"'[X
QUIT
+13 ;want only outpt and it's not a A,O or S
IF APCLOI="O"
IF X'="A"
IF X'="S"
IF X'="O"
QUIT
+14 ;want inpatient only
IF APCLOI="I"
IF X'="H"
IF X'="I"
QUIT
+15 SET X=$PIECE(^AUPNVSIT(APCLVIEN,0),U,6)
IF X=""
QUIT
+16 IF APCLLOCT="L"
IF X'=APCLLOC
QUIT
+17 ;not correct su
IF APCLLOCT="S"
IF $PIECE(^AUTTLOC(X,0),U,5)'=APCLSU
QUIT
+18 ;not correct tribe
IF APCLLOCT="T"
IF $$TRIBE^AUPNPAT(DFN,"I")'=APCLTRIB
QUIT
+19 ;get e&m and loop through V CPT
+20 KILL AUPNCPT
+21 SET X=$$CPT^AUPNCPT(APCLVIEN)
+22 IF '$DATA(AUPNCPT)
QUIT
+23 SET APCLX=0
FOR
SET APCLX=$ORDER(AUPNCPT(APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+24 SET APCLC=$PIECE(AUPNCPT(APCLX),U)
+25 SET APCLN=$PIECE(AUPNCPT(APCLX),U,2)
+26 SET APCLF=$PIECE(AUPNCPT(APCLX),U,4)
+27 SET APCLI=$PIECE(AUPNCPT(APCLX),U,5)
+28 ;reset quantity if necessary
SET APCLQ=1
IF $PIECE(AUPNCPT(APCLX),U,4)=9000010.18
SET I=$PIECE(AUPNCPT(APCLX),U,5)
IF $PIECE($GET(^AUPNVCPT(I,0)),U,16)>1
SET APCLQ=$PIECE(^AUPNVCPT(I,0),U,16)
+29 ;get providers for this cpt code
+30 KILL APCLPROV
+31 SET P=""
SET Q=""
+32 IF APCLF=9000010.08
Begin DoDot:2
+33 SET P=$PIECE(^AUPNVPRC(APCLI,0),U,11)
+34 IF P
QUIT
+35 SET P=$PIECE($GET(^AUPNVPRC(APCLI,12)),U,4)
+36 IF 'P
QUIT
+37 ;don't want this cpt or provider as it isn't the primary provider
IF APCLPRIM="P"
IF P'=$$PRIMPROV^APCLV($PIECE(^AUPNVPRC(APCLI,0),U,3),"I")
SET Q=1
End DoDot:2
IF P
IF 'Q
SET APCLPROV(P)=""
GOTO SETP
+38 IF APCLF=9000010.22
Begin DoDot:2
+39 SET P=$PIECE($GET(^AUPNVRAD(APCLI,12)),U,4)
+40 IF 'P
QUIT
+41 ;don't want this cpt or provider as it isn't the primary provider
IF APCLPRIM="P"
IF P'=$$PRIMPROV^APCLV($PIECE(^AUPNVRAD(APCLI,0),U,3),"I")
SET Q=1
End DoDot:2
IF P
IF 'Q
SET APCLPROV(P)=""
GOTO SETP
+42 IF APCLF=9000010.18
Begin DoDot:2
+43 SET P=$PIECE($GET(^AUPNVCPT(APCLI,12)),U,4)
+44 IF 'P
QUIT
+45 ;don't want this cpt or provider as it isn't the primary provider
IF APCLPRIM="P"
IF P'=$$PRIMPROV^APCLV($PIECE(^AUPNVCPT(APCLI,0),U,3),"I")
SET Q=1
End DoDot:2
IF P
IF 'Q
SET APCLPROV(P)=""
GOTO SETP
+46 ;
+47 ;check all provider since none documented in the v file
+48 SET APCLY=0
FOR
SET APCLY=$ORDER(^AUPNVPRV("AD",APCLVIEN,APCLY))
IF APCLY'=+APCLY
QUIT
Begin DoDot:2
+49 IF '$DATA(^AUPNVPRV(APCLY,0))
QUIT
+50 IF APCLPRIM="P"
IF $PIECE(^AUPNVPRV(APCLY,0),U,4)'="P"
QUIT
+51 SET APCLPROV($PIECE(^AUPNVPRV(APCLY,0),U))=""
End DoDot:2
+52 ;get providers from the H visit
IF '$DATA(APCLPROV)
IF $PIECE(APCLVREC,U,7)="I"
Begin DoDot:2
+53 SET V=$PIECE(APCLVREC,U,12)
+54 IF V=""
QUIT
+55 SET APCLY=0
FOR
SET APCLY=$ORDER(^AUPNVPRV("AD",V,APCLY))
IF APCLY'=+APCLY
QUIT
Begin DoDot:3
+56 IF '$DATA(^AUPNVPRV(APCLY,0))
QUIT
+57 IF APCLPRIM="P"
IF $PIECE(^AUPNVPRV(APCLY,0),U,4)'="P"
QUIT
+58 SET APCLPROV($PIECE(^AUPNVPRV(APCLY,0),U))=""
End DoDot:3
End DoDot:2
SETP ;
+1 SET APCLY=0
FOR
SET APCLY=$ORDER(APCLPROV(APCLY))
IF APCLY'=+APCLY
QUIT
Begin DoDot:2
+2 SET APCLPN=$PIECE($GET(^VA(200,APCLY,0)),U)
IF APCLPN=""
SET APCLPN="????????"
+3 SET APCLDISC=$$VAL^XBDIQ1(200,APCLY,53.5)
IF APCLDISC=""
SET APCLDISC="?????"
+4 DO SET
End DoDot:2
+5 IF '$DATA(APCLPROV)
SET APCLPN="NO PROVIDER ENTERED, UNKNOWN"
SET APCLDISC="?????"
SET APCLY=9999999
DO SET
+6 QUIT
End DoDot:1
+7 QUIT
SET ;
+1 IF "AOS"[$PIECE(APCLVREC,U,7)
SET ^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLY,APCLDISC,"OUTPATIENT",APCLC,APCLN)=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLY,APCLDISC,"OUTPATIENT",APCLC,APCLN))+APCLQ
+2 IF "HI"[$PIECE(APCLVREC,U,7)
SET ^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLY,APCLDISC,"INPATIENT",APCLC,APCLN)=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLY,APCLDISC,"INPATIENT",APCLC,APCLN))+APCLQ
+3 IF "AOS"[$PIECE(APCLVREC,U,7)
SET ^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLY,APCLDISC)=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLY,APCLDISC))+1
+4 IF "HI"[$PIECE(APCLVREC,U,7)
SET ^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLY,APCLDISC)=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLY,APCLDISC))+1
+5 IF $DATA(^XTMP("APCLCPT1",APCLJ,APCLH,"DFN",APCLPN,APCLY,APCLDISC,DFN))
QUIT
+6 SET ^XTMP("APCLCPT1",APCLJ,APCLH,"DFN",APCLPN,APCLY,APCLDISC,DFN)=""
+7 SET ^XTMP("APCLCPT1",APCLJ,APCLH,"PATIENTS",APCLPN,APCLY,APCLDISC)=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"PATIENTS",APCLPN,APCLY,APCLDISC))+1
+8 QUIT
PRINT ;
+1 IF APCLROT="D"
GOTO DEL
+2 DO PRINT1
+3 IF APCLROT'="B"
DO DONE
QUIT
DEL ;create delimited output file
+1 ;close printer device
DO ^%ZISC
+2 KILL ^TMP($JOB)
+3 ;create ^tmp of delimited report
DO ^APCLCPTD
+4 KILL ^TMP($JOB)
+5 DO DONE
+6 QUIT
PRINT1 ;EP - called from xbdbque
+1 SET APCLPG=0
KILL APCLQUIT
+2 IF '$DATA(^XTMP("APCLCPT1",APCLJ,APCLH))
DO HEADER
WRITE !!,"No data to report.",!
GOTO DONE
+3 SET APCLPN=""
FOR
SET APCLPN=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN))
IF APCLPN=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+4 SET APCLPIEN=0
FOR
SET APCLPIEN=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN))
IF APCLPIEN'=+APCLPIEN!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+5 DO HEADER
+6 WRITE !!,"Provider Name",?55,"Discipline"
+7 SET APCLDISC=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,""))
+8 WRITE !,APCLPN,?55,APCLDISC
+9 IF APCLOI="B"!(APCLOI="O")
Begin DoDot:3
+10 DO AMBHDR
+11 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY))
IF APCLY=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:4
+12 IF $Y>(IOSL-5)
DO HEADER
DO AMBHDR
+13 SET APCLN=""
FOR
SET APCLN=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN))
IF APCLN=""!($DATA(APCLQUIT))
QUIT
DO PRNO
End DoDot:4
End DoDot:3
+14 ;INPATIENT
+15 IF APCLOI="B"!(APCLOI="I")
Begin DoDot:3
+16 IF $Y>(IOSL-5)
DO HEADER
+17 DO INPHDR
+18 SET APCLY=""
FOR
SET APCLY=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY))
IF APCLY=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:4
+19 IF $Y>(IOSL-5)
DO HEADER
DO INPHDR
+20 SET APCLN=""
FOR
SET APCLN=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN))
IF APCLN=""!($DATA(APCLQUIT))
QUIT
DO PRNI
End DoDot:4
End DoDot:3
+21 ;TOTALS
+22 IF $Y>(IOSL-8)
DO HEADER
+23 IF APCLOI="B"!(APCLOI="O")
Begin DoDot:3
+24 SET APCLCNT=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLPIEN,APCLDISC))
+25 WRITE !!,"Total Outpatient Visits: ",$$PAD($$C(APCLCNT,0,7),7)
End DoDot:3
+26 IF APCLOI="B"!(APCLOI="I")
Begin DoDot:3
+27 SET APCLCNT=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLPIEN,APCLDISC))
+28 WRITE !!,"Total Inpatient Services: ",$$PAD($$C(APCLCNT,0,7),7)
End DoDot:3
+29 WRITE !!,"Total Patients: ",$$PAD($$C(APCLCNT,0,7),7)
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
PRNO ;
+1 IF $Y>(IOSL-2)
DO HEADER
+2 SET APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN)
+3 WRITE !,APCLY,?11,APCLN,?55,$$PAD($$C(APCLCNT,0,7),7)
+4 QUIT
PRNI ;
+1 IF $Y>(IOSL-2)
DO HEADER
+2 SET APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN)
+3 WRITE !,APCLY,?11,APCLN,?55,$$PAD($$C(APCLCNT,0,7),7)
+4 QUIT
AMBHDR ;
+1 WRITE !!,"Ambulatory/Outpatient Services:"
+2 WRITE !!,"CPT Code",?11,"CPT Narrative",?50,"# Subtotaled by CPT"
+3 QUIT
INPHDR ;
+1 WRITE !!,"Inpatient Services:"
+2 WRITE !!,"CPT Code",?11,"CPT Narrative",?50,"# Subtotaled by CPT"
+3 QUIT
+1 IF 'APCLPG
GOTO HEADER1
+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=""
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
+3 WRITE !,$$CTR("*** CPT Code by Provider Report ***",80),!
+4 SET X="Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED)
WRITE $$CTR(X,80),!
+5 QUIT
DONE ;
+1 KILL ^XTMP("APCLCPT1",APCLJ,APCLH)
+2 ;D EOP
+3 QUIT
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 IO'=IO(0)
QUIT
+3 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+4 NEW DIR
+5 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+6 WRITE !
+7 SET DIR("A")="End of Report. Press Enter"
SET DIR(0)="E"
DO ^DIR
+8 QUIT
+9 ;----------
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 ;----------
A ;
+1 QUIT
L ;one location
+1 SET APCLLOC=""
+2 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which LOCATION: "
DO ^DIC
KILL DIC
+3 IF Y=-1
SET APCLQ=""
QUIT
+4 SET APCLLOC=+Y
+5 QUIT
S ;
+1 SET APCLSU=""
+2 SET DIC="^AUTTSU("
SET DIC(0)="AEMQ"
SET DIC("A")="Which SERVICE UNIT: "
DO ^DIC
KILL DIC
+3 IF Y=-1
SET APCLQ=""
QUIT
+4 SET APCLSU=+Y
+5 QUIT
T ;
+1 SET APCLTRIB=""
+2 SET DIC="^AUTTTRI("
SET DIC(0)="AEMQ"
SET DIC("A")="Which TRIBE: "
DO ^DIC
KILL DIC
+3 IF Y=-1
SET APCLQ=""
QUIT
+4 SET APCLTRIB=+Y
+5 QUIT
PT ;EP
+1 SET (APCLROT,APCLDELT,APCLDELF)=""
+2 WRITE !!,"Please choose an output type. For an explanation of the delimited",!,"file please see the user manual.",!
+3 SET DIR(0)="S^P:Print Report on Printer or Screen;D:Create Delimited output file (for use in Excel);B:Both a Printed Report and Delimited File"
SET DIR("A")="Select an Output Option"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET APCLQ=""
QUIT
+5 SET APCLROT=Y
+6 IF APCLROT="P"
QUIT
+7 SET APCLDELF=""
SET APCLDELT=""
+8 WRITE !!,"You have selected to create a delimited output file. You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"
+9 WRITE !,"you can do a file capture. Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!
+10 SET DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to a file in pub"
SET DIR("A")="Select output type"
SET DIR("B")="S"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
GOTO PT
+12 SET APCLDELT=Y
+13 IF APCLDELT="S"
QUIT
+14 SET DIR(0)="F^1:40"
SET DIR("A")="Enter a filename for the delimited output (no more than 40 characters)"
KILL DA
DO ^DIR
KILL DIR
+15 IF $DATA(DIRUT)
GOTO PT
+16 SET APCLDELF=Y
+17 SET APCLHDIR=$SELECT($PIECE($GET(^AUTTSITE(1,1)),U,2)]"":$PIECE(^AUTTSITE(1,1),U,2),1:$GET(^XTV(8989.3,1,"DEV")))
+18 IF $GET(APCLHDIR)=""
SET APCLHDIR="/usr/spool/uucppublic/"
+19 WRITE !!,"When the report is finished your delimited output will be found in the",!,APCLHDIR," directory. The filename will be ",APCLDELF,".txt",!
+20 QUIT
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
