source: FOIAVistA/trunk/r/MEDICINE-MC/MCARAMLD.m@ 1683

Last change on this file since 1683 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 947 bytes
Line 
1MCARAMLD ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NO EKG DIAG ;2/27/95 18:01
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ;
5 ;Called from ^MCARAML
6 ;Retransmits EKG records without diagnoses
7 N MCIEN,MCI,MCJ,D,X,Y,DIC,MCNAME,MCDATE,MCSSN
8 S MCIEN=0
9 F S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN="B" I '$D(^MCAR(691.5,MCIEN,9)) D SET
10 Q
11 ;
12SET ;
13 I '$D(^MCAR(691.5,MCIEN,0)) Q
14 S MCSSN="NO SSN"
15 I $D(^MCAR(691.5,MCIEN,.1)) S MCSSN=^MCAR(691.5,MCIEN,.1)
16 S MCDATE=$P(^MCAR(691.5,MCIEN,0),"^") I MCDATE="" S MCDATE="NO DATE"
17 S D="SSN",X=MCSSN,DIC(0)="XZ",DIC="^DPT(" D IX^DIC
18 I +Y>0 S MCNAME=$P(Y(0),"^") I MCNAME="" S MCNAME="NO PATIENT NAME"
19 I '$D(MCNAME) S MCNAME="NO PATIENT NAME"
20 I $L(MCNAME)<30 F MCJ=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
21 I $L(MCSSN)<10 F MCJ=$L(MCSSN):1:10 S MCSSN=MCSSN_" "
22 I $D(^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)) Q
23 S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
24 S ^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)=""
25 S ^TMP($J,0,"MC",0)=MCCNT
26 Q
Note: See TracBrowser for help on using the repository browser.