- 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 Apr 23, 2025@18:26:45 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
