| [613] | 1 | MCARAMLG ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-EKG CORR ;2/27/95 19:42
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;Called from ^MCARAML
|
|---|
| 6 | ;Retransmits EKG external date cross-reference,
|
|---|
| 7 | ;EKG date cross-reference without record, without transaction
|
|---|
| 8 | ;EKG PID cross-reference without record,
|
|---|
| 9 | ;EKG automated record with defunct delete status
|
|---|
| 10 | N MCNAME,MCSSN,MCDATE,MCIEN,MCZERO,MCI,MCJ,X,D,DIC,Y,MCK
|
|---|
| 11 | ;Retransmits EKG external date cross-reference
|
|---|
| 12 | S MCDATE=9999999
|
|---|
| 13 | F MCI=1:1 S MCDATE=$O(^MCAR(691.5,"B",MCDATE)) Q:MCDATE="" I MCDATE'="ES" S MCIEN=0 F MCK=1:1 S MCIEN=$O(^MCAR(691.5,"B",MCDATE,MCIEN)) Q:MCIEN="" D SAVE
|
|---|
| 14 | ;EKG date cross-reference without transaction
|
|---|
| 15 | S MCDATE=0
|
|---|
| 16 | F MCI=1:1 S MCDATE=$O(^MCAR(691.5,"B",MCDATE)) Q:MCDATE=""!(+MCDATE>9999999) I '$D(^MCAR(700.5,"B",MCDATE)) S MCIEN=0 F MCK=1:1 S MCIEN=$O(^MCAR(691.5,"B",MCDATE,MCIEN)) Q:MCIEN="" D SAVE
|
|---|
| 17 | ;EKG automated record with defunct delete status
|
|---|
| 18 | ;EKG PID cross-reference without record,
|
|---|
| 19 | S (MCIEN,MCERR)=0
|
|---|
| 20 | F MCI=1:1 S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN=""!(MCIEN="B") S MCERR=0 D DEF S MCERR=1 D SAVE
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | DEF ;
|
|---|
| 24 | I '$D(^MCAR(691.5,MCIEN,"A")) Q
|
|---|
| 25 | I '$D(^MCAR(691.5,MCIEN,"ES")) Q
|
|---|
| 26 | I $P(^MCAR(691.5,MCIEN,"ES"),"^",12)=1 D SAVE
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | SAVE ;
|
|---|
| 30 | I '$D(^MCAR(691.5,MCIEN,0)) Q
|
|---|
| 31 | S MCSSN="" S:$D(^MCAR(691.5,MCIEN,.1)) MCSSN=^MCAR(691.5,MCIEN,.1)
|
|---|
| 32 | S MCZERO=^MCAR(691.5,MCIEN,0)
|
|---|
| 33 | S MCPID=$P(MCZERO,"^",2),MCNAME=""
|
|---|
| 34 | I '$D(MCDATE) S MCDATE=$P(MCZERO,"^") I MCDATE="" S MCDATE="NO DATE"
|
|---|
| 35 | S X=MCSSN,DIC="^DPT(",D="SSN",DIC(0)="XZ" D IX^DIC
|
|---|
| 36 | S:+Y>0 MCNAME=$P(Y(0),"^")
|
|---|
| 37 | I (MCERR=1),MCPID'="",$D(^MCAR(691.5,"C",MCPID)) Q
|
|---|
| 38 | D SET Q
|
|---|
| 39 | ;
|
|---|
| 40 | SET ;
|
|---|
| 41 | I MCNAME="",MCSSN="",MCDATE="" Q
|
|---|
| 42 | I MCNAME="" S MCNAME="NO PATIENT NAME"
|
|---|
| 43 | I MCSSN="" S MCSSN="NO SSN"
|
|---|
| 44 | I MCDATE="" S MCDATE="NO DATE"
|
|---|
| 45 | I $L(MCNAME)<30 F MCJ=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
|
|---|
| 46 | I $L(MCSSN)<10 F MCJ=$L(MCSSN):1:10 S MCSSN=MCSSN_" "
|
|---|
| 47 | I $D(^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)) Q
|
|---|
| 48 | S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
|
|---|
| 49 | S ^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)=""
|
|---|
| 50 | S ^TMP($J,0,"MC",0)=MCCNT
|
|---|
| 51 | Q
|
|---|
