BMCPXTEN.m

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

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

 ;

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

 D EXIT

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

 ;

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 ;

 K APCLANS,APCLCNT,APCLCRIT,AMQQTAX,APCLCUT,APCLDISP,APCLHIGH,APCLI,APCLNCAN,APCLSEL,APCLSKIP,APCLTEXT,APCLVAR,APCLVIEN,APCLVREC

 S XBRC="^APCLFPR1",XBRP="^APCLFPRP",XBNS="APCL",XBRX="EXIT^APCLFPR"

 D ^XBDBQUE

 D EXIT

 Q

EXIT ;

 K APCLBD,APCLED,APCLDOB1,APCLDOB2,APCLSEX,X,Y,Z,%,APCLFAC,APCLJOB,APCLLNO,ZTIO,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

 ;

 ;

 ;

 ;

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

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

 +2       ;

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

 +4        DO EXIT

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 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       ;

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       ;

 +1        KILL APCLANS,APCLCNT,APCLCRIT,AMQQTAX,APCLCUT,APCLDISP,APCLHIGH,APCLI,APCLNCAN,APCLSEL,APCLSKIP,APCLTEXT,APCLVAR,APCLVIEN,APCLVREC

 +2        SET XBRC="^APCLFPR1"

           SET XBRP="^APCLFPRP"

           SET XBNS="APCL"

           SET XBRX="EXIT^APCLFPR"

 +3        DO ^XBDBQUE

 +4        DO EXIT

 +5        QUIT 

EXIT      ;

 +1        KILL APCLBD,APCLED,APCLDOB1,APCLDOB2,APCLSEX,X,Y,Z,%,APCLFAC,APCLJOB,APCLLNO,ZTIO,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 

 +6       ;

 +7       ;

 +8       ;

 +9       ;