| [613] | 1 | MCARAMLD ;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 | ;
|
|---|
| 12 | SET ;
|
|---|
| 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
|
|---|
