MCARAMLC ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION NO TRAN ;2/27/95 17:18
;;2.3;Medicine;;09/13/1996
;
;
;Called from ^MCARAML
;Retransmits no EKG date cross-reference, misidentified PID
N MCNAME,MCSSN,MCDATE,MCPID,MCZERO,MCNAME2,MCI,MCJ,X,D,DIC,Y,MCK
N MCIEN,MCIEN2,MCERR
S (MCIEN,MCIEN2)=0
F MCI=1:1 S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN=""!(MCIEN="B") D SAVE
Q
;
SAVE ;
I '$D(^MCAR(691.5,MCIEN,0)) Q
S MCSSN="" I $D(^MCAR(691.5,MCIEN,.1)) S MCSSN=^MCAR(691.5,MCIEN,.1)
S MCZERO=^MCAR(691.5,MCIEN,0),MCNAME2=""
S MCDATE=$P(MCZERO,"^"),MCPID=$P(MCZERO,"^",2),MCNAME=""
I MCDATE="" Q
S X=MCSSN,DIC="^DPT(",D="SSN",DIC(0)="XZ" D IX^DIC
S:+Y>0 MCNAME=$P(Y(0),"^")
I MCPID'="",$D(^DPT(MCPID,0)) S MCNAME2=$P(^DPT(MCPID,0),"^")
I MCNAME'=MCNAME2 D SET Q
I '$D(^MCAR(700.5,"B",MCDATE)) D SET Q
I '$D(^MCAR(691.5,"B",MCDATE)) D SET Q
S MCERR=1 F MCK=1:1 S MCIEN2=$O(^MCAR(700.5,"B",MCDATE,MCIEN2)) Q:MCIEN2="" I $D(^MCAR(700.5,MCIEN2,0)),$P(^MCAR(700.5,MCIEN2,0),"^",3)=MCSSN S MCERR=0
I MCERR>0 D SET
Q
SET ;
I MCNAME="" S MCNAME="NO PATIENT NAME"
I MCSSN="" S MCSSN="NO SSN"
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[HMCARAMLC 1413 printed Dec 13, 2024@02:12:11 Page 2
MCARAMLC ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION NO TRAN ;2/27/95 17:18
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+4 ;Called from ^MCARAML
+5 ;Retransmits no EKG date cross-reference, misidentified PID
+6 NEW MCNAME,MCSSN,MCDATE,MCPID,MCZERO,MCNAME2,MCI,MCJ,X,D,DIC,Y,MCK
+7 NEW MCIEN,MCIEN2,MCERR
+8 SET (MCIEN,MCIEN2)=0
+9 FOR MCI=1:1
SET MCIEN=$ORDER(^MCAR(691.5,MCIEN))
if MCIEN=""!(MCIEN="B")
QUIT
DO SAVE
+10 QUIT
+11 ;
SAVE ;
+1 IF '$DATA(^MCAR(691.5,MCIEN,0))
QUIT
+2 SET MCSSN=""
IF $DATA(^MCAR(691.5,MCIEN,.1))
SET MCSSN=^MCAR(691.5,MCIEN,.1)
+3 SET MCZERO=^MCAR(691.5,MCIEN,0)
SET MCNAME2=""
+4 SET MCDATE=$PIECE(MCZERO,"^")
SET MCPID=$PIECE(MCZERO,"^",2)
SET MCNAME=""
+5 IF MCDATE=""
QUIT
+6 SET X=MCSSN
SET DIC="^DPT("
SET D="SSN"
SET DIC(0)="XZ"
DO IX^DIC
+7 if +Y>0
SET MCNAME=$PIECE(Y(0),"^")
+8 IF MCPID'=""
IF $DATA(^DPT(MCPID,0))
SET MCNAME2=$PIECE(^DPT(MCPID,0),"^")
+9 IF MCNAME'=MCNAME2
DO SET
QUIT
+10 IF '$DATA(^MCAR(700.5,"B",MCDATE))
DO SET
QUIT
+11 IF '$DATA(^MCAR(691.5,"B",MCDATE))
DO SET
QUIT
+12 SET MCERR=1
FOR MCK=1:1
SET MCIEN2=$ORDER(^MCAR(700.5,"B",MCDATE,MCIEN2))
if MCIEN2=""
QUIT
IF $DATA(^MCAR(700.5,MCIEN2,0))
IF $PIECE(^MCAR(700.5,MCIEN2,0),"^",3)=MCSSN
SET MCERR=0
+13 IF MCERR>0
DO SET
+14 QUIT
SET ;
+1 IF MCNAME=""
SET MCNAME="NO PATIENT NAME"
+2 IF MCSSN=""
SET MCSSN="NO SSN"
+3 IF $LENGTH(MCNAME)<30
FOR MCJ=$LENGTH(MCNAME):1:30
SET MCNAME=MCNAME_" "
+4 IF $LENGTH(MCSSN)<10
FOR MCJ=$LENGTH(MCSSN):1:10
SET MCSSN=MCSSN_" "
+5 IF $DATA(^TMP($JOB,0,"MC",MCNAME,MCSSN,MCDATE))
QUIT
+6 SET MCCNT=MCCNT+1
if MCCNT#100=0
WRITE "."
+7 SET ^TMP($JOB,0,"MC",MCNAME,MCSSN,MCDATE)=""
+8 SET ^TMP($JOB,0,"MC",0)=MCCNT
+9 QUIT
