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

BMCALERT.m

Go to the documentation of this file. 
  1. BMCALERT ; IHS/PHXAO/TMJ - RCIS ALERTS ; 02 Mar 2009  2:48 PM
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**3,4,5,8**;JAN 09, 2006;Build 101
  1.  ;BMC*4.0*3 9.20.2007 IHS.OIT.FCJ ADDED NEW ALERT FOR PRIM PROV AND REF PHY
  1.  ;BMC*4.0*4 11.12.2008 IHS.OIT.FCJ FIXED ALERT TO TRANSFER TO EHR
  1.  ;BMC*4.0*5 3.4.2009 IHS.OIT.FCJ ADDED TXT AND COM SECTION TO RNT FOR ALERT
  1.  ;
  1. EN1 ; EP - POSSIBLE HIGH COST ALERT (ROLL AND SCROLL)
  1.  Q:$P(^BMCREF(BMCRIEN,0),U,4)="O"  ;         quit if type=other
  1.  W !,"You are entering a diagnosis that indicates this may be a high cost case.",!,"You may want to carefully explore alternative resources and alert your case",!,"manager."
  1.  Q
  1.  ;
  1. EN2 ; EP - COSMETIC PROCEDURE ALERT (ROLL AND SCROLL)
  1.  Q:$P(^BMCREF(BMCRIEN,0),U,4)="O"  ;         quit if type=other
  1.  W !,"You are entering a cosmetic procedure that may require CMO approval."
  1.  Q
  1.  ;
  1. EN3 ;EP - POSSIBLE HIGH COST PROCEDURE ALERT (ROLL AND SCROLL)
  1.  ;
  1.  Q:$P(^BMCREF(BMCRIEN,0),U,4)="O"  ;         quit if type=other
  1.  W !,"You are entering a procedure that indicates this may be a high cost case.",!,"You may want to carefully explore alternative resources and alert your case",!,"manager."
  1.  Q
  1.  ;
  1. EN4 ;EP - EXPERIMENTAL CPT PROCEDURE ALERT (ROLL AND SCROLL)
  1.  ;
  1.  ;
  1.  Q:$P(^BMCREF(BMCRIEN,0),U,4)="O"  ;         quit if type=other
  1.  W !,"You are entering a procedure that indicates this may be a Experimental",!,"Procedure.  If so, CHS funds cannot be used to pay for this procedure."
  1.  Q
  1.  ;
  1. EN5 ;EP - 3RD PARTY LIABILITY ALERT (ROLL AND SCROLL)
  1.  ;
  1.  Q:$P(^BMCREF(BMCRIEN,0),U,4)="O"  ;         quit if type=other
  1.  W !,"You are entering a diagnosis that indicates this may involve third party",!,"liability.  You may want to investigate this possibility in order to recover",!,"costs."
  1.  Q
  1. PALRT1 ;EP-ALERT FOR PHYS
  1.  ;BMC*4.0*3 9.20.2007 IHS.OIT.FCJ ADDED NEW ALERT FOR PRIM PROV AND REF PHY
  1.  ;
  1.  W !!,"Processing alert for Physician(s)." H 1
  1.  NEW XQAID,XQAMSG,XQAROU,XQADATA,XQAARCH,XQAFLG,XQAGUID,XQAOPT,XQASUPV,XQASURO,XQATEXT,XQALERR
  1.  ;BMC*4.0*4 7/9/2008 IHS/OIT/FCJ Changed Package ID To "OR" and 27 which is service consult/request in the OE/RR notification file- Required for EHR
  1.  ;S XQAID="BMC REFERRED CARE INFO SYSTEM"
  1.  S XQAID="OR,"_BMCDFN_",46"
  1.  S XQAMSG="Referral "_BMCRHDR_": "_BMCREC("PAT NAME")
  1.  S XQAROU="PALRT2^BMCALERT"
  1.  S XQADATA=BMCRIEN
  1.  ;SETS PRIM PROV AND REF PROV TO AUTO SEND MESSAGE TO
  1.  I '$D(XQA) D
  1.  .I $P($G(^BMCPARM(DUZ(2),4100)),U,10)="Y" S BMCPPRV=$P(^AUPNPAT(BMCDFN,0),U,14) I BMCPPRV'="" S XQA(BMCPPRV)=""
  1.  .I $P($G(^BMCPARM(DUZ(2),4100)),U,9)="Y" S BMCRPRV=$P(^BMCREF(BMCRIEN,0),U,6) I BMCRPRV'="" S XQA(BMCRPRV)=""
  1.  I '$G(BMCPPRV) W !,"Primary Care Provider is not definned.",?45,"***ALERT WAS NOT SENT***"
  1.  I '$G(BMCRPRV) W !,"Referring Provider is not definned.",?45,"***ALERT WAS NOT SENT***"
  1.  Q:'$G(BMCPPRV)&'$G(BMCRPRV)
  1.  ;FCJ COMMENTED OUT NXT LINE AND ADDED FOLLOWING 3 LINES
  1.  ;D TXT S XQATEXT="BMCTXT" ;BMC*4.0*5 3.4.2009 IHS.OIT.FCJ NEW LINE
  1.  D TXT
  1.  I $$PATCH^XPDUTL("XU*8.0*1016") M XQATEXT=BMCTXT
  1.  E  S XQATEXT="BMCTXT"
  1.  D SETUP^XQALERT
  1.  K XQA,XQAID,XQAMSG,XQAROU,XQADATA,XQAARCH,XQAFLG,XQAGUID,XQAOPT,XQASUPV,XQASURO,XQATEXT,XQALERR,BMCTXT
  1.  Q
  1. PALRT2 ;ALERT TO DISPLAY
  1.  S BMCRIEN=XQADATA
  1.  S BMCREC=^BMCREF(BMCRIEN,0)
  1.  D EN^BMCAL1
  1.  Q
  1. TXT ;BMC*4.0*5 3.4.2009 IHS.OIT.FCJ ADDED SECTION
  1.  S BMCTXT(1)="Patient: "_$E($P(^DPT($P(^BMCREF(BMCRIEN,0),U,3),0),U),1,25)_"      Chart #: "_$S($D(^AUPNPAT($P(^BMCREF(BMCRIEN,0),U,3),41,DUZ(2),0)):$P(^(0),U,2),1:"None")
  1.  S BMCTXT(2)="Date Referral Initiated: "_$$VAL^XBDIQ1(90001,BMCRIEN,.01)
  1.  S BMCTXT(3)="Requesting Provider: "_$$VAL^XBDIQ1(90001,BMCRIEN,.06)
  1.  S BMCTXT(4)="Purpose of Referral: "_$$VAL^XBDIQ1(90001,BMCRIEN,1201)
  1.  S BMCTXT(5)="Referred To: "_$$TOFAC^BMC(BMCRIEN)
  1.  S BMCTST(6)="Notes to Scheduler: ",BMCV=$$VAL^XBDIQ1(90001,BMCRIEN,1301)
  1.  S BMCSTR="Priority: "_$$VAL^XBDIQ1(90001,BMCRIEN,.32)
  1.  S BMCTXT(7)=BMCSTR_"  Ref Type: "_$$VAL^XBDIQ1(90001,BMCRIEN,.04)_"     Date of Service: "_$$AVDOS^BMCRLU(BMCRIEN,"C")
  1.  S BMCT=7
  1.  Q:BMCRHDR="New"  ;BMC*4.0*8 NEW LINE
  1.  D COM
  1.  Q
  1. COM ;BO COMMENTS;BMC*4.0*5 3.4.2009 IHS.OIT.FCJ ADDED SECTION
  1.  Q:'$D(^BMCCOM("AD",BMCRIEN))
  1.  S BMCCDFN="" F  S BMCCDFN=$O(^BMCCOM("AD",BMCRIEN,BMCCDFN)) Q:BMCCDFN'?1N.N  D
  1.  .Q:$P(^BMCCOM(BMCCDFN,0),U,5)'="B"
  1.  .S BMCT=BMCT+1,BMCTXT(BMCT)="",BMCT=BMCT+1
  1.  .S BMCTXT(BMCT)="COMMENT DATE: "_$$VAL^XBDIQ1(90001.03,BMCCDFN,.01)_"    REVIEWER: "_$$VAL^XBDIQ1(90001.03,BMCCDFN,.04)
  1.  .S F=0 F  S F=$O(^BMCCOM(BMCCDFN,1,F)) Q:F'?1N.N  D
  1.  ..S BMCT=BMCT+1
  1.  ..S BMCTXT(BMCT)=^BMCCOM(BMCCDFN,1,F,0)
  1.  K F,BMCT
  1.  Q
  1. APRV ;BMC*4.0*8 5.14.2013 IHS/ITSC/FCJ ALERT FOR REF STATUS CHG TO APPROVED
  1.  S Y=DA D START^BMCREF
  1.  Q:'$P(^BMCREF(BMCRIEN,0),U,6)    ;CALL-IN REF DO NOT HAVE A REF PROV
  1.  S BMCPPRV=$P(^AUPNPAT(BMCDFN,0),U,14),BMCRPRV=$P(^BMCREF(BMCRIEN,0),U,6),BMCRHDR="Approved"
  1.  NEW XQA
  1.  S XQA(BMCRPRV)=""  ;REF PHYS
  1.  I BMCPPRV'="",BMCPPRV'=BMCRPRV S XQA(BMCPPRV)="" ;PRIM PROV IF DIFFERENT
  1.  I $D(XQA) D PALRT1
  1.  Q