SROCON.m

SROCON ;B'HAM ISC/MAM - STUFF ENTRY IN CONCURRENT CASE ;23 AUG 1990  9:15 AM

 ;;3.0;Surgery;**78,119,161**;24 Jun 93;Build 5

 I $D(SRNOCON),SRNOCON=1 Q

 I $D(SRFLAG) S SRCON=$P(^SRF(DA(1),"CON"),"^")

 I '$D(SRFLAG) S SRCON=$P(^SRF(DA,"CON"),"^")

ASK W !!,"Do you want to store this information in the concurrent case ?  YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N" Q

 S:SRYN="" SRYN="Y" S SRYN=$E(SRYN) I "YyNn"'[SRYN D HELP G ASK

 I "Yy"'[SRYN W ! Q

STUFF ; concatonate field to SRODR

 W ! I $G(SRFLAG)=1 S SRODR(130.213,DA(2)_","_SRCON_",",SRFLD)=X K SRFLAG Q

 S SRODR(130,SRCON_",",SRFLD)=X

 Q

HELP ;

 S SRMX=X W @IOF S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S X=SRMX  ;; < RJS *161 >

 W !!,"There is a concurrent surgical case associated with this procedure.  A brief",!,"description of that case is listed below."

 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

 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=""

 S SRSUR=$S($D(^SRF(SRCON,.1)):$P(^(.1),"^",4),1:"") S:'SRSUR SRSUR="NOT ENTERED" S:SRSUR SRSUR=$P(^VA(200,SRSUR,0),"^")

 S SRSS=$P(^SRF(SRCON,0),"^",4) S:'SRSS SRSS="NOT ENTERED" S:SRSS SRSS=$P(^SRO(137.45,SRSS,0),"^")

 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)

 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'.",!!

 Q

OTHER ; other operations

 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRCON,13,SROTHER,0),"^"))>235 S SRLONG=0,SROTHER=999,SROPERS=" ..."

 I SRLONG S SROPERS=$P(^SRF(SRCON,13,SROTHER,0),"^")

 S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)

 Q

LOOP ; break procedure

 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

 Q

SROCON    ;B'HAM ISC/MAM - STUFF ENTRY IN CONCURRENT CASE ;23 AUG 1990  9:15 AM

 +1       ;;3.0;Surgery;**78,119,161**;24 Jun 93;Build 5

 +2        IF $DATA(SRNOCON)

               IF SRNOCON=1

                   QUIT 

 +3        IF $DATA(SRFLAG)

               SET SRCON=$PIECE(^SRF(DA(1),"CON"),"^")

 +4        IF '$DATA(SRFLAG)

               SET SRCON=$PIECE(^SRF(DA,"CON"),"^")

ASK        WRITE !!,"Do you want to store this information in the concurrent case ?  YES//  "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRYN="N"

               QUIT 

 +1        IF SRYN=""

               SET SRYN="Y"

           SET SRYN=$EXTRACT(SRYN)

           IF "YyNn"'[SRYN

               DO HELP

               GOTO ASK

 +2        IF "Yy"'[SRYN

               WRITE !

               QUIT 

STUFF     ; concatonate field to SRODR

 +1        WRITE !

           IF $GET(SRFLAG)=1

               SET SRODR(130.213,DA(2)_","_SRCON_",",SRFLD)=X

               KILL SRFLAG

               QUIT 

 +2        SET SRODR(130,SRCON_",",SRFLD)=X

 +3        QUIT 

HELP      ;

 +1       ;; < RJS *161 >

           SET SRMX=X

           WRITE @IOF

           SET DFN=$PIECE(^SRF(SRTN,0),"^")

           DO DEM^VADPT

           SET X=SRMX

 +2        WRITE !!,"There is a concurrent surgical case associated with this procedure.  A brief",!,"description of that case is listed below."

 +3        SET SROPER=$PIECE(^SRF(SRCON,"OP"),"^")

           IF $ORDER(^SRF(SRCON,13,0))

               SET SROTHER=0

               FOR I=0:0

                   SET SROTHER=$ORDER(^SRF(SRCON,13,SROTHER))

                   IF 'SROTHER

                       QUIT 

                   DO OTHER

 +4        KILL SROPS,MM,MMM

           IF $LENGTH(SROPER)<65

               SET SROPS(1)=SROPER

           IF $LENGTH(SROPER)>64

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MMM=""

                       QUIT 

 +5        SET SRSUR=$SELECT($DATA(^SRF(SRCON,.1)):$PIECE(^(.1),"^",4),1:"")

           IF 'SRSUR

               SET SRSUR="NOT ENTERED"

           IF SRSUR

               SET SRSUR=$PIECE(^VA(200,SRSUR,0),"^")

 +6        SET SRSS=$PIECE(^SRF(SRCON,0),"^",4)

           IF 'SRSS

               SET SRSS="NOT ENTERED"

           IF SRSS

               SET SRSS=$PIECE(^SRO(137.45,SRSS,0),"^")

 +7        WRITE !!,"Surgeon: "_SRSUR,!,"Surgical Specialty: "_SRSS,!!,"Procedure: ",?12,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?12,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?12,SROPS(3)

                   IF $DATA(SROPS(4))

                       WRITE !,?12,SROPS(4)

 +8        WRITE !!,"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'.",!!

 +9        QUIT 

OTHER     ; other operations

 +1        SET SRLONG=1

           IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRCON,13,SROTHER,0),"^"))>235

               SET SRLONG=0

               SET SROTHER=999

               SET SROPERS=" ..."

 +2        IF SRLONG

               SET SROPERS=$PIECE(^SRF(SRCON,13,SROTHER,0),"^")

 +3        SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)

 +4        QUIT 

LOOP      ; break procedure

 +1        SET SROPS(M)=""

           FOR LOOP=1:1

               SET MM=$PIECE(SROPER," ")

               SET MMM=$PIECE(SROPER," ",2,200)

               IF MMM=""

                   QUIT 

               IF $LENGTH(SROPS(M))+$LENGTH(MM)'<65

                   QUIT 

               SET SROPS(M)=SROPS(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT