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

BMCREF.m

Go to the documentation of this file.
  1. BMCREF ; IHS/PHXAO/TMJ - SET REFERRAL VARIABLES ;
  1. ;;4.0;REFERRED CARE INFO SYSTEM;**7**;JAN 09, 2006;Build 101
  1. ;
  1. ; BMCRIEN=referral ien
  1. ; BMCRDATE=referral date in internal FileMan form (.01 field)
  1. ; BMCRNUMB=referral number (.02 field)
  1. ; BMCDFN=patient ien (.03 field)
  1. ; BMCRTYPE=type of referral (.04 field)
  1. ; BMCCHSCT=CHS authorization count (1115 field)
  1. ; BMCRIO=Inpatient or Outpatient (.14 field)
  1. ; BMCREC("PAT NAME")=patient name
  1. ; BMCREC("REF DATE")=referral date in external form
  1. ; BMCSUF=Secondary referral suffix ;4.0*7
  1. ;
  1. START ;
  1. Q:$D(BMCOVRPS) ;override post selection variable
  1. S (BMCCHSCT,BMCRIEN,BMCRDATE,BMCRNUMB,BMCDFN,BMCRTYPE,BMCRIO,BMCREC("PAT NAME"),BMCREC("REF DATE"))=""
  1. Q:'$G(Y)
  1. Q:'$D(^BMCREF(+Y,0))
  1. NEW X
  1. S BMCRIEN=+Y
  1. S X=^BMCREF(BMCRIEN,0)
  1. S BMCRDATE=$P(X,U)
  1. S BMCRNUMB=$P(X,U,2)
  1. S BMCDFN=$P(X,U,3)
  1. S BMCRSTAT=$P(X,U,15)
  1. S BMCRTYPE=$P(X,U,4)
  1. S BMCRIO=$P(X,U,14)
  1. S:$G(BMCDFN) BMCREC("PAT NAME")=$P(^DPT(BMCDFN,0),U)
  1. ;
  1. S BMCCHSCT=+$P($G(^BMCREF(BMCRIEN,11)),U,15)
  1. S BMCSUF=$P($G(^BMCREF(BMCRIEN,1)),U) ;4.0 FCJ
  1. ;
  1. NEW Y
  1. S Y=BMCRDATE
  1. D DD^%DT
  1. S BMCREC("REF DATE")=Y
  1. Q
  1. ;
  1. ;
  1. ;
  1. SETCA ;EP - trigger the CHS APPROVAL STATUS AUDIT multiple from
  1. ;call fileman with a xbnew call
  1. NEW BMCCA
  1. S BMCCA("DA")=DA,BMCCA("NEW")=$S($G(BMCNEWV)]"":BMCNEWV,1:X),BMCCA("OLD")=$S($G(BMCOLDV)]"":BMCOLDV,$D(D):$P(D,U,12),1:""),BMCCA("OPT")=$P($G(XQY0),U)
  1. I BMCCA("NEW")=BMCCA("OLD") K BMCCA Q ;don't update audit if values are the same
  1. D EN^XBNEW("SETCA1^BMCREF","BMCCA")
  1. K BMCCA
  1. Q
  1. SETCA1 ;EP entry point for XBNEW
  1. S DA=BMCCA("DA")
  1. S DIADD=1,DIE="^BMCREF(",DR="4200///NOW",DR(2,90001.42)=".02////^S X=DUZ;.04///"_$G(BMCCA("OLD"))_";.05///"_$G(BMCCA("NEW"))_";.03///"_$S(BMCCA("OPT")]"":BMCCA("OPT"),1:"UNKNOWN") D ^DIE K DIE,DA,DR,DIADD
  1. Q
  1. KILLCA ;EP trigger the CHS APPROVAL STATUS AUDIT multiple
  1. ;from the kill side of CHS APPROVAL STATUS xref AAS
  1. ;if this is not a delete just quit and set on set side
  1. Q:$P($G(^BMCREF(DA,11)),U,12)]"" ;this is a change or add
  1. NEW BMCCA
  1. S BMCCA("DA")=DA,BMCCA("OLD")=X,BMCCA("NEW")=""
  1. D EN^XBNEW("SETCA1^BMCREF","BMCCA")
  1. K BMCCA
  1. Q