- BMCRR8P ; IHS/PHXAO/TMJ - PRNT BILL VSTS;POT HIGH COST CASES ; [ 09/27/2006 2:16 PM ]
- ;;4.0;REFERRED CARE INFO SYSTEM;**1,3,9**;JAN 09, 2006;Build 101
- ;4.0*1 3.24.06 IHS/OIT/FCJ PRINT BEG AND END DT
- ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
- ;4.0*9 11.11.2012 IHS.OIT.FCJ CHG FOR ICD-10
- ;
- START ;
- S BMC80E="==============================================================================="
- S BMC80D="-------------------------------------------------------------------------------"
- S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^XTMP("BMCRR8",BMCJOB,BMCBTH)) W !,"No referrals to report",! G DONE
- S BMCPN="" K BMCQUIT
- F S BMCPN=$O(^XTMP("BMCRR8",BMCJOB,BMCBTH,"DATA HITS",BMCPN)) Q:BMCPN=""!($D(BMCQUIT)) D DFN
- G:$D(BMCQUIT) DONE
- I $Y>(IOSL-6) D HEAD G:$D(BMCQUIT) DONE
- DONE ;
- K ^XTMP("BMCRR8",BMCJOB,BMCBTH)
- D DONE^BMCRLP2
- Q
- DFN ;
- S DFN="" F S DFN=$O(^XTMP("BMCRR8",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN)) Q:DFN=""!($D(BMCQUIT)) D PRINT
- Q
- PRINT ;print one referral
- S BMCREF=0 F S BMCREF=$O(^XTMP("BMCRR8",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN,BMCREF)) Q:BMCREF'=+BMCREF!($D(BMCQUIT)) S BMCRREC=^BMCREF(BMCREF,0) D PRINT1
- Q
- PRINT1 ;
- I $Y>(IOSL-5) D HEAD Q:$D(BMCQUIT)
- W !,$$AVDOS^BMCRLU(BMCREF,"C")
- W ?13,$$VALI^XBDIQ1(90001,BMCREF,.15)
- 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 ?17,BMCHRN
- 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)
- S BMCFAC=$$FACREF^BMCRLU(BMCREF)
- I BMCFAC="" S BMCFAC="????"
- W ?59,$E(BMCFAC,1,20)
- I $$VAL^XBDIQ1(90001,BMCREF,.09)]"" W !?59,$E($$VAL^XBDIQ1(90001,BMCREF,.09),1,20)
- PURPOSE ;
- I $Y>(IOSL-5) D HEAD Q:$D(BMCQUIT)
- K BMCP W !,"Purpose:"
- S BMCP=$$GET1^DIQ(90001,BMCREF,1,"","BMCP")
- S DIWL=1,DIWF="C66",BMCX=0 F S BMCX=$O(BMCP(BMCX)) Q:BMCX'=+BMCX!($D(BMCQUIT)) D
- .S X=BMCP(BMCX) 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:C'=1 ! W ?12,^UTILITY($J,"W",DIWL,Z,0)
- K DIWL,DIWR,DIWF,Z,^UTILITY($J,"W"),BMCNODE,BMCFILE,BMCG,BMCCOL
- DX ;
- I $Y>(IOSL-5) D HEAD Q:$D(BMCQUIT)
- I $D(^BMCDX("AD",BMCREF)) D I 1
- .W !,"Dx:"
- .S BMCDOS=$$AVDOS^BMCRLU(BMCREF,"N") ;BMC*4.0*9
- .S (C,X)=0 F S X=$O(^BMCDX("AD",BMCREF,X)) Q:X'=+X!($D(BMCQUIT)) D
- ..;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES;4.0*9 11.11.2012 IHS.OIT.FCJ CHG FOR ICD-10
- ..;S C=C+1,BMCD=+^BMCDX(X,0) D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W:C'=1 ! W ?12,$P(^ICD9(BMCD,0),U),?19," - ",$E($P(^ICD9(BMCD,0),U,3),1,50)
- ..;S C=C+1,BMCD=+^BMCDX(X,0) D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W:C'=1 ! W ?12,$P($$ICDDX^ICDCODE(BMCD,0),U,2),?19," - ",$E($P($$ICDDX^ICDCODE(BMCD,0),U,4),1,50)
- ..S C=C+1,BMCD=+^BMCDX(X,0) D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W:C'=1 ! W ?12,$P($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,2),?19," - ",$E($P($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,4),1,50)
- E D
- .W !,"Dx Cat:",?12,$$GET1^DIQ(90001,BMCREF,.12)
- PROC ;
- I $Y>(IOSL-5) D HEAD Q:$D(BMCQUIT)
- I $D(^BMCPX("AD",BMCREF)) D I 1
- .W !,"Proc:"
- .S (C,X)=0
- .;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
- .;F S X=$O(^BMCPX("AD",BMCREF,X)) Q:X'=+X!($D(BMCQUIT)) S C=C+1,BMCD=+^BMCPX(X,0) D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W:C'=1 ! W ?12,$P(^ICPT(BMCD,0),U),?19," - ",$E($P(^ICPT(BMCD,0),U,2),1,50)
- .F S X=$O(^BMCPX("AD",BMCREF,X)) Q:X'=+X!($D(BMCQUIT)) S C=C+1,BMCD=+^BMCPX(X,0) D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W:C'=1 ! W ?12,$P($$CPT^ICPTCOD(BMCD,0),U,2),?19," - ",$E($P($$CPT^ICPTCOD(BMCD,0),U,3),1,50)
- E D
- .W !,"Srv Cat:",?12,$$GET1^DIQ(90001,BMCREF,.13)
- ;
- THIRD ;Third Party Coverage
- ;W !
- Q:'$G(DFN)
- S BMCRDATE=DT
- NEW BMCMSG,BMCI,BMCX
- S BMCI=1
- S BMCX=$$BEN^AUPNPAT(DFN,"E")
- S:BMCX="" BMCX="UNKNOWN"
- S BMCMSG(BMCI)="CLASSIFICATION/BENEFICIARY IS: "_BMCX,BMCI=+BMCI+1
- S BMCX=$$ELIGSTAT^AUPNPAT(DFN,"E")
- S:BMCX="" BMCX="UNKNOWN"
- S BMCMSG(BMCI)="ELIGIBILITY STATUS IS: "_BMCX,BMCI=+BMCI+1
- NEW BMCELG
- S BMCELG=BMCI
- I $$MCR^AUPNPAT(DFN,BMCRDATE) S BMCMSG(BMCI)="PATIENT HAS MEDICARE",BMCI=BMCI+1
- ;I $$MCD^AUPNPAT(DFN,BMCRDATE) S BMCMSG(BMCI)="PATIENT HAS MEDICAID--",BMCI=BMCI+1
- S BMCX=$$MCDPN^AUPNPAT(DFN,BMCRDATE,"E")
- S:BMCX="" BMCX="UNKNOWN"
- I $$MCD^AUPNPAT(DFN,BMCRDATE) S BMCMSG(BMCI)="PATIENT HAS MEDICAID-PLAN NAME: "_BMCX,BMCI=+BMCI+1
- ;I $$PI^AUPNPAT(DFN,BMCRDATE) S BMCMSG(BMCI)="PATIENT HAS PRIVATE INSURANCE--",BMCI=BMCI+1
- S BMCX=$$PIN^AUPNPAT(DFN,BMCRDATE,"E")
- S:BMCX="" BMCX="UNKNOWN"
- I $$PI^AUPNPAT(DFN,BMCRDATE) S BMCMSG(BMCI)="PATIENT HAS INSURANCE-INSURER: "_BMCX,BMCI=BMCI+1
- I BMCELG=BMCI S BMCMSG(BMCI)="NO THIRD PARTY COVERAGE RECORDED",BMCI=BMCI+1
- I $D(^AUPNPAT(DFN,13)) D
- .S BMCMSG(BMCI)="",BMCI=BMCI+1,BMCMSG(BMCI)="ADDITIONAL REGISTRATION INFORMATION:",BMCI=BMCI+1
- .K BMCAR D ENP^XBDIQ1(9000001,DFN,1301,"BMCAR(","E")
- .S I=0 F S I=$O(BMCAR(1301,I)) Q:I'=+I S BMCMSG(BMCI)=BMCAR(1301,I),BMCI=BMCI+1
- W:BMCI !!
- S BMCI=0
- F S BMCI=$O(BMCMSG(BMCI)) Q:'BMCI W BMCMSG(BMCI),!
- ;
- W !,"--------------------",!
- Q
- 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,!
- ;4.0*1 3.24.06 IHS/OIT/FCJ ADDED NXT 2 LINES TO PRT BEG AND END DT
- S Y=BMCBD D DD^%DT W ?17,"BEG DATE: "_Y
- S Y=BMCED D DD^%DT W ?40,"END DATE: "_Y,!
- S X="POTENTIAL HIGH COST CASES - BASED ON DIAGNOSIS"
- W ?(80-$L(X))/2,X,!
- W !,?49,"REF"
- W !,"BEGIN D.O.S.",?13,"ST",?17,"HRN",?28,"PATIENT NAME",?49,"PROV",?54,"TYPE",?59,"FACILITY REFERRED TO"
- W !,BMC80D
- Q
- BMCRR8P ; IHS/PHXAO/TMJ - PRNT BILL VSTS;POT HIGH COST CASES ; [ 09/27/2006 2:16 PM ]
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;**1,3,9**;JAN 09, 2006;Build 101
- +2 ;4.0*1 3.24.06 IHS/OIT/FCJ PRINT BEG AND END DT
- +3 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
- +4 ;4.0*9 11.11.2012 IHS.OIT.FCJ CHG FOR ICD-10
- +5 ;
- START ;
- +1 SET BMC80E="==============================================================================="
- +2 SET BMC80D="-------------------------------------------------------------------------------"
- +3 SET BMCPG=0
- DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
- IF '$DATA(^XTMP("BMCRR8",BMCJOB,BMCBTH))
- WRITE !,"No referrals to report",!
- GOTO DONE
- +4 SET BMCPN=""
- KILL BMCQUIT
- +5 FOR
- SET BMCPN=$ORDER(^XTMP("BMCRR8",BMCJOB,BMCBTH,"DATA HITS",BMCPN))
- IF BMCPN=""!($DATA(BMCQUIT))
- QUIT
- DO DFN
- +6 IF $DATA(BMCQUIT)
- GOTO DONE
- +7 IF $Y>(IOSL-6)
- DO HEAD
- IF $DATA(BMCQUIT)
- GOTO DONE
- DONE ;
- +1 KILL ^XTMP("BMCRR8",BMCJOB,BMCBTH)
- +2 DO DONE^BMCRLP2
- +3 QUIT
- DFN ;
- +1 SET DFN=""
- FOR
- SET DFN=$ORDER(^XTMP("BMCRR8",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN))
- IF DFN=""!($DATA(BMCQUIT))
- QUIT
- DO PRINT
- +2 QUIT
- PRINT ;print one referral
- +1 SET BMCREF=0
- FOR
- SET BMCREF=$ORDER(^XTMP("BMCRR8",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN,BMCREF))
- IF BMCREF'=+BMCREF!($DATA(BMCQUIT))
- QUIT
- SET BMCRREC=^BMCREF(BMCREF,0)
- DO PRINT1
- +2 QUIT
- PRINT1 ;
- +1 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- +2 WRITE !,$$AVDOS^BMCRLU(BMCREF,"C")
- +3 WRITE ?13,$$VALI^XBDIQ1(90001,BMCREF,.15)
- +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 ?17,BMCHRN
- +6 WRITE ?28,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20)
- +7 WRITE ?49,$SELECT($PIECE(BMCRREC,U,6):$$VAL^XBDIQ1(200,$PIECE(BMCRREC,U,6),1),1:"--")
- +8 WRITE ?54,$EXTRACT($$VAL^XBDIQ1(90001,BMCREF,.04),1,3)
- +9 SET BMCFAC=$$FACREF^BMCRLU(BMCREF)
- +10 IF BMCFAC=""
- SET BMCFAC="????"
- +11 WRITE ?59,$EXTRACT(BMCFAC,1,20)
- +12 IF $$VAL^XBDIQ1(90001,BMCREF,.09)]""
- WRITE !?59,$EXTRACT($$VAL^XBDIQ1(90001,BMCREF,.09),1,20)
- PURPOSE ;
- +1 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- +2 KILL BMCP
- WRITE !,"Purpose:"
- +3 SET BMCP=$$GET1^DIQ(90001,BMCREF,1,"","BMCP")
- +4 SET DIWL=1
- SET DIWF="C66"
- SET BMCX=0
- FOR
- SET BMCX=$ORDER(BMCP(BMCX))
- IF BMCX'=+BMCX!($DATA(BMCQUIT))
- QUIT
- Begin DoDot:1
- +5 SET X=BMCP(BMCX)
- DO ^DIWP
- End DoDot:1
- +6 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
- IF C'=1
- WRITE !
- WRITE ?12,^UTILITY($JOB,"W",DIWL,Z,0)
- +7 KILL DIWL,DIWR,DIWF,Z,^UTILITY($JOB,"W"),BMCNODE,BMCFILE,BMCG,BMCCOL
- DX ;
- +1 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- +2 IF $DATA(^BMCDX("AD",BMCREF))
- Begin DoDot:1
- +3 WRITE !,"Dx:"
- +4 ;BMC*4.0*9
- SET BMCDOS=$$AVDOS^BMCRLU(BMCREF,"N")
- +5 SET (C,X)=0
- FOR
- SET X=$ORDER(^BMCDX("AD",BMCREF,X))
- IF X'=+X!($DATA(BMCQUIT))
- QUIT
- Begin DoDot:2
- +6 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES;4.0*9 11.11.2012 IHS.OIT.FCJ CHG FOR ICD-10
- +7 ;S C=C+1,BMCD=+^BMCDX(X,0) D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W:C'=1 ! W ?12,$P(^ICD9(BMCD,0),U),?19," - ",$E($P(^ICD9(BMCD,0),U,3),1,50)
- +8 ;S C=C+1,BMCD=+^BMCDX(X,0) D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W:C'=1 ! W ?12,$P($$ICDDX^ICDCODE(BMCD,0),U,2),?19," - ",$E($P($$ICDDX^ICDCODE(BMCD,0),U,4),1,50)
- +9 SET C=C+1
- SET BMCD=+^BMCDX(X,0)
- IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- IF C'=1
- WRITE !
- WRITE ?12,$PIECE($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,2),?19," - ",$EXTRACT($PIECE($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,4),1,50)
- End DoDot:2
- End DoDot:1
- IF 1
- +10 IF '$TEST
- Begin DoDot:1
- +11 WRITE !,"Dx Cat:",?12,$$GET1^DIQ(90001,BMCREF,.12)
- End DoDot:1
- PROC ;
- +1 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- +2 IF $DATA(^BMCPX("AD",BMCREF))
- Begin DoDot:1
- +3 WRITE !,"Proc:"
- +4 SET (C,X)=0
- +5 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
- +6 ;F S X=$O(^BMCPX("AD",BMCREF,X)) Q:X'=+X!($D(BMCQUIT)) S C=C+1,BMCD=+^BMCPX(X,0) D:$Y>(IOSL-4) HEAD Q:$D(BMCQUIT) W:C'=1 ! W ?12,$P(^ICPT(BMCD,0),U),?19," - ",$E($P(^ICPT(BMCD,0),U,2),1,50)
- +7 FOR
- SET X=$ORDER(^BMCPX("AD",BMCREF,X))
- IF X'=+X!($DATA(BMCQUIT))
- QUIT
- SET C=C+1
- SET BMCD=+^BMCPX(X,0)
- IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- IF C'=1
- WRITE !
- WRITE ?12,$PIECE($$CPT^ICPTCOD(BMCD,0),U,2),?19," - ",$EXTRACT($PIECE($$CPT^ICPTCOD(BMCD,0),U,3),1,50)
- End DoDot:1
- IF 1
- +8 IF '$TEST
- Begin DoDot:1
- +9 WRITE !,"Srv Cat:",?12,$$GET1^DIQ(90001,BMCREF,.13)
- End DoDot:1
- +10 ;
- THIRD ;Third Party Coverage
- +1 ;W !
- +2 IF '$GET(DFN)
- QUIT
- +3 SET BMCRDATE=DT
- +4 NEW BMCMSG,BMCI,BMCX
- +5 SET BMCI=1
- +6 SET BMCX=$$BEN^AUPNPAT(DFN,"E")
- +7 IF BMCX=""
- SET BMCX="UNKNOWN"
- +8 SET BMCMSG(BMCI)="CLASSIFICATION/BENEFICIARY IS: "_BMCX
- SET BMCI=+BMCI+1
- +9 SET BMCX=$$ELIGSTAT^AUPNPAT(DFN,"E")
- +10 IF BMCX=""
- SET BMCX="UNKNOWN"
- +11 SET BMCMSG(BMCI)="ELIGIBILITY STATUS IS: "_BMCX
- SET BMCI=+BMCI+1
- +12 NEW BMCELG
- +13 SET BMCELG=BMCI
- +14 IF $$MCR^AUPNPAT(DFN,BMCRDATE)
- SET BMCMSG(BMCI)="PATIENT HAS MEDICARE"
- SET BMCI=BMCI+1
- +15 ;I $$MCD^AUPNPAT(DFN,BMCRDATE) S BMCMSG(BMCI)="PATIENT HAS MEDICAID--",BMCI=BMCI+1
- +16 SET BMCX=$$MCDPN^AUPNPAT(DFN,BMCRDATE,"E")
- +17 IF BMCX=""
- SET BMCX="UNKNOWN"
- +18 IF $$MCD^AUPNPAT(DFN,BMCRDATE)
- SET BMCMSG(BMCI)="PATIENT HAS MEDICAID-PLAN NAME: "_BMCX
- SET BMCI=+BMCI+1
- +19 ;I $$PI^AUPNPAT(DFN,BMCRDATE) S BMCMSG(BMCI)="PATIENT HAS PRIVATE INSURANCE--",BMCI=BMCI+1
- +20 SET BMCX=$$PIN^AUPNPAT(DFN,BMCRDATE,"E")
- +21 IF BMCX=""
- SET BMCX="UNKNOWN"
- +22 IF $$PI^AUPNPAT(DFN,BMCRDATE)
- SET BMCMSG(BMCI)="PATIENT HAS INSURANCE-INSURER: "_BMCX
- SET BMCI=BMCI+1
- +23 IF BMCELG=BMCI
- SET BMCMSG(BMCI)="NO THIRD PARTY COVERAGE RECORDED"
- SET BMCI=BMCI+1
- +24 IF $DATA(^AUPNPAT(DFN,13))
- Begin DoDot:1
- +25 SET BMCMSG(BMCI)=""
- SET BMCI=BMCI+1
- SET BMCMSG(BMCI)="ADDITIONAL REGISTRATION INFORMATION:"
- SET BMCI=BMCI+1
- +26 KILL BMCAR
- DO ENP^XBDIQ1(9000001,DFN,1301,"BMCAR(","E")
- +27 SET I=0
- FOR
- SET I=$ORDER(BMCAR(1301,I))
- IF I'=+I
- QUIT
- SET BMCMSG(BMCI)=BMCAR(1301,I)
- SET BMCI=BMCI+1
- End DoDot:1
- +28 IF BMCI
- WRITE !!
- +29 SET BMCI=0
- +30 FOR
- SET BMCI=$ORDER(BMCMSG(BMCI))
- IF 'BMCI
- QUIT
- WRITE BMCMSG(BMCI),!
- +31 ;
- +32 WRITE !,"--------------------",!
- +33 QUIT
- +34 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 ;4.0*1 3.24.06 IHS/OIT/FCJ ADDED NXT 2 LINES TO PRT BEG AND END DT
- +5 SET Y=BMCBD
- DO DD^%DT
- WRITE ?17,"BEG DATE: "_Y
- +6 SET Y=BMCED
- DO DD^%DT
- WRITE ?40,"END DATE: "_Y,!
- +7 SET X="POTENTIAL HIGH COST CASES - BASED ON DIAGNOSIS"
- +8 WRITE ?(80-$LENGTH(X))/2,X,!
- +9 WRITE !,?49,"REF"
- +10 WRITE !,"BEGIN D.O.S.",?13,"ST",?17,"HRN",?28,"PATIENT NAME",?49,"PROV",?54,"TYPE",?59,"FACILITY REFERRED TO"
- +11 WRITE !,BMC80D
- +12 QUIT
