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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAMLD 973 printed Dec 13, 2024@02:12:12 Page 2
MCARAMLD ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NO EKG DIAG ;2/27/95 18:01
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+4 ;Called from ^MCARAML
+5 ;Retransmits EKG records without diagnoses
+6 NEW MCIEN,MCI,MCJ,D,X,Y,DIC,MCNAME,MCDATE,MCSSN
+7 SET MCIEN=0
+8 FOR
SET MCIEN=$ORDER(^MCAR(691.5,MCIEN))
if MCIEN="B"
QUIT
IF '$DATA(^MCAR(691.5,MCIEN,9))
DO SET
+9 QUIT
+10 ;
SET ;
+1 IF '$DATA(^MCAR(691.5,MCIEN,0))
QUIT
+2 SET MCSSN="NO SSN"
+3 IF $DATA(^MCAR(691.5,MCIEN,.1))
SET MCSSN=^MCAR(691.5,MCIEN,.1)
+4 SET MCDATE=$PIECE(^MCAR(691.5,MCIEN,0),"^")
IF MCDATE=""
SET MCDATE="NO DATE"
+5 SET D="SSN"
SET X=MCSSN
SET DIC(0)="XZ"
SET DIC="^DPT("
DO IX^DIC
+6 IF +Y>0
SET MCNAME=$PIECE(Y(0),"^")
IF MCNAME=""
SET MCNAME="NO PATIENT NAME"
+7 IF '$DATA(MCNAME)
SET MCNAME="NO PATIENT NAME"
+8 IF $LENGTH(MCNAME)<30
FOR MCJ=$LENGTH(MCNAME):1:30
SET MCNAME=MCNAME_" "
+9 IF $LENGTH(MCSSN)<10
FOR MCJ=$LENGTH(MCSSN):1:10
SET MCSSN=MCSSN_" "
+10 IF $DATA(^TMP($JOB,0,"MC",MCNAME,MCSSN,MCDATE))
QUIT
+11 SET MCCNT=MCCNT+1
if MCCNT#100=0
WRITE "."
+12 SET ^TMP($JOB,0,"MC",MCNAME,MCSSN,MCDATE)=""
+13 SET ^TMP($JOB,0,"MC",0)=MCCNT
+14 QUIT
