MCARAMLA ;WASH ISC/JKL-MUSE AUTO RETRANSMISSION-TRAN INCOMP ;2/27/95 11:15
;;2.3;Medicine;;09/13/1996
;
;
;Called from ^MCARAML
;Retransmit records with same date/time,
;no transaction zero node, no EKG SSN, no EKG record by date
N MCDATE,MCIEN,MCZERO,MCNAME,MCSSN,MCI,MCJ,MCK,MCL,MCERR
S MCDATE=0
F MCI=1:1 S MCDATE=$O(^MCAR(700.5,"B",MCDATE)) Q:MCDATE="" D FORMAT
Q
FORMAT ;
S MCIEN=0 F MCJ=1:1 S MCIEN=$O(^MCAR(700.5,"B",MCDATE,MCIEN)) Q:MCIEN="" D SAVE
Q
SAVE ;
I '$D(^MCAR(700.5,MCIEN,0)) Q
S MCZERO=^MCAR(700.5,MCIEN,0),MCNAME=$P(MCZERO,"^",4),MCSSN=$P(MCZERO,"^",3)
I $P(MCZERO,"^",2)="MHOLT" Q
I '$D(^MCAR(691.5,"B",MCDATE)) D SET Q
S (MCERR,MCEKG)=0
F MCK=1:1 S MCEKG=$O(^MCAR(691.5,"B",MCDATE,MCEKG)) Q:MCEKG="" Q:('$D(^MCAR(691.5,MCEKG,.1))) I MCSSN=^MCAR(691.5,MCEKG,.1) S MCERR=1
I MCERR>0 Q
D SET Q
SET ;
I MCNAME="" S MCNAME="NO PATIENT NAME"
I MCSSN="" S MCSSN="NO SSN"
I $L(MCNAME)<30 F MCL=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
I $L(MCSSN)<10 F MCL=$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[HMCARAMLA 1212 printed Oct 16, 2024@18:12:46 Page 2
MCARAMLA ;WASH ISC/JKL-MUSE AUTO RETRANSMISSION-TRAN INCOMP ;2/27/95 11:15
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+4 ;Called from ^MCARAML
+5 ;Retransmit records with same date/time,
+6 ;no transaction zero node, no EKG SSN, no EKG record by date
+7 NEW MCDATE,MCIEN,MCZERO,MCNAME,MCSSN,MCI,MCJ,MCK,MCL,MCERR
+8 SET MCDATE=0
+9 FOR MCI=1:1
SET MCDATE=$ORDER(^MCAR(700.5,"B",MCDATE))
if MCDATE=""
QUIT
DO FORMAT
+10 QUIT
FORMAT ;
+1 SET MCIEN=0
FOR MCJ=1:1
SET MCIEN=$ORDER(^MCAR(700.5,"B",MCDATE,MCIEN))
if MCIEN=""
QUIT
DO SAVE
+2 QUIT
SAVE ;
+1 IF '$DATA(^MCAR(700.5,MCIEN,0))
QUIT
+2 SET MCZERO=^MCAR(700.5,MCIEN,0)
SET MCNAME=$PIECE(MCZERO,"^",4)
SET MCSSN=$PIECE(MCZERO,"^",3)
+3 IF $PIECE(MCZERO,"^",2)="MHOLT"
QUIT
+4 IF '$DATA(^MCAR(691.5,"B",MCDATE))
DO SET
QUIT
+5 SET (MCERR,MCEKG)=0
+6 FOR MCK=1:1
SET MCEKG=$ORDER(^MCAR(691.5,"B",MCDATE,MCEKG))
if MCEKG=""
QUIT
if ('$DATA(^MCAR(691.5,MCEKG,.1)))
QUIT
IF MCSSN=^MCAR(691.5,MCEKG,.1)
SET MCERR=1
+7 IF MCERR>0
QUIT
+8 DO SET
QUIT
SET ;
+1 IF MCNAME=""
SET MCNAME="NO PATIENT NAME"
+2 IF MCSSN=""
SET MCSSN="NO SSN"
+3 IF $LENGTH(MCNAME)<30
FOR MCL=$LENGTH(MCNAME):1:30
SET MCNAME=MCNAME_" "
+4 IF $LENGTH(MCSSN)<10
FOR MCL=$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
