- MCARAMLG ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-EKG CORR ;2/27/95 19:42
- ;;2.3;Medicine;;09/13/1996
- ;
- ;
- ;Called from ^MCARAML
- ;Retransmits EKG external date cross-reference,
- ;EKG date cross-reference without record, without transaction
- ;EKG PID cross-reference without record,
- ;EKG automated record with defunct delete status
- N MCNAME,MCSSN,MCDATE,MCIEN,MCZERO,MCI,MCJ,X,D,DIC,Y,MCK
- ;Retransmits EKG external date cross-reference
- S MCDATE=9999999
- 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
- ;EKG date cross-reference without transaction
- S MCDATE=0
- 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
- ;EKG automated record with defunct delete status
- ;EKG PID cross-reference without record,
- S (MCIEN,MCERR)=0
- 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
- Q
- ;
- DEF ;
- I '$D(^MCAR(691.5,MCIEN,"A")) Q
- I '$D(^MCAR(691.5,MCIEN,"ES")) Q
- I $P(^MCAR(691.5,MCIEN,"ES"),"^",12)=1 D SAVE
- Q
- ;
- SAVE ;
- I '$D(^MCAR(691.5,MCIEN,0)) Q
- S MCSSN="" S:$D(^MCAR(691.5,MCIEN,.1)) MCSSN=^MCAR(691.5,MCIEN,.1)
- S MCZERO=^MCAR(691.5,MCIEN,0)
- S MCPID=$P(MCZERO,"^",2),MCNAME=""
- I '$D(MCDATE) S MCDATE=$P(MCZERO,"^") I MCDATE="" S MCDATE="NO DATE"
- S X=MCSSN,DIC="^DPT(",D="SSN",DIC(0)="XZ" D IX^DIC
- S:+Y>0 MCNAME=$P(Y(0),"^")
- I (MCERR=1),MCPID'="",$D(^MCAR(691.5,"C",MCPID)) Q
- D SET Q
- ;
- SET ;
- I MCNAME="",MCSSN="",MCDATE="" Q
- I MCNAME="" S MCNAME="NO PATIENT NAME"
- I MCSSN="" S MCSSN="NO SSN"
- I MCDATE="" S MCDATE="NO DATE"
- 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[HMCARAMLG 2063 printed Feb 18, 2025@23:38:43 Page 2
- MCARAMLG ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-EKG CORR ;2/27/95 19:42
- +1 ;;2.3;Medicine;;09/13/1996
- +2 ;
- +3 ;
- +4 ;Called from ^MCARAML
- +5 ;Retransmits EKG external date cross-reference,
- +6 ;EKG date cross-reference without record, without transaction
- +7 ;EKG PID cross-reference without record,
- +8 ;EKG automated record with defunct delete status
- +9 NEW MCNAME,MCSSN,MCDATE,MCIEN,MCZERO,MCI,MCJ,X,D,DIC,Y,MCK
- +10 ;Retransmits EKG external date cross-reference
- +11 SET MCDATE=9999999
- +12 FOR MCI=1:1
- SET MCDATE=$ORDER(^MCAR(691.5,"B",MCDATE))
- if MCDATE=""
- QUIT
- IF MCDATE'="ES"
- SET MCIEN=0
- FOR MCK=1:1
- SET MCIEN=$ORDER(^MCAR(691.5,"B",MCDATE,MCIEN))
- if MCIEN=""
- QUIT
- DO SAVE
- +13 ;EKG date cross-reference without transaction
- +14 SET MCDATE=0
- +15 FOR MCI=1:1
- SET MCDATE=$ORDER(^MCAR(691.5,"B",MCDATE))
- if MCDATE=""!(+MCDATE>9999999)
- QUIT
- IF '$DATA(^MCAR(700.5,"B",MCDATE))
- SET MCIEN=0
- FOR MCK=1:1
- SET MCIEN=$ORDER(^MCAR(691.5,"B",MCDATE,MCIEN))
- if MCIEN=""
- QUIT
- DO SAVE
- +16 ;EKG automated record with defunct delete status
- +17 ;EKG PID cross-reference without record,
- +18 SET (MCIEN,MCERR)=0
- +19 FOR MCI=1:1
- SET MCIEN=$ORDER(^MCAR(691.5,MCIEN))
- if MCIEN=""!(MCIEN="B")
- QUIT
- SET MCERR=0
- DO DEF
- SET MCERR=1
- DO SAVE
- +20 QUIT
- +21 ;
- DEF ;
- +1 IF '$DATA(^MCAR(691.5,MCIEN,"A"))
- QUIT
- +2 IF '$DATA(^MCAR(691.5,MCIEN,"ES"))
- QUIT
- +3 IF $PIECE(^MCAR(691.5,MCIEN,"ES"),"^",12)=1
- DO SAVE
- +4 QUIT
- +5 ;
- 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)
- +4 SET MCPID=$PIECE(MCZERO,"^",2)
- SET MCNAME=""
- +5 IF '$DATA(MCDATE)
- SET MCDATE=$PIECE(MCZERO,"^")
- IF MCDATE=""
- SET MCDATE="NO DATE"
- +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 (MCERR=1)
- IF MCPID'=""
- IF $DATA(^MCAR(691.5,"C",MCPID))
- QUIT
- +9 DO SET
- QUIT
- +10 ;
- SET ;
- +1 IF MCNAME=""
- IF MCSSN=""
- IF MCDATE=""
- QUIT
- +2 IF MCNAME=""
- SET MCNAME="NO PATIENT NAME"
- +3 IF MCSSN=""
- SET MCSSN="NO SSN"
- +4 IF MCDATE=""
- SET MCDATE="NO DATE"
- +5 IF $LENGTH(MCNAME)<30
- FOR MCJ=$LENGTH(MCNAME):1:30
- SET MCNAME=MCNAME_" "
- +6 IF $LENGTH(MCSSN)<10
- FOR MCJ=$LENGTH(MCSSN):1:10
- SET MCSSN=MCSSN_" "
- +7 IF $DATA(^TMP($JOB,0,"MC",MCNAME,MCSSN,MCDATE))
- QUIT
- +8 SET MCCNT=MCCNT+1
- if MCCNT#100=0
- WRITE "."
- +9 SET ^TMP($JOB,0,"MC",MCNAME,MCSSN,MCDATE)=""
- +10 SET ^TMP($JOB,0,"MC",0)=MCCNT
- +11 QUIT
