| [613] | 1 | SROCON ;B'HAM ISC/MAM - STUFF ENTRY IN CONCURRENT CASE ;23 AUG 1990  9:15 AM
 | 
|---|
 | 2 |  ;;3.0;Surgery;**78,119,161**;24 Jun 93;Build 5
 | 
|---|
 | 3 |  I $D(SRNOCON),SRNOCON=1 Q
 | 
|---|
 | 4 |  I $D(SRFLAG) S SRCON=$P(^SRF(DA(1),"CON"),"^")
 | 
|---|
 | 5 |  I '$D(SRFLAG) S SRCON=$P(^SRF(DA,"CON"),"^")
 | 
|---|
 | 6 | ASK W !!,"Do you want to store this information in the concurrent case ?  YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N" Q
 | 
|---|
 | 7 |  S:SRYN="" SRYN="Y" S SRYN=$E(SRYN) I "YyNn"'[SRYN D HELP G ASK
 | 
|---|
 | 8 |  I "Yy"'[SRYN W ! Q
 | 
|---|
 | 9 | STUFF ; concatonate field to SRODR
 | 
|---|
 | 10 |  W ! I $G(SRFLAG)=1 S SRODR(130.213,DA(2)_","_SRCON_",",SRFLD)=X K SRFLAG Q
 | 
|---|
 | 11 |  S SRODR(130,SRCON_",",SRFLD)=X
 | 
|---|
 | 12 |  Q
 | 
|---|
 | 13 | HELP ;
 | 
|---|
 | 14 |  S SRMX=X W @IOF S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S X=SRMX  ;; < RJS *161 >
 | 
|---|
 | 15 |  W !!,"There is a concurrent surgical case associated with this procedure.  A brief",!,"description of that case is listed below."
 | 
|---|
 | 16 |  S SROPER=$P(^SRF(SRCON,"OP"),"^") I $O(^SRF(SRCON,13,0)) S SROTHER=0 F I=0:0 S SROTHER=$O(^SRF(SRCON,13,SROTHER)) Q:'SROTHER  D OTHER
 | 
|---|
 | 17 |  K SROPS,MM,MMM S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""
 | 
|---|
 | 18 |  S SRSUR=$S($D(^SRF(SRCON,.1)):$P(^(.1),"^",4),1:"") S:'SRSUR SRSUR="NOT ENTERED" S:SRSUR SRSUR=$P(^VA(200,SRSUR,0),"^")
 | 
|---|
 | 19 |  S SRSS=$P(^SRF(SRCON,0),"^",4) S:'SRSS SRSS="NOT ENTERED" S:SRSS SRSS=$P(^SRO(137.45,SRSS,0),"^")
 | 
|---|
 | 20 |  W !!,"Surgeon: "_SRSUR,!,"Surgical Specialty: "_SRSS,!!,"Procedure: ",?12,SROPS(1) I $D(SROPS(2)) W !,?12,SROPS(2) I $D(SROPS(3)) W !,?12,SROPS(3) I $D(SROPS(4)) W !,?12,SROPS(4)
 | 
|---|
 | 21 |  W !!,"If you answer 'YES', the information you entered for this field will also",!,"be stored for the concurrent case.  If this information is not pertinent for",!,"the concurrent case, enter 'NO'.",!!
 | 
|---|
 | 22 |  Q
 | 
|---|
 | 23 | OTHER ; other operations
 | 
|---|
 | 24 |  S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRCON,13,SROTHER,0),"^"))>235 S SRLONG=0,SROTHER=999,SROPERS=" ..."
 | 
|---|
 | 25 |  I SRLONG S SROPERS=$P(^SRF(SRCON,13,SROTHER,0),"^")
 | 
|---|
 | 26 |  S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
 | 
|---|
 | 27 |  Q
 | 
|---|
 | 28 | LOOP ; break procedure
 | 
|---|
 | 29 |  S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM=""  Q:$L(SROPS(M))+$L(MM)'<65  S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
 | 
|---|
 | 30 |  Q
 | 
|---|