- BMCRR7P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;
- ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- START ;
- S BMC80E="==============================================================================="
- S BMC80D="-------------------------------------------------------------------------------"
- S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^XTMP("BMCRR7",BMCJOB,BMCBT)) W !,"No referrals to report",! G DONE
- S BMCSORT="" K BMCQUIT
- F S BMCSORT=$O(^XTMP("BMCRR7",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 ^XTMP("BMCRR7",BMCJOB,BMCBT)
- D DONE^BMCRLP2
- Q
- PRINT ;print one referral
- I $G(BMCSPAGE),BMCPG'=1 D HEAD Q:$D(BMCQUIT)
- S BMCREF=0 F S BMCREF=$O(^XTMP("BMCRR7",BMCJOB,BMCBT,"DATA HITS",BMCSORT,BMCREF)) Q:BMCREF'=+BMCREF!($D(BMCQUIT)) S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3) D PRINT1
- Q
- PRINT1 ;
- I $Y>(IOSL-5) 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):$$VAL^XBDIQ1(200,$P(BMCRREC,U,6),1),1:"--")
- S BMCFAC=$$FACREF^BMCRLU(BMCREF)
- I BMCFAC="" S BMCFAC="????"
- W ?49,$E(BMCFAC,1,16)
- W ?67,$S($P($G(^BMCREF(BMCREF,11)),U,6)]"":$$FMTE^XLFDT($P($G(^BMCREF(BMCREF,11)),U,6),"2D")_" (A)",$P($G(^BMCREF(BMCREF,11)),U,5):$$FMTE^XLFDT($P($G(^BMCREF(BMCREF,11)),U,5),"2D")_" (E)",1:"")
- W !?5,"# Visits:",?16,$P($G(^BMCREF(BMCREF,11)),U,11)
- W ?20,"Type: ",$$VAL^XBDIQ1(90001,BMCREF,.04)
- W ?50,"Case Manager: ",$E($$CASEMAN^BMCRLU(BMCREF),1,15)
- W !,?5,"IHS Referring Physician: "_$$VAL^XBDIQ1(90001,BMCREF,.06)
- I $P($G(^BMCREF(BMCREF,12)),U)="" W ! Q
- S BMCP=$$GET1^DIQ(90001,BMCREF,1201,"","BMCP")
- S DIWL=1,DIWF="C66" S X=BMCP D ^DIWP
- S (C,Z)=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z!($D(BMCQUIT)) S C=C+1 D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W !?6,^UTILITY($J,"W",DIWL,Z,0)
- W !
- K DIWL,DIWR,DIWF,Z,^UTILITY($J,"W")
- 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,!
- W ?29,"OUTPATIENT REFERRAL LOG",!
- W !,"REF DATE",?11,"PATIENT NAME",?32," HRN",?43,"PROV",?49,"FACILITY REF TO",?67," D.O.S."
- W !,BMC80D
- Q
- BMCRR7P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- START ;
- +1 SET BMC80E="==============================================================================="
- +2 SET BMC80D="-------------------------------------------------------------------------------"
- +3 SET BMCPG=0
- DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
- IF '$DATA(^XTMP("BMCRR7",BMCJOB,BMCBT))
- WRITE !,"No referrals to report",!
- GOTO DONE
- +4 SET BMCSORT=""
- KILL BMCQUIT
- +5 FOR
- SET BMCSORT=$ORDER(^XTMP("BMCRR7",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 ^XTMP("BMCRR7",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 SET BMCREF=0
- FOR
- SET BMCREF=$ORDER(^XTMP("BMCRR7",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
- +3 QUIT
- PRINT1 ;
- +1 IF $Y>(IOSL-5)
- 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):$$VAL^XBDIQ1(200,$PIECE(BMCRREC,U,6),1),1:"--")
- +7 SET BMCFAC=$$FACREF^BMCRLU(BMCREF)
- +8 IF BMCFAC=""
- SET BMCFAC="????"
- +9 WRITE ?49,$EXTRACT(BMCFAC,1,16)
- +10 WRITE ?67,$SELECT($PIECE($GET(^BMCREF(BMCREF,11)),U,6)]"":$$FMTE^XLFDT($PIECE($GET(^BMCREF(BMCREF,11)),U,6),"2D")_" (A)",$PIECE($GET(^BMCREF(BMCREF,11)),U,5):$$FMTE^XLFDT($PIECE($GET(^BMCREF(BMCREF,11)),U,5),"2D")_" (E)",1:"")
- +11 WRITE !?5,"# Visits:",?16,$PIECE($GET(^BMCREF(BMCREF,11)),U,11)
- +12 WRITE ?20,"Type: ",$$VAL^XBDIQ1(90001,BMCREF,.04)
- +13 WRITE ?50,"Case Manager: ",$EXTRACT($$CASEMAN^BMCRLU(BMCREF),1,15)
- +14 WRITE !,?5,"IHS Referring Physician: "_$$VAL^XBDIQ1(90001,BMCREF,.06)
- +15 IF $PIECE($GET(^BMCREF(BMCREF,12)),U)=""
- WRITE !
- QUIT
- +16 SET BMCP=$$GET1^DIQ(90001,BMCREF,1201,"","BMCP")
- +17 SET DIWL=1
- SET DIWF="C66"
- SET X=BMCP
- DO ^DIWP
- +18 SET (C,Z)=0
- FOR
- SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
- IF Z'=+Z!($DATA(BMCQUIT))
- QUIT
- SET C=C+1
- IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- WRITE !?6,^UTILITY($JOB,"W",DIWL,Z,0)
- +19 WRITE !
- +20 KILL DIWL,DIWR,DIWF,Z,^UTILITY($JOB,"W")
- +21 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 ?29,"OUTPATIENT REFERRAL LOG",!
- +5 WRITE !,"REF DATE",?11,"PATIENT NAME",?32," HRN",?43,"PROV",?49,"FACILITY REF TO",?67," D.O.S."
- +6 WRITE !,BMC80D
- +7 QUIT
