Routine: BMCRR1P

BMCRR1P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;    [ 09/27/2006  2:05 PM ]

 ;;4.0;REFERRED CARE INFO SYSTEM;**1**;JAN 09, 2006;Build 101

 ;4.0*1 3.24.06 IHS/OIT/FCJ ADDED RUN DATE TO REPORT

START ;

 S BMC80E="==============================================================================="

 S BMC80D="-------------------------------------------------------------------------------"

 S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^TMP("BMCRR1",BMCJOB,BMCBT)) W !,"No referrals to report",! G DONE

 S BMCSORT=0 K BMCQUIT

 F  S BMCSORT=$O(^TMP("BMCRR1",BMCJOB,BMCBT,"DATA HITS",BMCSORT)) Q:BMCSORT=""!($D(BMCQUIT))  D PRINT

 G:$D(BMCQUIT) DONE

 I $Y>(IOSL-6) D HEAD G:$D(BMCQUIT) DONE

DONE ;

 K ^TMP("BMCRR1",BMCJOB,BMCBT)

 D DONE^BMCRLP2

PRINT ;print one referral

 I $G(BMCSPAGE),BMCPG'=1 D HEAD Q:$D(BMCQUIT)

 I $Y>(IOSL-10) D HEAD Q:$D(BMCQUIT)

 W !! I BMCSTYPE="F" W "FACILITY REFERRED TO:  ",BMCSORT,!

 I BMCSTYPE="T" W "TIME SINCE END OF SERVICE:  ",$S(BMCSORT=4:"0-1 Months",BMCSORT=3:"2-3 Months",BMCSORT=2:"4-6 Months",BMCSORT=1:">6 Months",1:"???"),!

 S BMCREF=0 F  S BMCREF=$O(^TMP("BMCRR1",BMCJOB,BMCBT,"DATA HITS",BMCSORT,BMCREF)) Q:BMCREF'=+BMCREF!($D(BMCQUIT))  S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3) D PRINT1

PRINT1 ;

 I $Y>(IOSL-9) D HEAD Q:$D(BMCQUIT)

 W !,$$FMTE^XLFDT($P(BMCRREC,U),"5D")

 W ?12,$E($P(^DPT(DFN,0),U),1,18)

 S BMCHRN="????" I $D(^AUPNPAT(DFN,41,DUZ(2))) S BMCHRN=$P(^AUTTLOC(DUZ(2),0),U,7)_$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)

 W ?32,BMCHRN

 W ?43,$S($P(BMCRREC,U,6):$$PROVINI^XBFUNC1($P(BMCRREC,U,6)),1:"--")

 S BMCFAC=$$FACREF^BMCRLU(BMCREF)

 I BMCFAC="" S BMCFAC="????"

 W ?49,$E(BMCFAC,1,16)

 W ?66,$S($P($G(^BMCREF(BMCREF,11)),U,6)]"":$$FMTE^XLFDT($P($G(^BMCREF(BMCREF,11)),U,6),"5D")_" (A)",$P($G(^BMCREF(BMCREF,11)),U,5):$$FMTE^XLFDT($P($G(^BMCREF(BMCREF,11)),U,5),"5D")_" (E)",1:"")

 S %=$$FMDIFF^XLFDT(DT,$$AVEOS^BMCRLU(BMCREF,"I"))

 S BMCEND=$$AVEOS^BMCRLU(BMCREF)

 W !?5,"Ending Date of Service: "_$S(BMCEND="":"UNKNOWN",1:BMCEND)

 I BMCEND="" S %="UNKNOWN"

 E  S %1=%\365.25,%=$S(%1>2:%1_" YRS",%<31:%1_" DYS",1:%\30_" MOS")

 W ?50,"Time Lapsed: ",%

 W !?5,"Case Manager: ",$S($P(BMCRREC,U,19):$P(^VA(200,$P(BMCRREC,U,19),0),U),1:"")

 W !?5,"ICD Diagnosis Category:  ",$S($P(BMCRREC,U,12):$P(^BMCTDXC($P(BMCRREC,U,12),0),U),1:"")

 W !?5,"CPT Service Category:  ",$S($P(BMCRREC,U,13):$P(^BMCTSVC($P(BMCRREC,U,13),0),U),1:""),!

HEAD ;ENTRY POINT

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BMCQUIT="" Q

HEAD1 ;

 W:$D(IOF) @IOF

HEAD2 ;

 S BMCPG=BMCPG+1

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?72,"Page ",BMCPG,!

 W ?10,"REFERRALS FOR WHICH MEDICAL/COST DATA HAS NOT BEEN RECEIVED",!

 W !,"Report Run Date: ",$$FMTE^XLFDT($$HTFM^XLFDT($H),"1P") ;4.0*1 3.24.06 IHS/OIT/FCJ ADDED RUN DATE TO REPORT

 W !,"REF DATE",?11,"PATIENT NAME",?32," HRN",?43,"PROV",?49,"FACILITY REF TO",?67,"BEG DOS."

 W !,BMC80D

BMCRR1P   ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;    [ 09/27/2006  2:05 PM ]

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

 +2       ;4.0*1 3.24.06 IHS/OIT/FCJ ADDED RUN DATE TO REPORT

