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

MCARAMLD.m

Go to the documentation of this file.
  1. MCARAMLD ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NO EKG DIAG ;2/27/95 18:01
  1. ;;2.3;Medicine;;09/13/1996
  1. ;
  1. ;
  1. ;Called from ^MCARAML
  1. ;Retransmits EKG records without diagnoses
  1. N MCIEN,MCI,MCJ,D,X,Y,DIC,MCNAME,MCDATE,MCSSN
  1. S MCIEN=0
  1. F S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN="B" I '$D(^MCAR(691.5,MCIEN,9)) D SET
  1. Q
  1. ;
  1. SET ;
  1. I '$D(^MCAR(691.5,MCIEN,0)) Q
  1. S MCSSN="NO SSN"
  1. I $D(^MCAR(691.5,MCIEN,.1)) S MCSSN=^MCAR(691.5,MCIEN,.1)
  1. S MCDATE=$P(^MCAR(691.5,MCIEN,0),"^") I MCDATE="" S MCDATE="NO DATE"
  1. S D="SSN",X=MCSSN,DIC(0)="XZ",DIC="^DPT(" D IX^DIC
  1. I +Y>0 S MCNAME=$P(Y(0),"^") I MCNAME="" S MCNAME="NO PATIENT NAME"
  1. I '$D(MCNAME) S MCNAME="NO PATIENT NAME"
  1. I $L(MCNAME)<30 F MCJ=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
  1. I $L(MCSSN)<10 F MCJ=$L(MCSSN):1:10 S MCSSN=MCSSN_" "
  1. I $D(^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)) Q
  1. S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
  1. S ^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)=""
  1. S ^TMP($J,0,"MC",0)=MCCNT
  1. Q