Routine: BMCRR18

BMCRR18 ; IHS/PHXAO/TMJ - list patients for Inpatient Discharge Comments ;

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

 W !?10,"********  DISCHARGE LISTING BY ENDING DATE OF SERVICE  ********",!

 W !!,"The report will print a list of all Inpatient referrals' ENDING DATE of Service",!,"Range entered by the user.  This report will list Patient "

 W "Name, Health Record #,",!,"Age, Community, Actual Beginning Dt of Service,"

 W " Facility Referred To, Purpose",!,"of Referral, Actual Ending Dt of Service,"

 W " & Los",!!

 W "Selecting the Detailed Patient Listing will provide a separate page for each",!,"Referral & also includes the Discharge Comments."

 W !!,"The Summary Report Listing will include all Discharges on one",!,"report, but will not include the Discharge Comments.",!

 W !,"Inhouse Referrals are NOT included.",!

BD ;get beginning END OF SERVICE date

 W !! S DIR(0)="D^::EP",DIR("A")="Enter beginning ENDING DT OF SERVICE Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S BMCBD=Y

ED ;get ending END OF SERVICE date

 W ! S DIR(0)="D^"_BMCBD_"::EP",DIR("A")="Enter ending ENDING OF SERVICE 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

OUTPUT ;Print Output Summary or Detail

 S BMCOUTP=""

 S DIR(0)="S^D:Detailed Patient Listing;S:Summary Report Listing",DIR("A")="Select Report Printing",DIR("B")="D" K DA D ^DIR K DIR

 I $D(DIRUT) G XIT

 S BMCOUTP=Y

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

 I $G(BMCOPT)="B" D BROWSE,XIT Q

 S XBRP="^BMCRR18P",XBRC="^BMCRR181",XBRX="XIT^BMCRR18",XBNS="BMC"

 D ^XBDBQUE

 D XIT

BROWSE ;

 S XBRP="VIEWR^XBLM(""^BMCRR18P"")"

 S XBRC="^BMCRR181",XBRX="XIT^BMCRR18",XBIOP=0 D ^XBDBQUE

XIT ;EP - CALLED FROM BMCRR18

 K BMCBD,BMCBT,BMCBTH,BMCCOL,BMCD,BMCDA,BMCDATE,BMCED,BMCET,BMCFILE,BMCG,BMCHRN,BMCIOM,BMCJOB,BMCNODE,BMCODAT,BMCOPT,BMCP,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD,BMCWP,BMCX,BMCC,BMCOUTP

 K BMCRNUMB

 D KILL^AUPNPAT

 K %,C,D0,DA,DFN,DI,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,F,I,X,Y,Z

BMCRR18   ; IHS/PHXAO/TMJ - list patients for Inpatient Discharge Comments ;

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

 +2       ;

 +3       ;

 +4       ;

 +5        WRITE !?10,"********  DISCHARGE LISTING BY ENDING DATE OF SERVICE  ********",!

 +6        WRITE !!,"The report will print a list of all Inpatient referrals' ENDING DATE of Service",!,"Range entered by the user.  This report will list Patient "

 +7        WRITE "Name, Health Record #,",!,"Age, Community, Actual Beginning Dt of Service,"

 +8        WRITE " Facility Referred To, Purpose",!,"of Referral, Actual Ending Dt of Service,"

 +9        WRITE " & Los",!!

 +10       WRITE "Selecting the Detailed Patient Listing will provide a separate page for each",!,"Referral & also includes the Discharge Comments."

 +11       WRITE !!,"The Summary Report Listing will include all Discharges on one",!,"report, but will not include the Discharge Comments.",!

 +12       WRITE !,"Inhouse Referrals are NOT included.",!

BD        ;get beginning END OF SERVICE date

 +1        WRITE !!

           SET DIR(0)="D^::EP"

           SET DIR("A")="Enter beginning ENDING DT OF SERVICE Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET BMCBD=Y

ED        ;get ending END OF SERVICE date

 +1        WRITE !

           SET DIR(0)="D^"_BMCBD_"::EP"

           SET DIR("A")="Enter ending ENDING OF SERVICE 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       ;

OUTPUT    ;Print Output Summary or Detail

 +1        SET BMCOUTP=""

 +2        SET DIR(0)="S^D:Detailed Patient Listing;S:Summary Report Listing"

           SET DIR("A")="Select Report Printing"

           SET DIR("B")="D"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET BMCOUTP=Y

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

 +6        IF $GET(BMCOPT)="B"

               DO BROWSE

               DO XIT

               QUIT

 +7        SET XBRP="^BMCRR18P"

           SET XBRC="^BMCRR181"

           SET XBRX="XIT^BMCRR18"

           SET XBNS="BMC"

 +8        DO ^XBDBQUE

 +9        DO XIT

 +10       QUIT

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""^BMCRR18P"")"

 +2        SET XBRC="^BMCRR181"

           SET XBRX="XIT^BMCRR18"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

XIT       ;EP - CALLED FROM BMCRR18

 +1        KILL BMCBD,BMCBT,BMCBTH,BMCCOL,BMCD,BMCDA,BMCDATE,BMCED,BMCET,BMCFILE,BMCG,BMCHRN,BMCIOM,BMCJOB,BMCNODE,BMCODAT,BMCOPT,BMCP,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD,BMCWP,BMCX,BMCC,BMCOUTP

 +2        KILL BMCRNUMB

 +3        DO KILL^AUPNPAT

 +4        KILL %,C,D0,DA,DFN,DI,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,F,I,X,Y,Z

 +5        QUIT

BMCRR18.m