MCARAMLA.m

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 ---MCARAMLA   1212     printed  Apr 09, 2024@21:16:06                                                                                                                                                                                                    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