- BMCRR6 ; IHS/PHXAO/TMJ - list patients for which medical and/or cost data has not been received ;
- ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- ;
- ;
- ;
- START ;
- W:$D(IOF) @IOF W !,"This report presents, by facility referred to, timeliness of receiving",!,"discharge letters. You will be given the number of letters received",!,"in under 1 month of discharge date, in 2-3 months, in 4-6 months"
- W !,"in in > 6 months.",!
- W !!,"Please enter the range of referral initiated dates that you are interested in.",!
- W !,"Inhouse Referrals are exlcuded",!
- D ;DATE RANGE
- BD ;get beginning date
- W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning Referral Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G XIT
- S BMCBD=Y
- ED ;get ending date
- W ! S DIR(0)="D^"_BMCBD_"::EP",DIR("A")="Enter ending Referral Date" D ^DIR 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
- ;
- ZIS ;call to XBDBQUE
- K BMCOPT
- W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
- I $D(DIRUT) S BMCQUIT="" Q
- S BMCOPT=Y
- G:$G(BMCQUIT) D
- I $G(BMCOPT)="B" D BROWSE,XIT Q
- S XBRP="^BMCRR6P",XBRC="^BMCRR61",XBRX="XIT^BMCRR6",XBNS="BMC"
- D ^XBDBQUE
- D XIT
- Q
- BROWSE ;
- S XBRP="VIEWR^XBLM(""^BMCRR6P"")"
- S XBRC="^BMCRR61",XBRX="XIT^BMCRR6",XBIOP=0 D ^XBDBQUE
- Q
- XIT ;EP - CALLED FROM BMCRR6
- D KILL^AUPNPAT
- K BMCBD,BMCBT,BMCBTH,BMCD,BMCED,BMCET,BMCF,BMCJOB,BMCODAT,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD,BMCSVCD
- K DA,DIR,DIRUT,DTOUT,DUOUT,J,K,T,X,X1,X2,Y,Z,%
- Q
- BMCRR6 ; IHS/PHXAO/TMJ - list patients for which medical and/or cost data has not been received ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- +2 ;
- +3 ;
- +4 ;
- START ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- WRITE !,"This report presents, by facility referred to, timeliness of receiving",!,"discharge letters. You will be given the number of letters received",!,"in under 1 month of discharge date, in 2-3 months, in 4-6 months"
- +2 WRITE !,"in in > 6 months.",!
- +3 WRITE !!,"Please enter the range of referral initiated dates that you are interested in.",!
- +4 WRITE !,"Inhouse Referrals are exlcuded",!
- D ;DATE RANGE
- BD ;get beginning date
- +1 WRITE !
- SET DIR(0)="D^::EP"
- SET DIR("A")="Enter beginning Referral Date"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO XIT
- +3 SET BMCBD=Y
- ED ;get ending date
- +1 WRITE !
- SET DIR(0)="D^"_BMCBD_"::EP"
- SET DIR("A")="Enter ending Referral Date"
- DO ^DIR
- 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 ;
- ZIS ;call to XBDBQUE
- +1 KILL BMCOPT
- +2 WRITE !
- SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
- SET DIR("A")="Do you wish to"
- SET DIR("B")="P"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- SET BMCQUIT=""
- QUIT
- +4 SET BMCOPT=Y
- +5 IF $GET(BMCQUIT)
- GOTO D
- +6 IF $GET(BMCOPT)="B"
- DO BROWSE
- DO XIT
- QUIT
- +7 SET XBRP="^BMCRR6P"
- SET XBRC="^BMCRR61"
- SET XBRX="XIT^BMCRR6"
- SET XBNS="BMC"
- +8 DO ^XBDBQUE
- +9 DO XIT
- +10 QUIT
- BROWSE ;
- +1 SET XBRP="VIEWR^XBLM(""^BMCRR6P"")"
- +2 SET XBRC="^BMCRR61"
- SET XBRX="XIT^BMCRR6"
- SET XBIOP=0
- DO ^XBDBQUE
- +3 QUIT
- XIT ;EP - CALLED FROM BMCRR6
- +1 DO KILL^AUPNPAT
- +2 KILL BMCBD,BMCBT,BMCBTH,BMCD,BMCED,BMCET,BMCF,BMCJOB,BMCODAT,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD,BMCSVCD
- +3 KILL DA,DIR,DIRUT,DTOUT,DUOUT,J,K,T,X,X1,X2,Y,Z,%
- +4 QUIT
