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