BMCFREQ.m

BMCFREQ ; IHS/PHXAO/TMJ - TOP FPR PROCEDURES ;    

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

 W !!?20,"*****  FREQUENCY OF RCIS PROCEDURES REPORT  *****",!!

 W !,"NOTE: Report does not include Secondary referrals",!

 D EXIT

 S BMCTYPR="P"

GETDATES ;

BD ;get beginning date

 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 BMCBD=Y

ED ;get ending date

 W ! S DIR(0)="DA^"_BMCBD_":DT:EP",DIR("A")="Enter ending Visit Date:  " S Y=BMCBD 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 BMCED=Y

 S X1=BMCBD,X2=-1 D C^%DTC S BMCSD=X

 I $D(DIRUT) G GETDATES

 S BMCNCAN=1 D ADD^BMCRL01 I $D(BMCQUIT) D DEL^BMCRL K BMCQUIT G GETDATES

 ;

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 BMCLNO=Y

 S Y=BMCBD D DD^%DT S BMCBDD=Y S Y=BMCED D DD^%DT S BMCEDD=Y

 S BMCTCW=0,BMCPTVS="R",BMCTYPE="D",BMCCTYP="T"

 K ^BMCRTMP(BMCRPT,11) S BMCCNTL="S" D ^BMCRL4 K BMCCNTL I $D(BMCQUIT) D DEL^BMCRL G GETDATES

ZIS ;

 K BMCANS,BMCCNT,BMCCRIT,AMQQTAX,BMCCUT,BMCDISP,BMCHIGH,BMCI,BMCNCAN,BMCSEL,BMCSKIP,BMCTEXT,BMCVAR,BMCVIEN,BMCRREC

 S XBRC="^BMCFREQ1",XBRP="^BMCFREQP",XBNS="BMC",XBRX="EXIT^BMCFREQ"

 D ^XBDBQUE

 D EXIT

 Q

EXIT ;

 K BMCBD,BMCED,BMCDOB1,BMCDOB2,BMCSEX,X,Y,Z,%,BMCFAC,BMCJOB,BMCLNO,ZTIO,ZTQUEUED,BMCCLN,BMCTYPE,BMCSC,BMCC,BMCPREC,BMCSD,BMCA,BMCC,BMCF,BMCGTOT,BMCPRC,BMCTOT,BMCD,BMCPRCN,BMCET

 K BMCQUIT,BMCAPC,BMCDATE,BMCPOV,BMCVSIT,BMCNOCK,BMCTOT,BMCPROV,BMCVTOT,BMCLINO,L,I,BMCCMA,BMCPOVN,BMCV,BMCTYPP,BMCSCP,BMCPRIM,BMCALL,BMCSEAT

 K BMCANS,AMQQTAX,BMCBDD,BMCCNT,BMCCRIT,BMCCTYP,BMCCUT,BMCDISP,BMCEDD,BMCHIGH,BMCI,BMCNCAN,BMCPTVS,BMCRPT,BMCSEL,BMCSKIP,BMCTCW,BMCTEXT,BMCVAR,BMCVIEN,BMCRREC,DFN,BMCX,BMCY,BMCTYPR

 K BMCBT

 Q

 ;

 ;

 ;

 ;

BMCFREQ   ; IHS/PHXAO/TMJ - TOP FPR PROCEDURES ;    

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3        WRITE !!?20,"*****  FREQUENCY OF RCIS PROCEDURES REPORT  *****",!!

 +4        WRITE !,"NOTE: Report does not include Secondary referrals",!

 +5        DO EXIT

 +6        SET BMCTYPR="P"

GETDATES  ;

BD        ;get beginning date

 +1        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

 +2        IF $DATA(DIRUT)

               GOTO EXIT

 +3        SET BMCBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="DA^"_BMCBD_":DT:EP"

           SET DIR("A")="Enter ending Visit Date:  "

           SET Y=BMCBD

           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 BMCED=Y

 +4        SET X1=BMCBD

           SET X2=-1

           DO C^%DTC

           SET BMCSD=X

 +5        IF $DATA(DIRUT)

               GOTO GETDATES

 +6        SET BMCNCAN=1

           DO ADD^BMCRL01

           IF $DATA(BMCQUIT)

               DO DEL^BMCRL

               KILL BMCQUIT

               GOTO GETDATES

 +7       ;

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 BMCLNO=Y

 +2        SET Y=BMCBD

           DO DD^%DT

           SET BMCBDD=Y

           SET Y=BMCED

           DO DD^%DT

           SET BMCEDD=Y

 +3        SET BMCTCW=0

           SET BMCPTVS="R"

           SET BMCTYPE="D"

           SET BMCCTYP="T"

 +4        KILL ^BMCRTMP(BMCRPT,11)

           SET BMCCNTL="S"

           DO ^BMCRL4

           KILL BMCCNTL

           IF $DATA(BMCQUIT)

               DO DEL^BMCRL

               GOTO GETDATES

ZIS       ;

 +1        KILL BMCANS,BMCCNT,BMCCRIT,AMQQTAX,BMCCUT,BMCDISP,BMCHIGH,BMCI,BMCNCAN,BMCSEL,BMCSKIP,BMCTEXT,BMCVAR,BMCVIEN,BMCRREC

 +2        SET XBRC="^BMCFREQ1"

           SET XBRP="^BMCFREQP"

           SET XBNS="BMC"

           SET XBRX="EXIT^BMCFREQ"

 +3        DO ^XBDBQUE

 +4        DO EXIT

 +5        QUIT 

EXIT      ;

 +1        KILL BMCBD,BMCED,BMCDOB1,BMCDOB2,BMCSEX,X,Y,Z,%,BMCFAC,BMCJOB,BMCLNO,ZTIO,ZTQUEUED,BMCCLN,BMCTYPE,BMCSC,BMCC,BMCPREC,BMCSD,BMCA,BMCC,BMCF,BMCGTOT,BMCPRC,BMCTOT,BMCD,BMCPRCN,BMCET

 +2        KILL BMCQUIT,BMCAPC,BMCDATE,BMCPOV,BMCVSIT,BMCNOCK,BMCTOT,BMCPROV,BMCVTOT,BMCLINO,L,I,BMCCMA,BMCPOVN,BMCV,BMCTYPP,BMCSCP,BMCPRIM,BMCALL,BMCSEAT

 +3        KILL BMCANS,AMQQTAX,BMCBDD,BMCCNT,BMCCRIT,BMCCTYP,BMCCUT,BMCDISP,BMCEDD,BMCHIGH,BMCI,BMCNCAN,BMCPTVS,BMCRPT,BMCSEL,BMCSKIP,BMCTCW,BMCTEXT,BMCVAR,BMCVIEN,BMCRREC,DFN,BMCX,BMCY,BMCTYPR

 +4        KILL BMCBT

 +5        QUIT 

 +6       ;

 +7       ;

 +8       ;

 +9       ;