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

SROCON1.m

Go to the documentation of this file.
  1. SROCON1 ;B'HAM ISC/MAM - MULTIPLES (.01) & CONCURRENTS ;16 AUG 1990 1:30 PM
  1. ;;3.0;Surgery;**78,107,119**;24 Jun 93
  1. ;
  1. ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
  1. ;
  1. W !!,"The information to be duplicated in the concurrent case will now be entered....",!!
  1. EN ;
  1. I $D(SRODR("130.213")) D
  1. . S SRCTMP="",SRCNTR=0
  1. . F S SRCTMP=$O(SRODR("130.213",SRCTMP)) Q:SRCTMP="" D
  1. . . 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)")
  1. . K SRCTMP,SRODR1,SRCNTR Q
  1. I $D(SRODR) D FILE^DIE("","SRODR","^TMP(""SR"",$J)") D
  1. .N SROERR S SROERR=SRCON I $D(^TMP("CSLSUR1",$J)) D ^SROERR0 S ^TMP("CSLSUR1",$J)=""
  1. K DIR S DIR("A")="Press RETURN to continue ",DIR(0)="FOA" D ^DIR K DIR
  1. Q