SROCON1.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROCON1   821     printed  Apr 09, 2024@21:43:59                                                                                                                                                                                                      Page 2

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