Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCLCPT1

APCLCPT1.m

Go to the documentation of this file. 
  1. APCLCPT1 ; IHS/CMI/LAB - list CPT CODES BY PROVIDER ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1.  ;EP
  1. INFORM ;
  1.  W !,$$CTR($$USR)
  1.  W !,$$LOC()
  1.  W !!,$$CTR("TALLY OF CPT CODES BY PROVIDER",80)
  1.  W !!,"This report will tally the all CPT codes entered by provider."
  1.  W !,"You will be able to specify the date range; whether to include"
  1.  W !,"outpatient (ambulatory, day surgery, observation), inpatient visits"
  1.  W !,"or both; tally cpts codes by primary provider only or primary"
  1.  W !,"and secondary provider; and whether to include only visits to"
  1.  W !,"one facility, a service unit or to patients who are members"
  1.  W !,"of a particular tribe."
  1.  W !!,"PLEASE NOTE:  If you choose both primary and secondary providers"
  1.  W !,"               the following logic will be applied:"
  1.  W !,"               If you use the CPE mnemonic or the CPT code is entered"
  1.  W !,"               through EHR the CPT code will be linked to the encounter"
  1.  W !,"               provider documented.  If there is no encounter provider"
  1.  W !,"               documented then the CPT code will be tallied under each"
  1.  W !,"               provider on that visit thus the counts will include the"
  1.  W !,"               same CPT code multiple times."
  1.  W !
  1.  D EOJ
  1. DATES K APCLED,APCLBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
  1.  D ^DIR Q:Y<1  S APCLBD=Y
  1.  K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
  1.  D ^DIR Q:Y<1  S APCLED=Y
  1.  ;
  1.  I APCLED<APCLBD D  G DATES
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  ;
  1. PS ;
  1.  S APCLPRIM=""
  1.  S DIR(0)="SO^P:Primary Provider Only;A:All Providers (Primary and Secondary)",DIR("A")="Report should include"
  1.  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
  1.  G:$D(DIRUT) DATES
  1.  S APCLPRIM=Y
  1. SC ;
  1.  S APCLOI=""
  1.  S DIR(0)="SO^O:Outpatient Visits (ambulatory, day surgery, observation);I:Inpatient;B:Both",DIR("A")="Report should include",DIR("B")="B"
  1.  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
  1.  G:$D(DIRUT) PS
  1.  S APCLOI=Y
  1. FAC ;
  1.  S APCLLOCT=""
  1.  S DIR(0)="S^S:One Service Unit;L:One Location/Facility;T:One Tribe;A:All visits",DIR("A")="Include Visits to"
  1.  S DIR("A")="Enter a code indicating which visits are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
  1.  G:$D(DIRUT) SC
  1.  S APCLLOCT=Y
  1.  K APCLQ
  1.  D @APCLLOCT
  1.  I $D(APCLQ) W !!,"none selected" G SC
  1. OUTP ;type of output, printed or excel delimited
  1.  K APCLQ
  1.  D PT
  1.  I $D(APCLQ) W !!,"no output type selected." G FAC
  1. ZIS ;
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCLDEMO)
  1.  I APCLDEMO=-1 G OUTP
  1.  K IOP,%ZIS I APCLROT="D",APCLDELT="F" D NODEV,XIT Q
  1.  W !! S %ZIS=$S(APCLDELT'="S":"PQM",1:"PM") D ^%ZIS
  1.  I $D(IO("Q")) G TSKMN
  1. DRIVER ;
  1.  D PROC
  1.  U IO
  1.  D PRINT
  1.  D ^%ZISC
  1.  D XIT
  1.  Q
  1.  ;
  1. NODEV1 ;
  1.  D PROC
  1.  D PRINT
  1.  D ^%ZISC
  1.  D XIT
  1.  Q
  1. TSKMN ;EP ENTRY POINT FROM TASKMAN
  1.  S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
  1.  I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
  1.  I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
  1.  K ZTSAVE S ZTSAVE("APCL*")=""
  1.  S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCLCPT1",ZTDTH="",ZTDESC="CPT PROVIDER TALLY" D ^%ZTLOAD D XIT Q
  1.  Q
  1.  ;
  1. NODEV ;
  1.  S XBRP="",XBRC="NODEV1^APCLCPT1",XBRX="XIT^APCLCPT1",XBNS="APCL"
  1.  D ^XBDBQUE
  1.  Q
  1.  ;
  1. XIT ;
  1.  D ^%ZISC
  1.  D EN^XBVK("APCL")
  1.  K DIRUT,DUOUT,DIR,DOD
  1.  K DIADD,DLAYGO
  1.  D KILL^AUPNPAT
  1.  K X,X1,X2,X3,X4,X5,X6
  1.  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
  1.  K N,N1,N2,N3,N4,N5,N6
  1.  K BD,ED
  1.  D ^XBFMK
  1.  Q
  1. EOJ ;
  1.  D EN^XBVK("APCL")
  1.  D ^XBFMK
  1.  Q
  1. PROC ;
  1.  S APCLH=$H,APCLJ=$J
  1.  K ^XTMP("APCLCPT1",APCLJ,APCLH)
  1.  D XTMP^APCLOSUT("APCLCPT1","CPT BY PROVIDER REPORT")
  1.  ; Run by visit date
  1.  S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
  1.  S APCLODAT=APCLSD_".9999" F  S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED)  D V1
  1.  Q
  1. V1 ;
  1.  S APCLVIEN="" F  S APCLVIEN=$O(^AUPNVSIT("B",APCLODAT,APCLVIEN)) Q:APCLVIEN'=+APCLVIEN  D PROC1
  1.  Q
  1. PROC1 ;
  1.  Q:'$D(^AUPNVSIT(APCLVIEN,0))
  1.  S APCLVREC=^AUPNVSIT(APCLVIEN,0)
  1.  Q:'$P(APCLVREC,U,9)  ;no dep entries
  1.  Q:$P(APCLVREC,U,11)  ;deleted
  1.  S DFN=$P(APCLVREC,U,5)
  1.  Q:DFN=""
  1.  Q:'$D(^DPT(DFN,0))
  1.  Q:'$D(^AUPNPAT(DFN,0))
  1.  Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
  1.  S X=$P(APCLVREC,U,7)
  1.  Q:X=""
  1.  Q:"AIHSO"'[X
  1.  I APCLOI="O",X'="A",X'="S",X'="O" Q  ;want only outpt and it's not a A,O or S
  1.  I APCLOI="I",X'="H",X'="I" Q  ;want inpatient only
  1.  S X=$P(^AUPNVSIT(APCLVIEN,0),U,6) Q:X=""
  1.  I APCLLOCT="L" Q:X'=APCLLOC
  1.  I APCLLOCT="S" Q:$P(^AUTTLOC(X,0),U,5)'=APCLSU  ;not correct su
  1.  I APCLLOCT="T" Q:$$TRIBE^AUPNPAT(DFN,"I")'=APCLTRIB  ;not correct tribe
  1.  ;get e&m and loop through V CPT
  1.  K AUPNCPT
  1.  S X=$$CPT^AUPNCPT(APCLVIEN)
  1.  Q:'$D(AUPNCPT)
  1.  S APCLX=0 F  S APCLX=$O(AUPNCPT(APCLX)) Q:APCLX'=+APCLX  D
  1.  .S APCLC=$P(AUPNCPT(APCLX),U)
  1.  .S APCLN=$P(AUPNCPT(APCLX),U,2)
  1.  .S APCLF=$P(AUPNCPT(APCLX),U,4)
  1.  .S APCLI=$P(AUPNCPT(APCLX),U,5)
  1.  .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
  1.  .;get providers for this cpt code
  1.  .K APCLPROV
  1.  .S P="",Q=""
  1.  .I APCLF=9000010.08 D  I P,'Q S APCLPROV(P)="" G SETP
  1.  ..S P=$P(^AUPNVPRC(APCLI,0),U,11)
  1.  ..Q:P
  1.  ..S P=$P($G(^AUPNVPRC(APCLI,12)),U,4)
  1.  ..Q:'P
  1.  ..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
  1.  .I APCLF=9000010.22 D  I P,'Q S APCLPROV(P)="" G SETP
  1.  ..S P=$P($G(^AUPNVRAD(APCLI,12)),U,4)
  1.  ..Q:'P
  1.  ..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
  1.  .I APCLF=9000010.18 D  I P,'Q S APCLPROV(P)="" G SETP
  1.  ..S P=$P($G(^AUPNVCPT(APCLI,12)),U,4)
  1.  ..Q:'P
  1.  ..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
  1.  .;
  1.  .;check all provider since none documented in the v file
  1.  .S APCLY=0 F  S APCLY=$O(^AUPNVPRV("AD",APCLVIEN,APCLY)) Q:APCLY'=+APCLY  D
  1.  ..Q:'$D(^AUPNVPRV(APCLY,0))
  1.  ..I APCLPRIM="P",$P(^AUPNVPRV(APCLY,0),U,4)'="P" Q
  1.  ..S APCLPROV($P(^AUPNVPRV(APCLY,0),U))=""
  1.  .I '$D(APCLPROV),$P(APCLVREC,U,7)="I" D  ;get providers from the H visit
  1.  ..S V=$P(APCLVREC,U,12)
  1.  ..Q:V=""
  1.  ..S APCLY=0 F  S APCLY=$O(^AUPNVPRV("AD",V,APCLY)) Q:APCLY'=+APCLY  D
  1.  ...Q:'$D(^AUPNVPRV(APCLY,0))
  1.  ...I APCLPRIM="P",$P(^AUPNVPRV(APCLY,0),U,4)'="P" Q
  1.  ...S APCLPROV($P(^AUPNVPRV(APCLY,0),U))=""
  1. SETP .;
  1.  .S APCLY=0 F  S APCLY=$O(APCLPROV(APCLY)) Q:APCLY'=+APCLY  D
  1.  ..S APCLPN=$P($G(^VA(200,APCLY,0)),U) I APCLPN="" S APCLPN="????????"
  1.  ..S APCLDISC=$$VAL^XBDIQ1(200,APCLY,53.5) I APCLDISC="" S APCLDISC="?????"
  1.  ..D SET
  1.  .I '$D(APCLPROV) S APCLPN="NO PROVIDER ENTERED, UNKNOWN",APCLDISC="?????",APCLY=9999999 D SET
  1.  .Q
  1.  Q
  1. SET ;
  1.  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
  1.  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
  1.  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
  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
  1.  Q:$D(^XTMP("APCLCPT1",APCLJ,APCLH,"DFN",APCLPN,APCLY,APCLDISC,DFN))
  1.  S ^XTMP("APCLCPT1",APCLJ,APCLH,"DFN",APCLPN,APCLY,APCLDISC,DFN)=""
  1.  S ^XTMP("APCLCPT1",APCLJ,APCLH,"PATIENTS",APCLPN,APCLY,APCLDISC)=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"PATIENTS",APCLPN,APCLY,APCLDISC))+1
  1.  Q
  1. PRINT ;
  1.  I APCLROT="D" G DEL
  1.  D PRINT1
  1.  I APCLROT'="B" D DONE Q
  1. DEL ;create delimited output file
  1.  D ^%ZISC ;close printer device
  1.  K ^TMP($J)
  1.  D ^APCLCPTD ;create ^tmp of delimited report
  1.  K ^TMP($J)
  1.  D DONE
  1.  Q
  1. PRINT1 ;EP - called from xbdbque
  1.  S APCLPG=0 K APCLQUIT
  1.  I '$D(^XTMP("APCLCPT1",APCLJ,APCLH)) D HEADER W !!,"No data to report.",! G DONE
  1.  S APCLPN="" F  S APCLPN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN)) Q:APCLPN=""!($D(APCLQUIT))  D
  1.  .S APCLPIEN=0 F  S APCLPIEN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN)) Q:APCLPIEN'=+APCLPIEN!($D(APCLQUIT))  D
  1.  ..D HEADER
  1.  ..W !!,"Provider Name",?55,"Discipline"
  1.  ..S APCLDISC=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,""))
  1.  ..W !,APCLPN,?55,APCLDISC
  1.  ..I APCLOI="B"!(APCLOI="O") D
  1.  ...D AMBHDR
  1.  ...S APCLY="" F  S APCLY=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY)) Q:APCLY=""!($D(APCLQUIT))  D
  1.  ....I $Y>(IOSL-5) D HEADER,AMBHDR
  1.  ....S APCLN="" F  S APCLN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN)) Q:APCLN=""!($D(APCLQUIT))  D PRNO
  1.  ..;INPATIENT
  1.  ..I APCLOI="B"!(APCLOI="I") D
  1.  ...I $Y>(IOSL-5) D HEADER
  1.  ...D INPHDR
  1.  ...S APCLY="" F  S APCLY=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY)) Q:APCLY=""!($D(APCLQUIT))  D
  1.  ....I $Y>(IOSL-5) D HEADER,INPHDR
  1.  ....S APCLN="" F  S APCLN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN)) Q:APCLN=""!($D(APCLQUIT))  D PRNI
  1.  ..;TOTALS
  1.  ..I $Y>(IOSL-8) D HEADER
  1.  ..I APCLOI="B"!(APCLOI="O") D
  1.  ...S APCLCNT=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLPIEN,APCLDISC))
  1.  ...W !!,"Total Outpatient Visits: ",$$PAD($$C(APCLCNT,0,7),7)
  1.  ..I APCLOI="B"!(APCLOI="I") D
  1.  ...S APCLCNT=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLPIEN,APCLDISC))
  1.  ...W !!,"Total Inpatient Services: ",$$PAD($$C(APCLCNT,0,7),7)
  1.  ..W !!,"Total Patients:  ",$$PAD($$C(APCLCNT,0,7),7)
  1.  .Q
  1.  Q
  1. PRNO ;
  1.  I $Y>(IOSL-2) D HEADER
  1.  S APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN)
  1.  W !,APCLY,?11,APCLN,?55,$$PAD($$C(APCLCNT,0,7),7)
  1.  Q
  1. PRNI ;
  1.  I $Y>(IOSL-2) D HEADER
  1.  S APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN)
  1.  W !,APCLY,?11,APCLN,?55,$$PAD($$C(APCLCNT,0,7),7)
  1.  Q
  1. AMBHDR ;
  1.  W !!,"Ambulatory/Outpatient Services:"
  1.  W !!,"CPT Code",?11,"CPT Narrative",?50,"# Subtotaled by CPT"
  1.  Q
  1. INPHDR ;
  1.  W !!,"Inpatient Services:"
  1.  W !!,"CPT Code",?11,"CPT Narrative",?50,"# Subtotaled by CPT"
  1.  Q
  1.  G:'APCLPG HEADER1
  1.  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
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S APCLPG=APCLPG+1
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
  1.  W !,$$CTR("***  CPT Code by Provider Report  ***",80),!
  1.  S X="Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
  1.  Q
  1. DONE ;
  1.  K ^XTMP("APCLCPT1",APCLJ,APCLH)
  1.  ;D EOP
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:IO'=IO(0)
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  W !
  1.  S DIR("A")="End of Report.  Press Enter",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. A ;
  1.  Q
  1. L ;one location
  1.  S APCLLOC=""
  1.  S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
  1.  I Y=-1 S APCLQ="" Q
  1.  S APCLLOC=+Y
  1.  Q
  1. S ;
  1.  S APCLSU=""
  1.  S DIC="^AUTTSU(",DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC
  1.  I Y=-1 S APCLQ="" Q
  1.  S APCLSU=+Y
  1.  Q
  1. T ;
  1.  S APCLTRIB=""
  1.  S DIC="^AUTTTRI(",DIC(0)="AEMQ",DIC("A")="Which TRIBE: " D ^DIC K DIC
  1.  I Y=-1 S APCLQ="" Q
  1.  S APCLTRIB=+Y
  1.  Q
  1. PT ;EP
  1.  S (APCLROT,APCLDELT,APCLDELF)=""
  1.  W !!,"Please choose an output type.  For an explanation of the delimited",!,"file please see the user manual.",!
  1.  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
  1.  I $D(DIRUT) S APCLQ="" Q
  1.  S APCLROT=Y
  1.  Q:APCLROT="P"
  1.  S APCLDELF="",APCLDELT=""
  1.  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"
  1.  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!!",!!
  1.  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
  1.  I $D(DIRUT) G PT
  1.  S APCLDELT=Y
  1.  Q:APCLDELT="S"
  1.  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
  1.  I $D(DIRUT) G PT
  1.  S APCLDELF=Y
  1.  S APCLHDIR=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:$G(^XTV(8989.3,1,"DEV")))
  1.  I $G(APCLHDIR)="" S APCLHDIR="/usr/spool/uucppublic/"
  1.  W !!,"When the report is finished your delimited output will be found in the",!,APCLHDIR," directory.  The filename will be ",APCLDELF,".txt",!
  1.  Q
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q $$STRIP^XLFSTR(X," ")
  1. PAD(D,L) ; -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  S L=L-$L(D)
  1.  Q $E($$REPEAT^XLFSTR(" ",L),1,L)_D