- 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 Mar 13, 2025@21:17:10 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
