- BMCRR19P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;
- ;;4.0;REFERRED CARE INFO SYSTEM;**3,9,12**;JAN 09, 2006;Build 101
- ;IHS/ITSC/FCJ ADDED PRINTING OF SECONDARY REF AND DX CAT
- ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
- ;4.0*9 11.2.2012 IHS.OIT.FCJ ADDED ICD-10 CHANGE
- ;
- ;
- S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^XTMP("BMCRR19",BMCJOB,BMCBT)) W !,"No referrals to report",! G XIT
- S BMCPN=0,BMCQUIT=0
- S BMCDATE="" F S BMCDATE=$O(^XTMP("BMCRR19",BMCJOB,BMCBT,"DATA HITS",BMCDATE)) Q:BMCDATE=""!(BMCQUIT) D P
- XIT ;
- K ^XTMP("BMCRR19",BMCJOB,BMCBT)
- D DONE^BMCRLP2
- D KILL^AUPNPAT
- K BMCDATE,BMCI,BMCCTYP,BMCRNUMB
- Q
- P ;
- S BMCPN="" F S BMCPN=$O(^XTMP("BMCRR19",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 BMCREF=0 F S BMCREF=$O(^XTMP("BMCRR19",BMCJOB,BMCBT,"DATA HITS",BMCDATE,BMCPN,BMCREF)) Q:BMCREF'=+BMCREF!(BMCQUIT) S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3) D PRINT1
- Q
- PRINT1 ;
- S BMCRNUMB=$P($G(^BMCREF(BMCREF,0)),U,2)
- 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 !,"Tribe: ",$E($$TRIBE^AUPNPAT(DFN,"E"),1,20),?32,"Req Provider: ",$$VAL^XBDIQ1(90001,BMCREF,.06)
- W !,"Referral #: ",BMCRNUMB W ?32,"Date Referral Initiated: ",$$REFDTI^BMCRLU(BMCREF,"S")
- S BMCC=0 W !,"3RD Party: " I $$MCR^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCREF,"I")]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:$P(BMCRREC,U))) W "MEDICARE" S BMCC=BMCC+1
- I $$MCD^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCREF,"I")]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:$P(BMCRREC,U))) D
- .W:BMCC " " W "MEDICAID: ",$$MCDPN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCREF,"I"),"E") S BMCC=BMCC+1
- I $$PI^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCREF,"I")]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:$P(BMCRREC,U))) D
- .W:BMCC " " W $$PIN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCREF,"I"),"E")
- I $Y>(IOSL-3) D HEAD Q:BMCQUIT
- W !,"Refer To:",?10,$E($$FACREF^BMCRLU(BMCREF),1,20),?32,$S($$VAL^XBDIQ1(90001,BMCREF,.09)]"":"Provider: "_$$VAL^XBDIQ1(90001,BMCREF,.09),1:"")
- SECREF ;Secondary Referral
- D SECREF2^BMCRUTL
- PRIPAY ;Primary Payor
- I $P(BMCRREC,U,11)'="" W !,"Primary Payor: "_$$VAL^XBDIQ1(90001,BMCREF,.11)
- ;
- TYPE ;
- I $P(BMCRREC,U,4)'="" W ?50,"Referral Type: "_$$VAL^XBDIQ1(90001,BMCREF,.04)
- I $P(BMCRREC,U,14)="I" D Q:BMCQUIT I 1
- .W !,"Inpatient Admission Date: ",$$AVDOS^BMCRLU(BMCREF,"C"),?45,"LOS: ",$$AVLOS^BMCRLU(BMCREF,"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"),BMCP=$TR(BMCP,"|","") ;BMC*3.1*12 ADDED TR COMMAND
- 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
- PERTMED ;
- S BMCCTYP="M"
- D:$D(^BMCCOM("AD",BMCREF)) BO^BMCRUTL
- Q:BMCQUIT
- DX ;Print either prov nar/canned nar
- I $Y>(IOSL-3) D HEAD Q:BMCQUIT
- W !,"Dx Cat:",?10,$$GET1^DIQ(90001,BMCREF,.12)
- 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!(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)
- ..;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES;4.0*9 11.2.2012 IHS.OIT.FCJ CHG FOR ICD-10
- ..;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))
- ..;W ?10,$P($$ICDDX^ICDCODE(BMCD,0),U,2),?19," - ",$S(BMCDXDOC'="":$E($P(^AUTNPOV(BMCDXDOC,0),U,1),1,50),1:$E($P($$ICDDX^ICDCODE(BMCD,0),U,4),1,50))
- ..W ?10,$P($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,2),?19," - ",$S(BMCDXDOC'="":$E($P(^AUTNPOV(BMCDXDOC,0),U,1),1,50),1:$E($P($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,4),1,50))
- PROC ;
- I $Y>(IOSL-3) D HEAD Q: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!(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)
- .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($$CPT^ICPTCOD(BMCD,0),U,2),?19," - ",$E($P($$CPT^ICPTCOD(BMCD,0),U,3),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(^BMCREF(BMCREF,21,0)) D
- . S BMCLOCC=0
- .F S BMCLOCC=$O(^BMCREF(BMCREF,21,"B",BMCLOCC)) Q:BMCLOCC'=+BMCLOCC D
- ..S BMCLOCI=0
- ..F S BMCLOCI=$O(^BMCREF(BMCREF,21,"B",BMCLOCC,BMCLOCI)) Q:BMCLOCI'=+BMCLOCI D
- ... S BMCLOCP=$P(^BMCREF(BMCREF,21,BMCLOCI,0),U)
- ... Q:BMCLOCP=""
- ... S BMCLOCPP=$P(^BMCLCAT(BMCLOCP,0),U)
- ... W !,"Local Category: "_BMCLOCPP
- ;
- ;
- BO ;Business office Comments
- S BMCCTYP="B"
- D:$D(^BMCCOM("AD",BMCREF)) BO^BMCRUTL
- 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,!
- S Y=DT D DD^%DT W ?(80-$L(Y)/2),Y,!
- W ?21,"**WEEKLY CHS REVIEW LISTING BY DATE**"
- S Y=BMCBD D DD^%DT W !,?28,"BEG DATE: "_Y
- S Y=BMCED D DD^%DT W !,?28,"END DATE: "_Y
- W !,$TR($J(" ",80)," ","-")
- Q
- BMCRR19P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;**3,9,12**;JAN 09, 2006;Build 101
- +2 ;IHS/ITSC/FCJ ADDED PRINTING OF SECONDARY REF AND DX CAT
- +3 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
- +4 ;4.0*9 11.2.2012 IHS.OIT.FCJ ADDED ICD-10 CHANGE
- +5 ;
- +6 ;
- +7 SET BMCPG=0
- DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
- IF '$DATA(^XTMP("BMCRR19",BMCJOB,BMCBT))
- WRITE !,"No referrals to report",!
- GOTO XIT
- +8 SET BMCPN=0
- SET BMCQUIT=0
- +9 SET BMCDATE=""
- FOR
- SET BMCDATE=$ORDER(^XTMP("BMCRR19",BMCJOB,BMCBT,"DATA HITS",BMCDATE))
- IF BMCDATE=""!(BMCQUIT)
- QUIT
- DO P
- XIT ;
- +1 KILL ^XTMP("BMCRR19",BMCJOB,BMCBT)
- +2 DO DONE^BMCRLP2
- +3 DO KILL^AUPNPAT
- +4 KILL BMCDATE,BMCI,BMCCTYP,BMCRNUMB
- +5 QUIT
- P ;
- +1 SET BMCPN=""
- FOR
- SET BMCPN=$ORDER(^XTMP("BMCRR19",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 BMCREF=0
- FOR
- SET BMCREF=$ORDER(^XTMP("BMCRR19",BMCJOB,BMCBT,"DATA HITS",BMCDATE,BMCPN,BMCREF))
- IF BMCREF'=+BMCREF!(BMCQUIT)
- QUIT
- SET BMCRREC=^BMCREF(BMCREF,0)
- SET DFN=$PIECE(BMCRREC,U,3)
- DO PRINT1
- +3 QUIT
- PRINT1 ;
- +1 SET BMCRNUMB=$PIECE($GET(^BMCREF(BMCREF,0)),U,2)
- +2 IF $Y>(IOSL-3)
- DO HEAD
- IF BMCQUIT
- QUIT
- +3 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)
- +4 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)
- +5 WRITE !,"Tribe: ",$EXTRACT($$TRIBE^AUPNPAT(DFN,"E"),1,20),?32,"Req Provider: ",$$VAL^XBDIQ1(90001,BMCREF,.06)
- +6 WRITE !,"Referral #: ",BMCRNUMB
- WRITE ?32,"Date Referral Initiated: ",$$REFDTI^BMCRLU(BMCREF,"S")
- +7 SET BMCC=0
- WRITE !,"3RD Party: "
- IF $$MCR^AUPNPAT(DFN,$SELECT($$AVDOS^BMCRLU(BMCREF,"I")]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:$PIECE(BMCRREC,U)))
- WRITE "MEDICARE"
- SET BMCC=BMCC+1
- +8 IF $$MCD^AUPNPAT(DFN,$SELECT($$AVDOS^BMCRLU(BMCREF,"I")]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:$PIECE(BMCRREC,U)))
- Begin DoDot:1
- +9 IF BMCC
- WRITE " "
- WRITE "MEDICAID: ",$$MCDPN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCREF,"I"),"E")
- SET BMCC=BMCC+1
- End DoDot:1
- +10 IF $$PI^AUPNPAT(DFN,$SELECT($$AVDOS^BMCRLU(BMCREF,"I")]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:$PIECE(BMCRREC,U)))
- Begin DoDot:1
- +11 IF BMCC
- WRITE " "
- WRITE $$PIN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCREF,"I"),"E")
- End DoDot:1
- +12 IF $Y>(IOSL-3)
- DO HEAD
- IF BMCQUIT
- QUIT
- +13 WRITE !,"Refer To:",?10,$EXTRACT($$FACREF^BMCRLU(BMCREF),1,20),?32,$SELECT($$VAL^XBDIQ1(90001,BMCREF,.09)]"":"Provider: "_$$VAL^XBDIQ1(90001,BMCREF,.09),1:"")
- SECREF ;Secondary Referral
- +1 DO SECREF2^BMCRUTL
- PRIPAY ;Primary Payor
- +1 IF $PIECE(BMCRREC,U,11)'=""
- WRITE !,"Primary Payor: "_$$VAL^XBDIQ1(90001,BMCREF,.11)
- +2 ;
- TYPE ;
- +1 IF $PIECE(BMCRREC,U,4)'=""
- WRITE ?50,"Referral Type: "_$$VAL^XBDIQ1(90001,BMCREF,.04)
- +2 IF $PIECE(BMCRREC,U,14)="I"
- Begin DoDot:1
- +3 WRITE !,"Inpatient Admission Date: ",$$AVDOS^BMCRLU(BMCREF,"C"),?45,"LOS: ",$$AVLOS^BMCRLU(BMCREF,"C")
- End DoDot:1
- IF BMCQUIT
- QUIT
- IF 1
- +4 IF '$TEST
- Begin DoDot:1
- +5 WRITE !,"Outpatient Services requested for: ",$$AVDOS^BMCRLU(BMCREF,"C")," # of Visits: ",$$VAL^XBDIQ1(90001,BMCREF,1111)
- End DoDot:1
- PURPOSE ;
- +1 IF $Y>(IOSL-3)
- DO HEAD
- IF BMCQUIT
- QUIT
- +2 KILL BMCP
- WRITE !,"Purpose:"
- +3 ;BMC*3.1*12 ADDED TR COMMAND
- SET BMCP=$$GET1^DIQ(90001,BMCREF,1201,"","BMCP")
- SET BMCP=$TRANSLATE(BMCP,"|","")
- +4 SET DIWL=1
- SET DIWF="C66"
- SET X=BMCP
- DO ^DIWP
- +5 SET (C,Z)=0
- FOR
- SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
- IF Z'=+Z!(BMCQUIT)
- QUIT
- SET C=C+1
- IF $Y>(IOSL-3)
- DO HEAD
- IF BMCQUIT
- QUIT
- IF C'=1
- WRITE !
- WRITE ?10,^UTILITY($JOB,"W",DIWL,Z,0)
- +6 IF BMCQUIT
- QUIT
- +7 KILL DIWL,DIWR,DIWF,Z,^UTILITY($JOB,"W"),BMCNODE,BMCFILE,BMCG,BMCCOL
- PERTMED ;
- +1 SET BMCCTYP="M"
- +2 IF $DATA(^BMCCOM("AD",BMCREF))
- DO BO^BMCRUTL
- +3 IF BMCQUIT
- QUIT
- DX ;Print either prov nar/canned nar
- +1 IF $Y>(IOSL-3)
- DO HEAD
- IF BMCQUIT
- QUIT
- +2 WRITE !,"Dx Cat:",?10,$$GET1^DIQ(90001,BMCREF,.12)
- +3 IF $DATA(^BMCDX("AD",BMCREF))
- Begin DoDot:1
- +4 WRITE !,"Dx:"
- +5 ;BMC*4.0*9
- SET BMCDOS=$$AVDOS^BMCRLU(BMCREF,"N")
- +6 SET (C,X)=0
- FOR
- SET X=$ORDER(^BMCDX("AD",BMCREF,X))
- IF X'=+X!(BMCQUIT)
- QUIT
- SET C=C+1
- SET BMCD=+^BMCDX(X,0)
- IF $Y>(IOSL-3)
- DO HEAD
- IF BMCQUIT
- QUIT
- IF C'=1
- WRITE !
- Begin DoDot:2
- +7 SET BMCDXDOC=""
- IF $PIECE($GET(^BMCDX(X,0)),U,6)'=""
- SET BMCDXDOC=$PIECE($GET(^BMCDX(X,0)),U,6)
- +8 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES;4.0*9 11.2.2012 IHS.OIT.FCJ CHG FOR ICD-10
- +9 ;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))
- +10 ;W ?10,$P_source.html#xP">P_source.html#xP_source.html#xP">P">P_source.html#xP">P($$ICDDX^ICDCODE(BMCD,0),U,2),?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($$ICDDX^ICDCODE(BMCD,0),U,4),1,50))
- +11 WRITE ?10,$PIECE($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,2),?19," - ",$SELECT(BMCDXDOC'="":$EXTRACT($PIECE(^AUTNPOV(BMCDXDOC,0),U,1),1,50),1:$EXTRACT($PIECE($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,4),1,50))
- End DoDot:2
- End DoDot:1
- IF 1
- PROC ;
- +1 IF $Y>(IOSL-3)
- DO HEAD
- IF 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(^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)
- +7 FOR
- SET X=$ORDER(^BMCPX("AD",BMCREF,X))
- IF X'=+X!(BMCQUIT)
- QUIT
- SET C=C+1
- SET BMCD=+^BMCPX(X,0)
- IF $Y>(IOSL-3)
- DO HEAD
- IF BMCQUIT
- QUIT
- IF C'=1
- WRITE !
- WRITE ?10,$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:",?10,$$GET1^DIQ(90001,BMCREF,.13)
- End DoDot:1
- +10 IF BMCQUIT
- QUIT
- BOC ;
- +1 IF $Y>(IOSL-3)
- DO HEAD
- IF BMCQUIT
- QUIT
- +2 WRITE !,"Priority: ",$$VAL^XBDIQ1(90001,BMCREF,.32)," CHS Auth Dec: ",$$VAL^XBDIQ1(90001,BMCREF,1112)," MCC Action: ",$$VAL^XBDIQ1(90001,BMCREF,1123)
- +3 WRITE !,"Utilization Review by MD: ",$$VAL^XBDIQ1(90001,BMCREF,1125)
- LOCAT ;Print Local Categories
- +1 IF $DATA(^BMCREF(BMCREF,21,0))
- Begin DoDot:1
- +2 SET BMCLOCC=0
- +3 FOR
- SET BMCLOCC=$ORDER(^BMCREF(BMCREF,21,"B",BMCLOCC))
- IF BMCLOCC'=+BMCLOCC
- QUIT
- Begin DoDot:2
- +4 SET BMCLOCI=0
- +5 FOR
- SET BMCLOCI=$ORDER(^BMCREF(BMCREF,21,"B",BMCLOCC,BMCLOCI))
- IF BMCLOCI'=+BMCLOCI
- QUIT
- Begin DoDot:3
- +6 SET BMCLOCP=$PIECE(^BMCREF(BMCREF,21,BMCLOCI,0),U)
- +7 IF BMCLOCP=""
- QUIT
- +8 SET BMCLOCPP=$PIECE(^BMCLCAT(BMCLOCP,0),U)
- +9 WRITE !,"Local Category: "_BMCLOCPP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 ;
- +11 ;
- BO ;Business office Comments
- +1 SET BMCCTYP="B"
- +2 IF $DATA(^BMCCOM("AD",BMCREF))
- DO BO^BMCRUTL
- +3 IF BMCQUIT
- QUIT
- 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 SET Y=DT
- DO DD^%DT
- WRITE ?(80-$LENGTH(Y)/2),Y,!
- +5 WRITE ?21,"**WEEKLY CHS REVIEW LISTING BY DATE**"
- +6 SET Y=BMCBD
- DO DD^%DT
- WRITE !,?28,"BEG DATE: "_Y
- +7 SET Y=BMCED
- DO DD^%DT
- WRITE !,?28,"END DATE: "_Y
- +8 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
- +9 QUIT
