MCARAMLC.m

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

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