START     ;

 +1        SET BMC80E="==============================================================================="

 +2        SET BMC80D="-------------------------------------------------------------------------------"

 +3        SET BMCPG=0

           DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))

           IF '$DATA(^TMP("BMCRR1",BMCJOB,BMCBT))

               WRITE !,"No referrals to report",!

               GOTO DONE

 +4        SET BMCSORT=0

           KILL BMCQUIT

 +5        FOR

               SET BMCSORT=$ORDER(^TMP("BMCRR1",BMCJOB,BMCBT,"DATA HITS",BMCSORT))

               IF BMCSORT=""!($DATA(BMCQUIT))

                   QUIT

               DO PRINT

 +6        IF $DATA(BMCQUIT)

               GOTO DONE

 +7        IF $Y>(IOSL-6)

               DO HEAD

               IF $DATA(BMCQUIT)

                   GOTO DONE

DONE      ;

 +1        KILL ^TMP("BMCRR1",BMCJOB,BMCBT)

 +2        DO DONE^BMCRLP2

 +3        QUIT

PRINT     ;print one referral

 +1        IF $GET(BMCSPAGE)

               IF BMCPG'=1

                   DO HEAD

                   IF $DATA(BMCQUIT)

                       QUIT

 +2        IF $Y>(IOSL-10)

               DO HEAD

               IF $DATA(BMCQUIT)

                   QUIT

 +3        WRITE !!

           IF BMCSTYPE="F"

               WRITE "FACILITY REFERRED TO:  ",BMCSORT,!

 +4        IF BMCSTYPE="T"

               WRITE "TIME SINCE END OF SERVICE:  ",$SELECT(BMCSORT=4:"0-1 Months",BMCSORT=3:"2-3 Months",BMCSORT=2:"4-6 Months",BMCSORT=1:">6 Months",1:"???"),!

 +5        SET BMCREF=0

FOR

               SET BMCREF=$ORDER(^TMP("BMCRR1",BMCJOB,BMCBT,"DATA HITS",BMCSORT,BMCREF))

               IF BMCREF'=+BMCREF!($DATA(BMCQUIT))

                   QUIT

               SET BMCRREC=^BMCREF(BMCREF,0)

               SET DFN=$PIECE(BMCRREC,U,3)

               DO PRINT1

 +6        QUIT

PRINT1    ;

 +1        IF $Y>(IOSL-9)

               DO HEAD

               IF $DATA(BMCQUIT)

                   QUIT

 +2        WRITE !,$$FMTE^XLFDT($PIECE(BMCRREC,U),"5D")

 +3        WRITE ?12,$EXTRACT($PIECE(^DPT(DFN,0),U),1,18)

 +4        SET BMCHRN="????"

           IF $DATA(^AUPNPAT(DFN,41,DUZ(2)))

               SET BMCHRN=$PIECE(^AUTTLOC(DUZ(2),0),U,7)_$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)

 +5        WRITE ?32,BMCHRN

 +6        WRITE ?43,$SELECT($PIECE(BMCRREC,U,6):$$PROVINI^XBFUNC1($PIECE(BMCRREC,U,6)),1:"--")

 +7        SET BMCFAC=$$FACREF^BMCRLU(BMCREF)

 +8        IF BMCFAC=""

               SET BMCFAC="????"

 +9        WRITE ?49,$EXTRACT(BMCFAC,1,16)

 +10       WRITE ?66,$SELECT($PIECE($GET(^BMCREF(BMCREF,11)),U,6)]"":$$FMTE^XLFDT($PIECE($GET(^BMCREF(BMCREF,11)),U,6),"5D")_" (A)",$PIECE($GET(^BMCREF(BMCREF,11)),U,5):$$FMTE^XLFDT($PIECE($GET(^BMCREF(BMCREF,11)),U,5),"5D")_" (E)",1:"")

 +11       SET %=$$FMDIFF^XLFDT(DT,$$AVEOS^BMCRLU(BMCREF,"I"))

 +12       SET BMCEND=$$AVEOS^BMCRLU(BMCREF)

 +13       WRITE !?5,"Ending Date of Service: "_$SELECT(BMCEND="":"UNKNOWN",1:BMCEND)

 +14       IF BMCEND=""

               SET %="UNKNOWN"

 +15      IF '$TEST

               SET %1=%\365.25

               SET %=$SELECT(%1>2:%1_" YRS",%<31:%1_" DYS",1:%\30_" MOS")

 +16       WRITE ?50,"Time Lapsed: ",%

 +17       WRITE !?5,"Case Manager: ",$SELECT($PIECE(BMCRREC,U,19):$PIECE(^VA(200,$PIECE(BMCRREC,U,19),0),U),1:"")

 +18       WRITE !?5,"ICD Diagnosis Category:  ",$SELECT($PIECE(BMCRREC,U,12):$PIECE(^BMCTDXC($PIECE(BMCRREC,U,12),0),U),1:"")

 +19       WRITE !?5,"CPT Service Category:  ",$SELECT($PIECE(BMCRREC,U,13):$PIECE(^BMCTSVC($PIECE(BMCRREC,U,13),0),U),1:""),!

 +20       QUIT

HEAD      ;ENTRY POINT

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET BMCQUIT=""

                       QUIT

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

HEAD2     ;

 +1        SET BMCPG=BMCPG+1

 +2        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +3        WRITE !?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?72,"Page ",BMCPG,!

 +4        WRITE ?10,"REFERRALS FOR WHICH MEDICAL/COST DATA HAS NOT BEEN RECEIVED",!

 +5       ;4.0*1 3.24.06 IHS/OIT/FCJ ADDED RUN DATE TO REPORT

           WRITE !,"Report Run Date: ",$$FMTE^XLFDT($$HTFM^XLFDT($HOROLOG),"1P")

 +6        WRITE !,"REF DATE",?11,"PATIENT NAME",?32," HRN",?43,"PROV",?49,"FACILITY REF TO",?67,"BEG DOS."

 +7        WRITE !,BMC80D

 +8        QUIT

BMCRR1P.m