BMCRR10P.m

BMCRR10P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;   

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

 ;IHS/ITSC/FCJ ADDED PRINTING OF SEC REF AND CHG FAC REFERRED TO COLUMN

 ;      TO PRIMARY PAYOR AND ADDED TOTALS

START ;

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

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

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

 S BMCPG=0 I 'BMCSPAGE D @("HEAD"_(2-($E(IOST,1,2)="C-")))

 S BMCFAC="" K BMCQUIT

 F  S BMCFAC=$O(^XTMP("BMCRR10",BMCJOB,BMCBT,"DATA HITS",BMCFAC)) Q:BMCFAC=""!($D(BMCQUIT))  D PRINT

 G:$D(BMCQUIT) DONE

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

DONE ;

 K ^XTMP("BMCRR10",BMCJOB,BMCBT)

 D DONE^BMCRLP2

 Q

PRINT ;print one referral

 I BMCSPAGE=1 D HEAD Q:$D(BMCQUIT)

 I BMCSPAGE'=1 W !

 W !,"FACILITY REFERRED TO:  ",BMCFAC

 S BMCREF=0,BMCCT=0

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

 W !,"TOTAL = ",BMCCT

 Q

PRINT1 ;

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

 W !,$$AVDOS^BMCRLU(BMCREF,"C")

 W ?11,$P(BMCRREC,U,2)

 W $P($G(^BMCREF(BMCREF,1)),U)

 W ?28,$E($P(^DPT(DFN,0),U),1,20)

 W ?49,$S($P(BMCRREC,U,6):$$VAL^XBDIQ1(200,$P(BMCRREC,U,6),1),1:"--")

 W ?54,$E($$VAL^XBDIQ1(90001,BMCREF,.04),1,3)

 W ?61,$$VAL^XBDIQ1(90001,BMCREF,.11)

 S BMCCT=BMCCT+1

 Q

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

 S X="ACTIVE REFERRALS BY FACILITY REFERRED TO"

 W ?(80-$L(X))/2,X,!

 S Y=BMCBD D DD^%DT W ?17,"BEG DATE: "_Y

 S Y=BMCED D DD^%DT W ?40,"END DATE: "_Y,!

 W !,?49,"REF"

 W !,"BEGIN DOS",?11,"REFERRAL #",?28,"PATIENT NAME",?49,"PROV",?54,"TYPE",?59,"PRIM PAYOR"

 W !,BMC80D

 Q

BMCRR10P  ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;   

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

 +2       ;IHS/ITSC/FCJ ADDED PRINTING OF SEC REF AND CHG FAC REFERRED TO COLUMN

 +3       ;      TO PRIMARY PAYOR AND ADDED TOTALS

START     ;

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

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

 +3        IF '$DATA(^XTMP("BMCRR10",BMCJOB,BMCBT))

               SET BMCPG=0

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

               WRITE !,"No referrals to report",!

               GOTO DONE

 +4        SET BMCPG=0

           IF 'BMCSPAGE

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

 +5        SET BMCFAC=""

           KILL BMCQUIT

 +6        FOR 

               SET BMCFAC=$ORDER(^XTMP("BMCRR10",BMCJOB,BMCBT,"DATA HITS",BMCFAC))

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

                   QUIT 

               DO PRINT

 +7        IF $DATA(BMCQUIT)

               GOTO DONE

 +8        IF $Y>(IOSL-6)

               DO HEAD

               IF $DATA(BMCQUIT)

                   GOTO DONE

DONE      ;

 +1        KILL ^XTMP("BMCRR10",BMCJOB,BMCBT)

 +2        DO DONE^BMCRLP2

 +3        QUIT 

PRINT     ;print one referral

 +1        IF BMCSPAGE=1

               DO HEAD

               IF $DATA(BMCQUIT)

                   QUIT 

 +2        IF BMCSPAGE'=1

               WRITE !

 +3        WRITE !,"FACILITY REFERRED TO:  ",BMCFAC

 +4        SET BMCREF=0

           SET BMCCT=0

 +5        FOR 

               SET BMCREF=$ORDER(^XTMP("BMCRR10",BMCJOB,BMCBT,"DATA HITS",BMCFAC,BMCREF))

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

                   QUIT 

               SET BMCRREC=^BMCREF(BMCREF,0)

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

               DO PRINT1

 +6        WRITE !,"TOTAL = ",BMCCT

 +7        QUIT 

PRINT1    ;

 +1        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(BMCQUIT)

                   QUIT 

 +2        WRITE !,$$AVDOS^BMCRLU(BMCREF,"C")

 +3        WRITE ?11,$PIECE(BMCRREC,U,2)

 +4        WRITE $PIECE($GET(^BMCREF(BMCREF,1)),U)

 +5        WRITE ?28,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20)

 +6        WRITE ?49,$SELECT($PIECE(BMCRREC,U,6):$$VAL^XBDIQ1(200,$PIECE(BMCRREC,U,6),1),1:"--")

 +7        WRITE ?54,$EXTRACT($$VAL^XBDIQ1(90001,BMCREF,.04),1,3)

 +8        WRITE ?61,$$VAL^XBDIQ1(90001,BMCREF,.11)

 +9        SET BMCCT=BMCCT+1

 +10       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        SET X="ACTIVE REFERRALS BY FACILITY REFERRED TO"

 +5        WRITE ?(80-$LENGTH(X))/2,X,!

 +6        SET Y=BMCBD

           DO DD^%DT

           WRITE ?17,"BEG DATE: "_Y

 +7        SET Y=BMCED

           DO DD^%DT

           WRITE ?40,"END DATE: "_Y,!

 +8        WRITE !,?49,"REF"

 +9        WRITE !,"BEGIN DOS",?11,"REFERRAL #",?28,"PATIENT NAME",?49,"PROV",?54,"TYPE",?59,"PRIM PAYOR"

 +10       WRITE !,BMC80D

 +11       QUIT