APCLFPC.m

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