- BMCTEN ; IHS/PHXAO/TMJ - TOP TEN POVS ;
- ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- ;
- W !!?15,"***** RCIS FREQUENCY OF DIAGNOSES 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 Referral 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 Referral 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
- S Y=BMCBD D DD^%DT S BMCBDD=Y S Y=BMCED D DD^%DT S BMCEDD=Y
- ;
- 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
- I $D(DIRUT) G GETDATES
- S BMCLNO=Y
- SCREEN ;
- 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
- POV ;
- K BMCPRIM,BMCALL
- S DIR(0)="SO^P:Primary Diagnosis of Referral;A:All Diagnosis of Referral (Primary and Secondary)",DIR("A")="Report should include"
- S DIR("?")="If you wish to count only the primary purpose of Referral enter a 'P'. To include ALL purpose of visits enter an 'A'. " D ^DIR K DIR
- I $D(DIRUT) S BMCQUIT="" G SCREEN
- I Y="A" S BMCALL=""
- I Y="P" S BMCPRIM=""
- ;
- CHRT ;
- S DIR(0)="S^L:List of items with Counts;B:Bar Chart (132 col)",DIR("A")="Select TYPE OF OUTPUT",DIR("B")="L" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G POV
- S BMCCHRT=Y
- ZIS ;
- K BMCANS,BMCCNT,BMCCRIT,BMCCUT,AMQQTAX,BMCDISP,BMCHIGH,BMCI,BMCCAN,BMCSEL,BMCSKIP,BMCTEXT,BMCVAR,BMCVIEN,BMCRREC
- S XBRC="^BMCTEN1",XBRP="^BMCTENP",XBNS="BMC",XBRX="EXIT^BMCTEN"
- D ^XBDBQUE
- D EXIT
- Q
- EXIT ;
- D EXIT^BMCTEN1
- Q
- ;
- ;
- ;
- ;
- BMCTEN ; IHS/PHXAO/TMJ - TOP TEN POVS ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- +2 ;
- +3 WRITE !!?15,"***** RCIS FREQUENCY OF DIAGNOSES 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 Referral 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 Referral 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 SET Y=BMCBD
- DO DD^%DT
- SET BMCBDD=Y
- SET Y=BMCED
- DO DD^%DT
- SET BMCEDD=Y
- +6 ;
- +7 SET BMCNCAN=1
- DO ADD^BMCRL01
- IF $DATA(BMCQUIT)
- DO DEL^BMCRL
- KILL BMCQUIT
- GOTO GETDATES
- 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 IF $DATA(DIRUT)
- GOTO GETDATES
- +2 SET BMCLNO=Y
- SCREEN ;
- +1 SET BMCTCW=0
- SET BMCPTVS="R"
- SET BMCTYPE="D"
- SET BMCCTYP="T"
- +2 KILL ^BMCRTMP(BMCRPT,11)
- SET BMCCNTL="S"
- DO ^BMCRL4
- KILL BMCCNTL
- IF $DATA(BMCQUIT)
- DO DEL^BMCRL
- GOTO GETDATES
- POV ;
- +1 KILL BMCPRIM,BMCALL
- +2 SET DIR(0)="SO^P:Primary Diagnosis of Referral;A:All Diagnosis of Referral (Primary and Secondary)"
- SET DIR("A")="Report should include"
- +3 SET DIR("?")="If you wish to count only the primary purpose of Referral enter a 'P'. To include ALL purpose of visits enter an 'A'. "
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)
- SET BMCQUIT=""
- GOTO SCREEN
- +5 IF Y="A"
- SET BMCALL=""
- +6 IF Y="P"
- SET BMCPRIM=""
- +7 ;
- CHRT ;
- +1 SET DIR(0)="S^L:List of items with Counts;B:Bar Chart (132 col)"
- SET DIR("A")="Select TYPE OF OUTPUT"
- SET DIR("B")="L"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO POV
- +3 SET BMCCHRT=Y
- ZIS ;
- +1 KILL BMCANS,BMCCNT,BMCCRIT,BMCCUT,AMQQTAX,BMCDISP,BMCHIGH,BMCI,BMCCAN,BMCSEL,BMCSKIP,BMCTEXT,BMCVAR,BMCVIEN,BMCRREC
- +2 SET XBRC="^BMCTEN1"
- SET XBRP="^BMCTENP"
- SET XBNS="BMC"
- SET XBRX="EXIT^BMCTEN"
- +3 DO ^XBDBQUE
- +4 DO EXIT
- +5 QUIT
- EXIT ;
- +1 DO EXIT^BMCTEN1
- +2 QUIT
- +3 ;
- +4 ;
- +5 ;
- +6 ;