MCARAMLD.m

MCARAMLD ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NO EKG DIAG ;2/27/95  18:01

 ;;2.3;Medicine;;09/13/1996

 ;

 ;

 ;Called from ^MCARAML

 ;Retransmits EKG records without diagnoses

 N MCIEN,MCI,MCJ,D,X,Y,DIC,MCNAME,MCDATE,MCSSN

 S MCIEN=0

 F  S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN="B"  I '$D(^MCAR(691.5,MCIEN,9)) D SET

 Q

 ;

SET ;

 I '$D(^MCAR(691.5,MCIEN,0)) Q

 S MCSSN="NO SSN"

 I $D(^MCAR(691.5,MCIEN,.1)) S MCSSN=^MCAR(691.5,MCIEN,.1)

 S MCDATE=$P(^MCAR(691.5,MCIEN,0),"^") I MCDATE="" S MCDATE="NO DATE"

 S D="SSN",X=MCSSN,DIC(0)="XZ",DIC="^DPT(" D IX^DIC

 I +Y>0 S MCNAME=$P(Y(0),"^") I MCNAME="" S MCNAME="NO PATIENT NAME"

 I '$D(MCNAME) S MCNAME="NO PATIENT NAME"

 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 ---MCARAMLD   973     printed  Apr 09, 2024@21:18:47                                                                                                                                                                                                     Page 2

MCARAMLD  ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NO EKG DIAG ;2/27/95  18:01

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

 +3       ;

 +4       ;Called from ^MCARAML

 +5       ;Retransmits EKG records without diagnoses

 +6        NEW MCIEN,MCI,MCJ,D,X,Y,DIC,MCNAME,MCDATE,MCSSN

 +7        SET MCIEN=0

 +8        FOR 

               SET MCIEN=$ORDER(^MCAR(691.5,MCIEN))

               if MCIEN="B"

                   QUIT 

               IF '$DATA(^MCAR(691.5,MCIEN,9))

                   DO SET

 +9        QUIT 

 +10      ;

SET       ;

 +1        IF '$DATA(^MCAR(691.5,MCIEN,0))

               QUIT 

 +2        SET MCSSN="NO SSN"

 +3        IF $DATA(^MCAR(691.5,MCIEN,.1))

               SET MCSSN=^MCAR(691.5,MCIEN,.1)

 +4        SET MCDATE=$PIECE(^MCAR(691.5,MCIEN,0),"^")

           IF MCDATE=""

               SET MCDATE="NO DATE"

 +5        SET D="SSN"

           SET X=MCSSN

           SET DIC(0)="XZ"

           SET DIC="^DPT("

           DO IX^DIC

 +6        IF +Y>0

               SET MCNAME=$PIECE(Y(0),"^")

               IF MCNAME=""

                   SET MCNAME="NO PATIENT NAME"

 +7        IF '$DATA(MCNAME)

               SET MCNAME="NO PATIENT NAME"

 +8        IF $LENGTH(MCNAME)<30

               FOR MCJ=$LENGTH(MCNAME):1:30

                   SET MCNAME=MCNAME_" "

 +9        IF $LENGTH(MCSSN)<10

               FOR MCJ=$LENGTH(MCSSN):1:10

                   SET MCSSN=MCSSN_" "

 +10       IF $DATA(^TMP($JOB,0,"MC",MCNAME,MCSSN,MCDATE))

               QUIT 

 +11       SET MCCNT=MCCNT+1

           if MCCNT#100=0

               WRITE "."

 +12       SET ^TMP($JOB,0,"MC",MCNAME,MCSSN,MCDATE)=""

 +13       SET ^TMP($JOB,0,"MC",0)=MCCNT

 +14       QUIT