- 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 ---[H[J[2J[HMCARAMLD 973 printed Feb 18, 2025@23:38:40 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