BMCRCRVP ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;2.0*2 12/30/03 IHS/ITSC/FCJ ADDED COMMENTS TO THE LINES AFTER THE DO'S
; THAT WERE ALREADY COMMENTED OUT
;
S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^XTMP("BMCRCRV",BMCJOB,BMCBT)) W !,"No referrals to report",! G XIT
S BMCPN=0,BMCQUIT=0
S BMCDATE="" F S BMCDATE=$O(^XTMP("BMCRCRV",BMCJOB,BMCBT,"DATA HITS",BMCDATE)) Q:BMCDATE=""!(BMCQUIT) D P
XIT ;
K ^XTMP("BMCRCRV",BMCJOB,BMCBT)
D DONE^BMCRLP2
D KILL^AUPNPAT
K BMCDATE
Q
P ;
S BMCPN="" F S BMCPN=$O(^XTMP("BMCRCRV",BMCJOB,BMCBT,"DATA HITS",BMCDATE,BMCPN)) Q:BMCPN=""!(BMCQUIT) D PRINT
Q
PRINT ;print one referral
I $Y>(IOSL-10) D HEAD Q:BMCQUIT
S BMCCDT=0 F S BMCCDT=$O(^XTMP("BMCRCRV",BMCJOB,BMCBT,"DATA HITS",BMCDATE,BMCPN,BMCCDT)) Q:BMCCDT'=+BMCCDT!(BMCQUIT) S BMCRREC=^BMCCOM(BMCCDT,0),DFN=$P(BMCRREC,U,2) D PRINT1
Q
PRINT1 ;
I $Y>(IOSL-3) D HEAD Q:BMCQUIT
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 !,$E($P(^DPT(DFN,0),U),1,30),?32,BMCHRN,?43,"DOB: ",$$DOB^AUPNPAT(DFN,"E")," ",$$AGE^AUPNPAT(DFN,DT,"R")," ",$$SSN^AUPNPAT(DFN)
W !!,BMCCDT
W !,BMCRREC
;W !,"Tribe: ",$E($$TRIBE^AUPNPAT(DFN,"E"),1,20),?32,"Req Provider: ",$$VAL^XBDIQ1(90001,BMCCDT,.06)
;W !,"Referral #: ",$P($G(^BMCCOM(BMCCDT,0)),U,2)
;S BMCC=0 W !,"3RD Party: " I $$MCR^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCCDT,"I")]"":$$AVDOS^BMCRLU(BMCCDT,"I"),1:$P(BMCRREC,U))) W "MEDICARE" S BMCC=BMCC+1
;I $$MCD^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCCDT,"I")]"":$$AVDOS^BMCRLU(BMCCDT,"I"),1:$P(BMCRREC,U))) D
;.W:BMCC " " W "MEDICAID: ",$$MCDPN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCCDT,"I"),"E") S BMCC=BMCC+1
;I $$PI^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCCDT,"I")]"":$$AVDOS^BMCRLU(BMCCDT,"I"),1:$P(BMCRREC,U))) D
;.W:BMCC " " W $$PIN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCCDT,"I"),"E")
I $Y>(IOSL-3) D HEAD Q:BMCQUIT
;W !,"Refer To:",?10,$E($$FACREF^BMCRLU(BMCCDT),1,20),?32,$S($$VAL^XBDIQ1(90001,BMCCDT,.09)]"":"Provider: "_$$VAL^XBDIQ1(90001,BMCCDT,.09),1:"")
PRIPAY ;Primary Payor
;I $P(BMCRREC,U,11)'="" W !,"Primary Payor: "_$$VAL^XBDIQ1(90001,BMCCDT,.11)
;
TYPE ;
;I $P(BMCRREC,U,4)'="" W ?50,"Referral Type: "_$$VAL^XBDIQ1(90001,BMCCDT,.04)
;I $P(BMCRREC,U,14)="I" D Q:BMCQUIT I 1
;.W !,"Inpatient Admission Date: ",$$AVDOS^BMCRLU(BMCCDT,"C"),?45,"LOS: ",$$AVLOS^BMCRLU(BMCCDT,"C")
;E D
;.W !,"Outpatient Services requested for: ",$$AVDOS^BMCRLU(BMCREF,"C")," # of Visits: ",$$VAL^XBDIQ1(90001,BMCREF,1111)
PURPOSE ;
;I $Y>(IOSL-3) D HEAD Q:BMCQUIT
;K BMCP W !,"Purpose:"
;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!(BMCQUIT) S C=C+1 D:$Y>(IOSL-3) HEAD Q:BMCQUIT W:C'=1 ! W ?10,^UTILITY($J,"W",DIWL,Z,0)
;Q:BMCQUIT
;K DIWL,DIWR,DIWF,Z,^UTILITY($J,"W"),BMCNODE,BMCFILE,BMCG,BMCCOL
;I '$D(^BMCCOM(BMCREF,1)) G DX
S BMCNODE=1,BMCIOM=70,BMCFILE=90001.03,BMCDA=BMCCDT D WP^BMCFDR K BMCIOM
S Y=0 F S Y=$O(BMCWP(Y)) Q:Y'=+Y!(BMCQUIT) D
.I $Y>(IOSL-3) D HEAD Q:BMCQUIT
.W !?5,BMCWP(Y)
Q:BMCQUIT
DX ;Print either prov narrative/canned narrative
;I $Y>(IOSL-3) D HEAD Q:BMCQUIT
;I $D(^BMCDX("AD",BMCREF)) D I 1
;.W !,"Dx:"
;.S (C,X)=0 F S X=$O(^BMCDX("AD",BMCREF,X)) Q:X'=+X!(BMCQUIT) S C=C+1,BMCD=+^BMCDX(X,0) D:$Y>(IOSL-3) HEAD Q:BMCQUIT W:C'=1 ! D
;..S BMCDXDOC="" I $P($G(^BMCDX(X,0)),U,6)'="" S BMCDXDOC=$P($G(^BMCDX(X,0)),U,6) D
;..W ?10,$P(^ICD9(BMCD,0),U),?19," - ",$S(BMCDXDOC'="":$E($P(^AUTNPOV(BMCDXDOC,0),U,1),1,50),1:$E($P(^ICD9(BMCD,0),U,3),1,50))
;E D
;.W !,"Dx Cat:",?10,$$GET1^DIQ(90001,BMCREF,.12)
PROC ;
;I $Y>(IOSL-3) D HEAD Q:BMCQUIT
;I $D(^BMCPX("AD",BMCREF)) D I 1
;.W !,"Proc:"
;.S (C,X)=0 F S X=$O(^BMCPX("AD",BMCREF,X)) Q:X'=+X!(BMCQUIT) S C=C+1,BMCD=+^BMCPX(X,0) D:$Y>(IOSL-3) HEAD Q:BMCQUIT W:C'=1 ! W ?10,$P(^ICPT(BMCD,0),U),?19," - ",$E($P(^ICPT(BMCD,0),U,2),1,50)
;E D
;.W !,"Srv Cat:",?10,$$GET1^DIQ(90001,BMCREF,.13)
;Q:BMCQUIT
BOC ;
;I $Y>(IOSL-3) D HEAD Q:BMCQUIT
;W !,"Priority: ",$$VAL^XBDIQ1(90001,BMCREF,.32)," CHS Auth Dec: ",$$VAL^XBDIQ1(90001,BMCREF,1112)," MCC Action: ",$$VAL^XBDIQ1(90001,BMCREF,1123)
;W !,"Utilization Review by MD: ",$$VAL^XBDIQ1(90001,BMCREF,1125)
LOCAT ;Print Local Categories
;I $D(^BMCCOM(BMCREF,21,0)) D
;. S BMCLOCC=0
;.F S BMCLOCC=$O(^BMCCOM(BMCREF,21,"B",BMCLOCC)) Q:BMCLOCC'=+BMCLOCC D
;..S BMCLOCI=0
;..F S BMCLOCI=$O(^BMCCOM(BMCREF,21,"B",BMCLOCC,BMCLOCI)) Q:BMCLOCI'=+BMCLOCI D
;... S BMCLOCP=$P(^BMCCOM(BMCREF,21,BMCLOCI,0),U)
;... Q:BMCLOCP=""
;... S BMCLOCPP=$P(^BMCLCAT(BMCLOCP,0),U)
;... W !,"Local Category: "_BMCLOCPP
;
;
;I '$D(^BMCCOM(BMCREF,2)) G NEXT
;W !,"Business Office Comments:"
;S BMCNODE=2,BMCIOM=70,BMCFILE=90001.03,BMCDA=BMCREF D WP^BMCFDR K BMCIOM
;S Y=0 F S Y=$O(BMCWP(Y)) Q:Y'=+Y!(BMCQUIT) D
;.I $Y>(IOSL-3) D HEAD Q:BMCQUIT
;.W !?5,BMCWP(Y)
;Q:BMCQUIT
NEXT ;
W !,"--------------------",!
Q
HEAD ;ENTRY POINT
NEW X,Y,Z,C
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BMCQUIT=1 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 ?21,"**WEEKLY CHS REVIEW LISTING BY DATE**"
W !,$TR($J(" ",80)," ","-")
Q
BMCRCRVP ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
+2 ;2.0*2 12/30/03 IHS/ITSC/FCJ ADDED COMMENTS TO THE LINES AFTER THE DO'S
+3 ; THAT WERE ALREADY COMMENTED OUT
+4 ;
+5 SET BMCPG=0
DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
IF '$DATA(^XTMP("BMCRCRV",BMCJOB,BMCBT))
WRITE !,"No referrals to report",!
GOTO XIT
+6 SET BMCPN=0
SET BMCQUIT=0
+7 SET BMCDATE=""
FOR
SET BMCDATE=$ORDER(^XTMP("BMCRCRV",BMCJOB,BMCBT,"DATA HITS",BMCDATE))
IF BMCDATE=""!(BMCQUIT)
QUIT
DO P
XIT ;
+1 KILL ^XTMP("BMCRCRV",BMCJOB,BMCBT)
+2 DO DONE^BMCRLP2
+3 DO KILL^AUPNPAT
+4 KILL BMCDATE
+5 QUIT
P ;
+1 SET BMCPN=""
FOR
SET BMCPN=$ORDER(^XTMP("BMCRCRV",BMCJOB,BMCBT,"DATA HITS",BMCDATE,BMCPN))
IF BMCPN=""!(BMCQUIT)
QUIT
DO PRINT
+2 QUIT
PRINT ;print one referral
+1 IF $Y>(IOSL-10)
DO HEAD
IF BMCQUIT
QUIT
+2 SET BMCCDT=0
FOR
SET BMCCDT=$ORDER(^XTMP("BMCRCRV",BMCJOB,BMCBT,"DATA HITS",BMCDATE,BMCPN,BMCCDT))
IF BMCCDT'=+BMCCDT!(BMCQUIT)
QUIT
SET BMCRREC=^BMCCOM(BMCCDT,0)
SET DFN=$PIECE(BMCRREC,U,2)
DO PRINT1
+3 QUIT
PRINT1 ;
+1 IF $Y>(IOSL-3)
DO HEAD
IF BMCQUIT
QUIT
+2 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)
+3 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,30),?32,BMCHRN,?43,"DOB: ",$$DOB^AUPNPAT(DFN,"E")," ",$$AGE^AUPNPAT(DFN,DT,"R")," ",$$SSN^AUPNPAT(DFN)
+4 WRITE !!,BMCCDT
+5 WRITE !,BMCRREC
+6 ;W !,"Tribe: ",$E($$TRIBE^AUPNPAT(DFN,"E"),1,20),?32,"Req Provider: ",$$VAL^XBDIQ1(90001,BMCCDT,.06)
+7 ;W !,"Referral #: ",$P($G(^BMCCOM(BMCCDT,0)),U,2)
+8 ;S BMCC=0 W !,"3RD Party: " I $$PNPAT_source.html#MCR">MCR^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCCDT,"I")]"":$$AVDOS^BMCRLU(BMCCDT,"I"),1:$P(BMCRREC,U))) W "MEDICARE" S BMCC=BMCC+1
+9 ;I $$PNPAT_source.html#MCD">MCD^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCCDT,"I")]"":$$AVDOS^BMCRLU(BMCCDT,"I"),1:$P(BMCRREC,U))) D
+10 ;.W:BMCC " " W "MEDICAID: ",$$MCDPN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCCDT,"I"),"E") S BMCC=BMCC+1
+11 ;I $$PNPAT_source.html#PI">PI^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCCDT,"I")]"":$$AVDOS^BMCRLU(BMCCDT,"I"),1:$P(BMCRREC,U))) D
+12 ;.W:BMCC " " W $$PIN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCCDT,"I"),"E")
+13 IF $Y>(IOSL-3)
DO HEAD
IF BMCQUIT
QUIT
+14 ;W !,"Refer To:",?10,$E($$FACREF^BMCRLU(BMCCDT),1,20),?32,$S($$VAL^XBDIQ1(90001,BMCCDT,.09)]"":"Provider: "_$$VAL^XBDIQ1(90001,BMCCDT,.09),1:"")
PRIPAY ;Primary Payor
+1 ;I $P(BMCRREC,U,11)'="" W !,"Primary Payor: "_$$VAL^XBDIQ1(90001,BMCCDT,.11)
+2 ;
TYPE ;
+1 ;I $P(BMCRREC,U,4)'="" W ?50,"Referral Type: "_$$VAL^XBDIQ1(90001,BMCCDT,.04)
+2 ;I $P(BMCRREC,U,14)="I" D Q:BMCQUIT I 1
+3 ;.W !,"Inpatient Admission Date: ",$$AVDOS^BMCRLU(BMCCDT,"C"),?45,"LOS: ",$$AVLOS^BMCRLU(BMCCDT,"C")
+4 ;E D
+5 ;.W !,"Outpatient Services requested for: ",$$AVDOS^BMCRLU(BMCREF,"C")," # of Visits: ",$$VAL^XBDIQ1(90001,BMCREF,1111)
PURPOSE ;
+1 ;I $Y>(IOSL-3) D HEAD Q:BMCQUIT
+2 ;K BMCP W !,"Purpose:"
+3 ;S BMCP=$$GET1^DIQ(90001,BMCREF,1201,"","BMCP")
+4 ;S DIWL=1,DIWF="C66" S X=BMCP D ^DIWP
+5 ;S (C,Z)=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z!(BMCQUIT) S C=C+1 D:$Y>(IOSL-3) HEAD Q:BMCQUIT W:C'=1 ! W ?10,^UTILITY($J,"W",DIWL,Z,0)
+6 ;Q:BMCQUIT
+7 ;K DIWL,DIWR,DIWF,Z,^UTILITY($J,"W"),BMCNODE,BMCFILE,BMCG,BMCCOL
+1 ;I '$D(^BMCCOM(BMCREF,1)) G DX
+2 SET BMCNODE=1
SET BMCIOM=70
SET BMCFILE=90001.03
SET BMCDA=BMCCDT
DO WP^BMCFDR
KILL BMCIOM
+3 SET Y=0
FOR
SET Y=$ORDER(BMCWP(Y))
IF Y'=+Y!(BMCQUIT)
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-3)
DO HEAD
IF BMCQUIT
QUIT
+5 WRITE !?5,BMCWP(Y)
End DoDot:1
+6 IF BMCQUIT
QUIT
DX ;Print either prov narrative/canned narrative
+1 ;I $Y>(IOSL-3) D HEAD Q:BMCQUIT
+2 ;I $D(^BMCDX("AD",BMCREF)) D I 1
+3 ;.W !,"Dx:"
+4 ;.S (C,X)=0 F S X=$O(^BMCDX("AD",BMCREF,X)) Q:X'=+X!(BMCQUIT) S C=C+1,BMCD=+^BMCDX(X,0) D:$Y>(IOSL-3) HEAD Q:BMCQUIT W:C'=1 ! D
+5 ;..S BMCDXDOC="" I $P_source.html#xP">P($G(^BMCDX(X,0)),U,6)'="" S BMCDXDOC=$P_source.html#xP">P($G(^BMCDX(X,0)),U,6) D
+6 ;..W ?10,$P_source.html#xP">P_source.html#xP_source.html#xP">P">P_source.html#xP">P(^ICD9(BMCD,0),U),?19," - ",$S(BMCDXDOC'="":$E($P_source.html#xP">P_source.html#xP_source.html#xP">P">P_source.html#xP">P(^AUTNP_source.html#xP">P_source.html#xP_source.html#xP">P">P_source.html#xP">POV(BMCDXDOC,0),U,1),1,50),1:$E($P_source.html#xP">P_source.html#xP_source.html#xP">P">P_source.html#xP">P(^ICD9(BMCD,0),U,3),1,50))
+7 ;E D
+8 ;.W !,"Dx Cat:",?10,$$GET1^DIQ(90001,BMCREF,.12)
PROC ;
+1 ;I $Y>(IOSL-3) D HEAD Q:BMCQUIT
+2 ;I $D(^BMCPX("AD",BMCREF)) D I 1
+3 ;.W !,"Proc:"
+4 ;.S (C,X)=0 F S X=$O(^BMCP_source.html#xP">PX("AD",BMCREF,X)) Q:X'=+X!(BMCQUIT) S C=C+1,BMCD=+^BMCP_source.html#xP">PX(X,0) D:$Y>(IOSL-3) HEAD Q:BMCQUIT W:C'=1 ! W ?10,$P_source.html#xP">P(^ICP_source.html#xP">PT(BMCD,0),U),?19," - ",$E($P_source.html#xP">P(^ICP_source.html#xP">PT(BMCD,0),U,2),1,50)
+5 ;E D
+6 ;.W !,"Srv Cat:",?10,$$GET1^DIQ(90001,BMCREF,.13)
+7 ;Q:BMCQUIT
BOC ;
+1 ;I $Y>(IOSL-3) D HEAD Q:BMCQUIT
+2 ;W !,"Priority: ",$$VAL^XBDIQ1(90001,BMCREF,.32)," CHS Auth Dec: ",$$VAL^XBDIQ1(90001,BMCREF,1112)," MCC Action: ",$$VAL^XBDIQ1(90001,BMCREF,1123)
+3 ;W !,"Utilization Review by MD: ",$$VAL^XBDIQ1(90001,BMCREF,1125)
LOCAT ;Print Local Categories
+1 ;I $D(^BMCCOM(BMCREF,21,0)) D
+2 ;. S BMCLOCC=0
+3 ;.F S BMCLOCC=$O(^BMCCOM(BMCREF,21,"B",BMCLOCC)) Q:BMCLOCC'=+BMCLOCC D
+4 ;..S BMCLOCI=0
+5 ;..F S BMCLOCI=$O(^BMCCOM(BMCREF,21,"B",BMCLOCC,BMCLOCI)) Q:BMCLOCI'=+BMCLOCI D
+6 ;... S BMCLOCP=$P(^BMCCOM(BMCREF,21,BMCLOCI,0),U)
+7 ;... Q:BMCLOCP=""
+8 ;... S BMCLOCPP=$P(^BMCLCAT(BMCLOCP,0),U)
+9 ;... W !,"Local Category: "_BMCLOCPP
+10 ;
+11 ;
+12 ;I '$D(^BMCCOM(BMCREF,2)) G NEXT
+13 ;W !,"Business Office Comments:"
+14 ;S BMCNODE=2,BMCIOM=70,BMCFILE=90001.03,BMCDA=BMCREF D WP^BMCFDR K BMCIOM
+15 ;S Y=0 F S Y=$O(BMCWP(Y)) Q:Y'=+Y!(BMCQUIT) D
+16 ;.I $Y>(IOSL-3) D HEAD Q:BMCQUIT
+17 ;.W !?5,BMCWP(Y)
+18 ;Q:BMCQUIT
NEXT ;
+1 WRITE !,"--------------------",!
+2 QUIT
HEAD ;ENTRY POINT
+1 NEW X,Y,Z,C
+2 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=1
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 ?21,"**WEEKLY CHS REVIEW LISTING BY DATE**"
+5 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+6 QUIT
