- 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
