source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARAMLB.m@ 837

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

initial load of WorldVistAEHR

File size: 934 bytes
RevLine 
[613]1MCARAMLB ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-TRAN DATE ;2/27/95 16:35
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ;
5 ; Called from ^MCARAML
6 ; Retransmits transaction record without EKG,tran date cross-reference
7 N MCIEN,MCZERO,MCDATE,MCSSN,MCNAME,MCI,MCJ
8 S MCIEN=0
9 F MCI=1:1 S MCIEN=$O(^MCAR(700.5,MCIEN)) Q:MCIEN=""!(MCIEN="B") D SAVE
10 Q
11 ;
12SAVE ;
13 I '$D(^MCAR(700.5,MCIEN,0)) Q
14 S MCZERO=^MCAR(700.5,MCIEN,0),MCDATE=$P(MCZERO,"^"),MCSSN=$P(MCZERO,"^",3)
15 I $P(MCZERO,"^",2)="MHOLT" Q
16 S MCNAME=$P(MCZERO,"^",4)
17 I $D(^MCAR(691.5,"B",MCDATE)),$D(^MCAR(700.5,"B",MCDATE)) Q
18 D SET Q
19 ;
20SET ;
21 I MCNAME="" S MCNAME="NO PATIENT NAME"
22 I MCSSN="" S MCSSN="NO SSN"
23 I $L(MCNAME)<30 F MCJ=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
24 I $L(MCSSN)<10 F MCJ=$L(MCSSN):1:10 S MCSSN=MCSSN_" "
25 I $D(^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)) Q
26 S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
27 S ^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)=""
28 S ^TMP($J,0,"MC",0)=MCCNT
29 Q
Note: See TracBrowser for help on using the repository browser.