Routine: BMCRCRVP

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

P ;

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

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

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

COMMENT ;

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

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)," ","-")

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

COMMENT   ;

 +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

BMCRCRVP.m