source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARAMLA.m@ 1789

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1MCARAMLA ;WASH ISC/JKL-MUSE AUTO RETRANSMISSION-TRAN INCOMP ;2/27/95 11:15
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ;
5 ;Called from ^MCARAML
6 ;Retransmit records with same date/time,
7 ;no transaction zero node, no EKG SSN, no EKG record by date
8 N MCDATE,MCIEN,MCZERO,MCNAME,MCSSN,MCI,MCJ,MCK,MCL,MCERR
9 S MCDATE=0
10 F MCI=1:1 S MCDATE=$O(^MCAR(700.5,"B",MCDATE)) Q:MCDATE="" D FORMAT
11 Q
12FORMAT ;
13 S MCIEN=0 F MCJ=1:1 S MCIEN=$O(^MCAR(700.5,"B",MCDATE,MCIEN)) Q:MCIEN="" D SAVE
14 Q
15SAVE ;
16 I '$D(^MCAR(700.5,MCIEN,0)) Q
17 S MCZERO=^MCAR(700.5,MCIEN,0),MCNAME=$P(MCZERO,"^",4),MCSSN=$P(MCZERO,"^",3)
18 I $P(MCZERO,"^",2)="MHOLT" Q
19 I '$D(^MCAR(691.5,"B",MCDATE)) D SET Q
20 S (MCERR,MCEKG)=0
21 F MCK=1:1 S MCEKG=$O(^MCAR(691.5,"B",MCDATE,MCEKG)) Q:MCEKG="" Q:('$D(^MCAR(691.5,MCEKG,.1))) I MCSSN=^MCAR(691.5,MCEKG,.1) S MCERR=1
22 I MCERR>0 Q
23 D SET Q
24SET ;
25 I MCNAME="" S MCNAME="NO PATIENT NAME"
26 I MCSSN="" S MCSSN="NO SSN"
27 I $L(MCNAME)<30 F MCL=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
28 I $L(MCSSN)<10 F MCL=$L(MCSSN):1:10 S MCSSN=MCSSN_" "
29 I $D(^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)) Q
30 S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
31 S ^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)=""
32 S ^TMP($J,0,"MC",0)=MCCNT
33 Q
Note: See TracBrowser for help on using the repository browser.