SROCON1 ;B'HAM ISC/MAM - MULTIPLES (.01) & CONCURRENTS ;16 AUG 1990 1:30 PM
;;3.0;Surgery;**78,107,119**;24 Jun 93
;
; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
;
W !!,"The information to be duplicated in the concurrent case will now be entered....",!!
EN ;
I $D(SRODR("130.213")) D
. S SRCTMP="",SRCNTR=0
. F S SRCTMP=$O(SRODR("130.213",SRCTMP)) Q:SRCTMP="" D
. . I '$D(^SRF(SRCON,50,$P(SRCTMP,","))) S SRCNTR=SRCNTR+1 K SRODR1 S SRODR1("130.213","+"_SRCNTR_","_SRCON_",",".01")="0" D UPDATE^DIE("","SRODR1","^TMP(""SR"",$J)")
. K SRCTMP,SRODR1,SRCNTR Q
I $D(SRODR) D FILE^DIE("","SRODR","^TMP(""SR"",$J)") D
.N SROERR S SROERR=SRCON I $D(^TMP("CSLSUR1",$J)) D ^SROERR0 S ^TMP("CSLSUR1",$J)=""
K DIR S DIR("A")="Press RETURN to continue ",DIR(0)="FOA" D ^DIR K DIR
Q
SROCON1 ;B'HAM ISC/MAM - MULTIPLES (.01) & CONCURRENTS ;16 AUG 1990 1:30 PM
+1 ;;3.0;Surgery;**78,107,119**;24 Jun 93
+2 ;
+3 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
+4 ;
+5 WRITE !!,"The information to be duplicated in the concurrent case will now be entered....",!!
EN ;
+1 IF $DATA(SRODR("130.213"))
Begin DoDot:1
+2 SET SRCTMP=""
SET SRCNTR=0
+3 FOR
SET SRCTMP=$ORDER(SRODR("130.213",SRCTMP))
IF SRCTMP=""
QUIT
Begin DoDot:2
+4 IF '$DATA(^SRF(SRCON,50,$PIECE(SRCTMP,",")))
SET SRCNTR=SRCNTR+1
KILL SRODR1
SET SRODR1("130.213","+"_SRCNTR_","_SRCON_",",".01")="0"
DO UPDATE^DIE("","SRODR1","^TMP(""SR"",$J)")
End DoDot:2
+5 KILL SRCTMP,SRODR1,SRCNTR
QUIT
End DoDot:1
+6 IF $DATA(SRODR)
DO FILE^DIE("","SRODR","^TMP(""SR"",$J)")
Begin DoDot:1
+7 NEW SROERR
SET SROERR=SRCON
IF $DATA(^TMP("CSLSUR1",$JOB))
DO ^SROERR0
SET ^TMP("CSLSUR1",$JOB)=""
End DoDot:1
+8 KILL DIR
SET DIR("A")="Press RETURN to continue "
SET DIR(0)="FOA"
DO ^DIR
KILL DIR
+9 QUIT