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

BMCRR81.m

Go to the documentation of this file.
  1. BMCRR81 ; IHS/PHXAO/TMJ - PROCESS REFERRAL LIST ;
  1. ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
  1. ;IHS/ITSC/FCJ ADDED TEST FOR SR
  1. ;
  1. ;
  1. START ;
  1. S (BMCBT,BMCBTH)=$H,BMCJOB=$J,BMCRCNT=0
  1. D PROCESS,END
  1. Q
  1. ;
  1. PROCESS ;
  1. V ; Run by visit date
  1. S BMCODAT=$O(^BMCREF("B",BMCSD)) I BMCODAT="" S BMCET=$H Q
  1. S BMCODAT=BMCSD_".9999" F S BMCODAT=$O(^BMCREF("B",BMCODAT)) Q:BMCODAT=""!((BMCODAT\1)>BMCED) D R1
  1. Q
  1. ;
  1. END ;
  1. S BMCET=$H
  1. Q
  1. R1 ;
  1. S BMCREF="" F S BMCREF=$O(^BMCREF("B",BMCODAT,BMCREF)) Q:BMCREF'=+BMCREF S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3) D PROCR
  1. Q
  1. PROCR ;
  1. Q:$P(BMCRREC,U,4)="N"
  1. Q:$P(BMCRREC,U,15)="X"
  1. Q:$P($G(^BMCREF(BMCREF,1)),U)'="" ;QUIT IF SR
  1. I '$D(^BMCDX("AD",BMCREF)) Q ;no icd codes/cpt codes
  1. S (BMCX,BMCFOUN)=0 F S BMCX=$O(^BMCDX("AD",BMCREF,BMCX)) Q:BMCX'=+BMCX!(BMCFOUN) S BMCFOUN=$$TXC^ATXTXCHK(+^BMCDX(BMCX,0),BMCHCTAX)
  1. Q:'BMCFOUN
  1. S ^XTMP("BMCRR8",BMCJOB,BMCBTH,"DATA HITS",$P(^DPT(DFN,0),U),DFN,BMCREF)=""
  1. Q