Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMCRR14P

BMCRR14P.m

Go to the documentation of this file. 
  1. BMCRR14P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ;     
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**3,9,12**;JAN 09, 2006;Build 101
  1.  ;IHS/OIT/FCJ ADDED PRINTING OF SEC REFERRAL INFO
  1.  ;   ADDED PRINTING OF DX CAT
  1.  ;4.0 8/15/05 IHS/OIT/FCJ ADDED ELIG STATUS
  1.  ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1.  ;4.0*9 11.2.2012 IHS.OIT.FCJ ADDED ICD-10 CHANGE
  1.  ;
  1.  S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^XTMP("BMCRR14",BMCJOB,BMCBT)) W !,"No referrals to report",! G XIT
  1.  S BMCPN=0,BMCQUIT=0
  1.  S BMCDATE="" F  S BMCDATE=$O(^XTMP("BMCRR14",BMCJOB,BMCBT,"DATA HITS",BMCDATE)) Q:BMCDATE=""!(BMCQUIT)  D P
  1. XIT ;
  1.  K ^XTMP("BMCRR14",BMCJOB,BMCBT)
  1.  D DONE^BMCRLP2
  1.  D KILL^AUPNPAT
  1.  K BMCDATE,BMCI,BMCCTYP,BMCRNUMB
  1.  Q
  1. P ;
  1.  S BMCPN="" F  S BMCPN=$O(^XTMP("BMCRR14",BMCJOB,BMCBT,"DATA HITS",BMCDATE,BMCPN)) Q:BMCPN=""!(BMCQUIT)  D PRINT
  1.  Q
  1. PRINT ;print one referral
  1.  I $Y>(IOSL-10) D HEAD Q:BMCQUIT
  1.  S BMCREF=0 F  S BMCREF=$O(^XTMP("BMCRR14",BMCJOB,BMCBT,"DATA HITS",BMCDATE,BMCPN,BMCREF)) Q:BMCREF'=+BMCREF!(BMCQUIT)  S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3) D PRINT1
  1.  Q
  1. PRINT1 ;
  1.  I $Y>(IOSL-3) D HEAD Q:BMCQUIT
  1.  S BMCRNUMB=$P($G(^BMCREF(BMCREF,0)),U,2)
  1.  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)
  1.  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)
  1.  W !,"Tribe: ",$E($$TRIBE^AUPNPAT(DFN,"E"),1,20),?32,"Req Provider: ",$$VAL^XBDIQ1(90001,BMCREF,.06)
  1.  W !,"Referral #: ",BMCRNUMB W ?32,"Date Referral Initiated: ",$$REFDTI^BMCRLU(BMCREF,"S")
  1.  W !,"Eligibility:  ",$$VAL^XBDIQ1(9000001,DFN,1112)  ;4.0 IHS/OIT/FCJ
  1.  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
  1.  I $$MCD^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCREF,"I")]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:$P(BMCRREC,U))) D
  1.  .W:BMCC "  " W "MEDICAID: ",$$MCDPN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCREF,"I"),"E") S BMCC=BMCC+1
  1.  I $$PI^AUPNPAT(DFN,$S($$AVDOS^BMCRLU(BMCREF,"I")]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:$P(BMCRREC,U))) D
  1.  .W:BMCC "  " W $$PIN^AUPNPAT(DFN,$$AVDOS^BMCRLU(BMCREF,"I"),"E")
  1.  I $Y>(IOSL-3) D HEAD Q:BMCQUIT
  1.  W !,"Refer To:",?10,$E($$FACREF^BMCRLU(BMCREF),1,20),?32,$S($$VAL^XBDIQ1(90001,BMCREF,.09)]"":"Provider:  "_$$VAL^XBDIQ1(90001,BMCREF,.09),1:"")
  1. SECREF ;PRINT SECONDARY REF
  1.  D SECREF2^BMCRUTL
  1. PRIPAY ;Primary Payor
  1.  I $P(BMCRREC,U,11)'="" W !,"Primary Payor: "_$$VAL^XBDIQ1(90001,BMCREF,.11)
  1.  ;
  1. TYPE ;Get Type
  1.  I $P(BMCRREC,U,4)'="" W ?50,"Referral Type:   "_$$VAL^XBDIQ1(90001,BMCREF,.04)
  1.  I $P(BMCRREC,U,14)="I" D  Q:BMCQUIT  I 1
  1.  .W !,"Inpatient Admission Date:  ",$$AVDOS^BMCRLU(BMCREF,"C"),?45,"LOS: ",$$AVLOS^BMCRLU(BMCREF,"C")
  1.  E  D
  1.  .W !,"Outpatient Services requested for: ",$$AVDOS^BMCRLU(BMCREF,"C")," # of Visits: ",$$VAL^XBDIQ1(90001,BMCREF,1111)
  1. PURPOSE ;
  1.  I $Y>(IOSL-3) D HEAD Q:BMCQUIT
  1.  K BMCP W !,"Purpose:"
  1.  S BMCP=$$GET1^DIQ(90001,BMCREF,1201,"","BMCP"),BMCP=$TR(BMCP,"|","")  ;BMC*3.1*12 ADDED TR COMMAND
  1.  S DIWL=1,DIWF="C66" S X=BMCP D ^DIWP
  1.  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)
  1.  Q:BMCQUIT
  1.  K DIWL,DIWR,DIWF,Z,^UTILITY($J,"W"),BMCNODE,BMCFILE,BMCG,BMCCOL
  1. PERTMED ;
  1.  S BMCCTYP="M"
  1.  D:$D(^BMCCOM("AD",BMCREF)) BO^BMCRUTL
  1.  Q:BMCQUIT
  1. DX ;Print either prov nar/canned nar
  1.  I $Y>(IOSL-3) D HEAD Q:BMCQUIT
  1.  ;7/27/04 IHS/ITSC/FCJ Added nxt line,Dx Cat will always print
  1.  W !,"Dx Cat:",?10,$$GET1^DIQ(90001,BMCREF,.12)
  1.  I $D(^BMCDX("AD",BMCREF)) D  I 1
  1.  .W !,"Dx:"
  1.  .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
  1.  ..;S BMCDXDOC="" I $P($G(^BMCDX(X,0)),U,6)'="" S BMCDXDOC=$P($G(^BMCDX(X,0)),U,6)
  1.  ..S BMCDOS=$$AVDOS^BMCRLU(BMCREF,"N") ;4.0*9
  1.  ..;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 AND ALWAYS PRINT ICD DESCRIPTION
  1.  ..;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))
  1.  ..;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))
  1.  ..;W ?10,$P($$ICDDX^ICDEX(BMCCDI,BMCDOS,,"E"),U,2),?19," - ",$E($P($$ICDDX^ICDEX(BMCCDI,BMCDOS),U,4),1,50) W:BMCDXDOC'="" !,"DX NAR: ",$E($P(^AUTNPOV(BMCDXDOC,0),U,1),1,50)
  1.  ..W ?10,$P($$ICDDX^ICDEX(BMCD,BMCDOS,,"I"),U,2),?19," - ",$E($P($$ICDDX^ICDEX(BMCD,BMCDOS),U,4),1,50)
  1. PROC ;
  1.  I $Y>(IOSL-3) D HEAD Q:BMCQUIT
  1.  I $D(^BMCPX("AD",BMCREF)) D  I 1
  1.  .W !,"Proc:"
  1.  .S (C,X)=0
  1.  .;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1.  .;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)
  1.  .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)
  1.  E  D
  1.  .W !,"Srv Cat:",?10,$$GET1^DIQ(90001,BMCREF,.13)
  1.  Q:BMCQUIT
  1. BOC ;
  1.  I $Y>(IOSL-3) D HEAD Q:BMCQUIT
  1.  W !,"Priority: ",$$VAL^XBDIQ1(90001,BMCREF,.32),"  CHS Auth Dec: ",$$VAL^XBDIQ1(90001,BMCREF,1112),"  MCC Action: ",$$VAL^XBDIQ1(90001,BMCREF,1123)
  1.  W !,"Utilization Review by MD: ",$$VAL^XBDIQ1(90001,BMCREF,1125)
  1. LOCAT ;Print Local Categories 
  1.  I $D(^BMCREF(BMCREF,21,0)) D
  1.  . S BMCLOCC=0
  1.  .F  S BMCLOCC=$O(^BMCREF(BMCREF,21,"B",BMCLOCC)) Q:BMCLOCC'=+BMCLOCC  D
  1.  ..S BMCLOCI=0
  1.  ..F  S BMCLOCI=$O(^BMCREF(BMCREF,21,"B",BMCLOCC,BMCLOCI)) Q:BMCLOCI'=+BMCLOCI  D
  1.  ... S BMCLOCP=$P(^BMCREF(BMCREF,21,BMCLOCI,0),U)
  1.  ... Q:BMCLOCP=""
  1.  ... S BMCLOCPP=$P(^BMCLCAT(BMCLOCP,0),U)
  1.  ... W !,"Local Category:   "_BMCLOCPP
  1.  ;
  1.  ;
  1. ALT ;Alternate Resource Letter Date
  1.  I $Y>(IOSL-3) D HEAD Q:BMCQUIT
  1.  W !,"Alternate Resource Letter Date: ",$$VAL^XBDIQ1(90001,BMCREF,1401)
  1. BO ;Business office comments
  1.  S BMCCTYP="B"
  1.  D:$D(^BMCCOM("AD",BMCREF)) BO^BMCRUTL
  1.  Q:BMCQUIT
  1. NEXT ;
  1.  W !,"--------------------",!
  1.  Q
  1.  Q:BMCQUIT    ;BMC*4.0*9
  1.  NEW X,Y,Z,C
  1.  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
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF
  1. HEAD2 ;
  1.  S BMCPG=BMCPG+1
  1.  W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
  1.  W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?72,"Page ",BMCPG,!
  1.  S Y=DT D DD^%DT W ?(80-$L(Y)/2),Y,!
  1.  W ?21,"**WEEKLY CHS REVIEW LISTING BY DATE**"
  1.  S Y=BMCBD D DD^%DT W !,?16,"BEG DATE: "_Y
  1.  S Y=BMCED D DD^%DT W ?40,"END DATE: "_Y
  1.  W !,$TR($J(" ",80)," ","-")
  1.  Q