Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCARAMLB

MCARAMLB.m

Go to the documentation of this file.
  1. MCARAMLB ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-TRAN DATE ;2/27/95 16:35
  1. ;;2.3;Medicine;;09/13/1996
  1. ;
  1. ;
  1. ; Called from ^MCARAML
  1. ; Retransmits transaction record without EKG,tran date cross-reference
  1. N MCIEN,MCZERO,MCDATE,MCSSN,MCNAME,MCI,MCJ
  1. S MCIEN=0
  1. F MCI=1:1 S MCIEN=$O(^MCAR(700.5,MCIEN)) Q:MCIEN=""!(MCIEN="B") D SAVE
  1. Q
  1. ;
  1. SAVE ;
  1. I '$D(^MCAR(700.5,MCIEN,0)) Q
  1. S MCZERO=^MCAR(700.5,MCIEN,0),MCDATE=$P(MCZERO,"^"),MCSSN=$P(MCZERO,"^",3)
  1. I $P(MCZERO,"^",2)="MHOLT" Q
  1. S MCNAME=$P(MCZERO,"^",4)
  1. I $D(^MCAR(691.5,"B",MCDATE)),$D(^MCAR(700.5,"B",MCDATE)) Q
  1. D SET Q
  1. ;
  1. SET ;
  1. I MCNAME="" S MCNAME="NO PATIENT NAME"
  1. I MCSSN="" S MCSSN="NO SSN"
  1. I $L(MCNAME)<30 F MCJ=$L(MCNAME):1:30 S MCNAME=MCNAME_" "
  1. I $L(MCSSN)<10 F MCJ=$L(MCSSN):1:10 S MCSSN=MCSSN_" "
  1. I $D(^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)) Q
  1. S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
  1. S ^TMP($J,0,"MC",MCNAME,MCSSN,MCDATE)=""
  1. S ^TMP($J,0,"MC",0)=MCCNT
  1. Q