source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARAMLF.m@ 1800

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

initial load of WorldVistAEHR

File size: 943 bytes
Line 
1MCARAMLF ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NODHCP NAME ;2/27/95 19:25
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ;
5 ; Called from ^MCARAML
6 ; Retransmits transaction records cross-referenced by non-DHCP name
7 N MCIEN,MCZERO,MCDATE,MCSSN,MCNAME,MCI,MCJ,MCK
8 S MCNAME=0
9 F MCI=1:1 S MCNAME=$O(^MCAR(700.5,"PT",MCNAME)) Q:MCNAME="" I (MCNAME["=>")!(MCNAME["<=") S MCIEN=0 F MCK=1:1 S MCIEN=$O(^MCAR(700.5,"PT",MCNAME,MCIEN)) Q:MCIEN="" 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 D SET Q
17 ;
18SET ;
19 I MCSSN="" S MCSSN="NO SSN"
20 I MCDATE="" S MCDATE="NO DATE"
21 I $L(MCNAME)<30 F MCJ=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
22 I $L(MCSSN)<10 F MCJ=$L(MCSSN):1:10 S MCSSN=MCSSN_" "
23 I $D(^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)) Q
24 S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
25 S ^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)=""
26 S ^TMP($J,0,"MC",0)=MCCNT
27 Q
Note: See TracBrowser for help on using the repository browser.