27 lines
947 B
Mathematica
27 lines
947 B
Mathematica
MCARAMLD ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NO EKG DIAG ;2/27/95 18:01
|
|
;;2.3;Medicine;;09/13/1996
|
|
;
|
|
;
|
|
;Called from ^MCARAML
|
|
;Retransmits EKG records without diagnoses
|
|
N MCIEN,MCI,MCJ,D,X,Y,DIC,MCNAME,MCDATE,MCSSN
|
|
S MCIEN=0
|
|
F S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN="B" I '$D(^MCAR(691.5,MCIEN,9)) D SET
|
|
Q
|
|
;
|
|
SET ;
|
|
I '$D(^MCAR(691.5,MCIEN,0)) Q
|
|
S MCSSN="NO SSN"
|
|
I $D(^MCAR(691.5,MCIEN,.1)) S MCSSN=^MCAR(691.5,MCIEN,.1)
|
|
S MCDATE=$P(^MCAR(691.5,MCIEN,0),"^") I MCDATE="" S MCDATE="NO DATE"
|
|
S D="SSN",X=MCSSN,DIC(0)="XZ",DIC="^DPT(" D IX^DIC
|
|
I +Y>0 S MCNAME=$P(Y(0),"^") I MCNAME="" S MCNAME="NO PATIENT NAME"
|
|
I '$D(MCNAME) S MCNAME="NO PATIENT NAME"
|
|
I $L(MCNAME)<30 F MCJ=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
|
|
I $L(MCSSN)<10 F MCJ=$L(MCSSN):1:10 S MCSSN=MCSSN_" "
|
|
I $D(^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)) Q
|
|
S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
|
|
S ^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)=""
|
|
S ^TMP($J,0,"MC",0)=MCCNT
|
|
Q
|