- MCARAMLB ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-TRAN DATE ;2/27/95 16:35
- ;;2.3;Medicine;;09/13/1996
- ;
- ;
- ; Called from ^MCARAML
- ; Retransmits transaction record without EKG,tran date cross-reference
- N MCIEN,MCZERO,MCDATE,MCSSN,MCNAME,MCI,MCJ
- S MCIEN=0
- F MCI=1:1 S MCIEN=$O(^MCAR(700.5,MCIEN)) Q:MCIEN=""!(MCIEN="B") D SAVE
- Q
- ;
- SAVE ;
- I '$D(^MCAR(700.5,MCIEN,0)) Q
- S MCZERO=^MCAR(700.5,MCIEN,0),MCDATE=$P(MCZERO,"^"),MCSSN=$P(MCZERO,"^",3)
- I $P(MCZERO,"^",2)="MHOLT" Q
- S MCNAME=$P(MCZERO,"^",4)
- I $D(^MCAR(691.5,"B",MCDATE)),$D(^MCAR(700.5,"B",MCDATE)) Q
- D SET Q
- ;
- SET ;
- I MCNAME="" S MCNAME="NO PATIENT NAME"
- I MCSSN="" S MCSSN="NO SSN"
- 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[HMCARAMLB 963 printed Jan 18, 2025@03:13:22 Page 2
- MCARAMLB ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-TRAN DATE ;2/27/95 16:35
- +1 ;;2.3;Medicine;;09/13/1996
- +2 ;
- +3 ;
- +4 ; Called from ^MCARAML
- +5 ; Retransmits transaction record without EKG,tran date cross-reference
- +6 NEW MCIEN,MCZERO,MCDATE,MCSSN,MCNAME,MCI,MCJ
- +7 SET MCIEN=0
- +8 FOR MCI=1:1
- SET MCIEN=$ORDER(^MCAR(700.5,MCIEN))
- if MCIEN=""!(MCIEN="B")
- QUIT
- DO SAVE
- +9 QUIT
- +10 ;
- SAVE ;
- +1 IF '$DATA(^MCAR(700.5,MCIEN,0))
- QUIT
- +2 SET MCZERO=^MCAR(700.5,MCIEN,0)
- SET MCDATE=$PIECE(MCZERO,"^")
- SET MCSSN=$PIECE(MCZERO,"^",3)
- +3 IF $PIECE(MCZERO,"^",2)="MHOLT"
- QUIT
- +4 SET MCNAME=$PIECE(MCZERO,"^",4)
- +5 IF $DATA(^MCAR(691.5,"B",MCDATE))
- IF $DATA(^MCAR(700.5,"B",MCDATE))
- QUIT
- +6 DO SET
- QUIT
- +7 ;
- SET ;
- +1 IF MCNAME=""
- SET MCNAME="NO PATIENT NAME"
- +2 IF MCSSN=""
- SET MCSSN="NO SSN"
- +3 IF $LENGTH(MCNAME)<30
- FOR MCJ=$LENGTH(MCNAME):1:30
- SET MCNAME=MCNAME_" "
- +4 IF $LENGTH(MCSSN)<10
- FOR MCJ=$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