APCLFPC ; IHS/CMI/LAB - TOP FPR PROCEDURES ; 10 Nov 2009 9:49 AM
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
W !!?20,"***** FREQUENCY OF CPTS REPORT *****",!!
D EXIT
GETDATES ;
BD ;get beginning date
K DIR
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G EXIT
S APCLBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date: " S Y=APCLBD D DD^%DT S Y="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
I $D(DIRUT) G GETDATES
S APCLNCAN=1 D ADD^APCLVL01 I $D(APCLQUIT) D DEL^APCLVL K APCLQUIT G GETDATES
;
LIMITCPT ;
K APCLCPTM S APCLCPTT=""
S DIR(0)="S^A:All CPTs;S:Selected set of CPTs, range of CPTs or taxonomy of CPTs",DIR("A")="List patients who are members of",DIR("B")="A" K DA D ^DIR K DIR
I $D(DIRUT) G EXIT
S APCLCPTT=Y
I APCLCPTT="A" W !!,"ALL CPT codes will be included in the report.",! G NUM
I APCLCPTT="O" D G:'$D(APCLCPTM) LIMITCPT G NUM
.S Y="" F D Q:Y=-1
..S DIC="^ICPT(",DIC(0)="AEMQ",DIC("A")="Which CPT: " D ^DIC K DIC
..Q:Y=-1
..S APCLCPTM(+Y)=""
S X="CPT CODE",DIC="^AMQQ(5,",DIC(0)="FMX",DIC("S")="I $P(^(0),U,14)",D="B" D MIX^DIC1 K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCLERR=1 D EXIT Q
D PEP^AMQQGTX0(+Y,"APCLCPTM(")
I '$D(APCLCPTM) G LIMITCPT
I $D(APCLCPTM("*")) K APCLCPTM G LIMITCPT
NUM S DIR(0)="NO^5:100:0",DIR("A")="How many entries do you want in the list",DIR("B")="10",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
S APCLLNO=Y
S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
S APCLTCW=0,APCLPTVS="V",APCLTYPE="D",APCLCTYP="T"
K ^APCLVRPT(APCLRPT,11) S APCLCNTL="S" D ^APCLVL4 K APCLCNTL I $D(APCLQUIT) D DEL^APCLVL G GETDATES
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G NUM
K APCLANS,APCLCNT,APCLCRIT,AMQQTAX,APCLCUT,APCLDISP,APCLHIGH,APCLI,APCLNCAN,APCLSEL,APCLSKIP,APCLTEXT,APCLVAR,APCLVIEN,APCLVREC
S XBRC="^APCLFPC1",XBRP="^APCLFPCP",XBNS="APCL",XBRX="EXIT^APCLFPC"
D ^XBDBQUE
D EXIT
Q
EXIT ;
K APCLBD,APCLED,APCLDOB1,APCLDOB2,APCLSEX,X,Y,Z,%,APCLFAC,APCLJOB,APCLLNO,ZTQUEUED,APCLCLN,APCLTYPE,APCLSC,APCLC,APCLPREC,APCLSD,APCLA,APCLC,APCLF,APCLGTOT,APCLPRC,APCLTOT,APCLD,APCLPRCN,APCLET
K APCLQUIT,APCLAPC,APCLDATE,APCLPOV,APCLVSIT,APCLNOCK,APCLTOT,APCLPROV,APCLVTOT,APCLLINO,L,I,APCLCMA,APCLPOVN,APCLV,APCLTYPP,APCLSCP,APCLPRIM,APCLALL,APCLSEAT
K APCLANS,AMQQTAX,APCLBDD,APCLCNT,APCLCRIT,APCLCTYP,APCLCUT,APCLDISP,APCLEDD,APCLHIGH,APCLI,APCLNCAN,APCLPTVS,APCLRPT,APCLSEL,APCLSKIP,APCLTCW,APCLTEXT,APCLVAR,APCLVIEN,APCLVREC,DFN,APCLX,APCLY
K APCLBT
Q
APCLFPC ; IHS/CMI/LAB - TOP FPR PROCEDURES ; 10 Nov 2009 9:49 AM
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 WRITE !!?20,"***** FREQUENCY OF CPTS REPORT *****",!!
+4 DO EXIT
GETDATES ;
BD ;get beginning date
+1 KILL DIR
+2 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date"
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO EXIT
+4 SET APCLBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCLBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date: "
SET Y=APCLBD
DO DD^%DT
SET Y=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCLED=Y
+4 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
+5 IF $DATA(DIRUT)
GOTO GETDATES
+6 SET APCLNCAN=1
DO ADD^APCLVL01
IF $DATA(APCLQUIT)
DO DEL^APCLVL
KILL APCLQUIT
GOTO GETDATES
+7 ;
LIMITCPT ;
+1 KILL APCLCPTM
SET APCLCPTT=""
+2 SET DIR(0)="S^A:All CPTs;S:Selected set of CPTs, range of CPTs or taxonomy of CPTs"
SET DIR("A")="List patients who are members of"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO EXIT
+4 SET APCLCPTT=Y
+5 IF APCLCPTT="A"
WRITE !!,"ALL CPT codes will be included in the report.",!
GOTO NUM
+6 IF APCLCPTT="O"
Begin DoDot:1
+7 SET Y=""
FOR
Begin DoDot:2
+8 SET DIC="^ICPT("
SET DIC(0)="AEMQ"
SET DIC("A")="Which CPT: "
DO ^DIC
KILL DIC
+9 IF Y=-1
QUIT
+10 SET APCLCPTM(+Y)=""
End DoDot:2
IF Y=-1
QUIT
End DoDot:1
IF '$DATA(APCLCPTM)
GOTO LIMITCPT
GOTO NUM
+11 SET X="CPT CODE"
SET DIC="^AMQQ(5,"
SET DIC(0)="FMX"
SET DIC("S")="I $P(^(0),U,14)"
SET D="B"
DO MIX^DIC1
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
SET APCLERR=1
DO EXIT
QUIT
+12 DO PEP^AMQQGTX0(+Y,"APCLCPTM(")
+13 IF '$DATA(APCLCPTM)
GOTO LIMITCPT
+14 IF $DATA(APCLCPTM("*"))
KILL APCLCPTM
GOTO LIMITCPT
NUM SET DIR(0)="NO^5:100:0"
SET DIR("A")="How many entries do you want in the list"
SET DIR("B")="10"
SET DIR("?")=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+1 SET APCLLNO=Y
+2 SET Y=APCLBD
DO DD^%DT
SET APCLBDD=Y
SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+3 SET APCLTCW=0
SET APCLPTVS="V"
SET APCLTYPE="D"
SET APCLCTYP="T"
+4 KILL ^APCLVRPT(APCLRPT,11)
SET APCLCNTL="S"
DO ^APCLVL4
KILL APCLCNTL
IF $DATA(APCLQUIT)
DO DEL^APCLVL
GOTO GETDATES
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO NUM
+3 KILL APCLANS,APCLCNT,APCLCRIT,AMQQTAX,APCLCUT,APCLDISP,APCLHIGH,APCLI,APCLNCAN,APCLSEL,APCLSKIP,APCLTEXT,APCLVAR,APCLVIEN,APCLVREC
+4 SET XBRC="^APCLFPC1"
SET XBRP="^APCLFPCP"
SET XBNS="APCL"
SET XBRX="EXIT^APCLFPC"
+5 DO ^XBDBQUE
+6 DO EXIT
+7 QUIT
EXIT ;
+1 KILL APCLBD,APCLED,APCLDOB1,APCLDOB2,APCLSEX,X,Y,Z,%,APCLFAC,APCLJOB,APCLLNO,ZTQUEUED,APCLCLN,APCLTYPE,APCLSC,APCLC,APCLPREC,APCLSD,APCLA,APCLC,APCLF,APCLGTOT,APCLPRC,APCLTOT,APCLD,APCLPRCN,APCLET
+2 KILL APCLQUIT,APCLAPC,APCLDATE,APCLPOV,APCLVSIT,APCLNOCK,APCLTOT,APCLPROV,APCLVTOT,APCLLINO,L,I,APCLCMA,APCLPOVN,APCLV,APCLTYPP,APCLSCP,APCLPRIM,APCLALL,APCLSEAT
+3 KILL APCLANS,AMQQTAX,APCLBDD,APCLCNT,APCLCRIT,APCLCTYP,APCLCUT,APCLDISP,APCLEDD,APCLHIGH,APCLI,APCLNCAN,APCLPTVS,APCLRPT,APCLSEL,APCLSKIP,APCLTCW,APCLTEXT,APCLVAR,APCLVIEN,APCLVREC,DFN,APCLX,APCLY
+4 KILL APCLBT
+5 QUIT
