MCARAMLF ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NODHCP NAME ;2/27/95 19:25
;;2.3;Medicine;;09/13/1996
;
;
; Called from ^MCARAML
; Retransmits transaction records cross-referenced by non-DHCP name
N MCIEN,MCZERO,MCDATE,MCSSN,MCNAME,MCI,MCJ,MCK
S MCNAME=0
F MCI=1:1 S MCNAME=$O(^MCAR(700.5,"PT",MCNAME)) Q:MCNAME="" I (MCNAME["=>")!(MCNAME["<=") S MCIEN=0 F MCK=1:1 S MCIEN=$O(^MCAR(700.5,"PT",MCNAME,MCIEN)) Q:MCIEN="" 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
D SET Q
;
SET ;
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[HMCARAMLF 970 printed Dec 13, 2024@02:12:14 Page 2
MCARAMLF ;WASH ISC/JKL-MUSE AUTO INSTRUMENT RETRANSMISSION-NODHCP NAME ;2/27/95 19:25
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+4 ; Called from ^MCARAML
+5 ; Retransmits transaction records cross-referenced by non-DHCP name
+6 NEW MCIEN,MCZERO,MCDATE,MCSSN,MCNAME,MCI,MCJ,MCK
+7 SET MCNAME=0
+8 FOR MCI=1:1
SET MCNAME=$ORDER(^MCAR(700.5,"PT",MCNAME))
if MCNAME=""
QUIT
IF (MCNAME["=>")!(MCNAME["<=")
SET MCIEN=0
FOR MCK=1:1
SET MCIEN=$ORDER(^MCAR(700.5,"PT",MCNAME,MCIEN))
if MCIEN=""
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 DO SET
QUIT
+5 ;
SET ;
+1 IF MCSSN=""
SET MCSSN="NO SSN"
+2 IF MCDATE=""
SET MCDATE="NO DATE"
+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
