SROCON ;BIR/MAM - STUFF ENTRY IN CONCURRENT CASE ;06/28/10
;;3.0;Surgery;**78,119,161,174**;24 Jun 93;Build 8
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"),"^")
N SRX S SRX=X
ASK N DIR,X,Y S DIR("A",1)="",DIR("A")="Do you want to store this information in the concurrent case ",DIR(0)="YO",DIR("B")="YES"
S DIR("?")="^D HELP^SROCON" D ^DIR I Y=0 Q
STUFF ; concatonate field to SRODR
D EN^DDIOL(" ","","!")
I $G(SRFLAG)=1 S SRODR(130.213,DA(2)_","_SRCON_",",SRFLD)=SRX K SRFLAG Q
S SRODR(130,SRCON_",",SRFLD)=SRX
Q
HELP ;
N SRMX S SRMX=X W @IOF S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S X=SRMX ;; < RJS *161 >
D EN^DDIOL("There is a concurrent surgical case associated with this procedure. A brief","","!!")
D EN^DDIOL("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),"^")
D EN^DDIOL("Surgeon: "_SRSUR,"","!!") D EN^DDIOL("Surgical Specialty: "_SRSS,"","!")
D EN^DDIOL("Procedure: "_SROPS(1),"","!!")
I $D(SROPS(2)) D EN^DDIOL(SROPS(2),"","!,?11")
I $D(SROPS(3)) D EN^DDIOL(SROPS(3),"","!,?11")
I $D(SROPS(4)) D EN^DDIOL(SROPS(4),"","!,?11")
N SRW S SRW(1)="",SRW(2)="If you answer 'YES', the information you entered for this field will also"
S SRW(3)="be stored for the concurrent case. If this information is not pertinent for"
S SRW(4)="the concurrent case, enter 'NO'.",SRW(5)=""
D EN^DDIOL(.SRW)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCON 2309 printed Oct 16, 2024@18:43:36 Page 2
SROCON ;BIR/MAM - STUFF ENTRY IN CONCURRENT CASE ;06/28/10
+1 ;;3.0;Surgery;**78,119,161,174**;24 Jun 93;Build 8
+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"),"^")
+5 NEW SRX
SET SRX=X
ASK NEW DIR,X,Y
SET DIR("A",1)=""
SET DIR("A")="Do you want to store this information in the concurrent case "
SET DIR(0)="YO"
SET DIR("B")="YES"
+1 SET DIR("?")="^D HELP^SROCON"
DO ^DIR
IF Y=0
QUIT
STUFF ; concatonate field to SRODR
+1 DO EN^DDIOL(" ","","!")
+2 IF $GET(SRFLAG)=1
SET SRODR(130.213,DA(2)_","_SRCON_",",SRFLD)=SRX
KILL SRFLAG
QUIT
+3 SET SRODR(130,SRCON_",",SRFLD)=SRX
+4 QUIT
HELP ;
+1 ;; < RJS *161 >
NEW SRMX
SET SRMX=X
WRITE @IOF
SET DFN=$PIECE(^SRF(SRTN,0),"^")
DO DEM^VADPT
SET X=SRMX
+2 DO EN^DDIOL("There is a concurrent surgical case associated with this procedure. A brief","","!!")
+3 DO EN^DDIOL("description of that case is listed below.","","!")
+4 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
+5 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
+6 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),"^")
+7 SET SRSS=$PIECE(^SRF(SRCON,0),"^",4)
if 'SRSS
SET SRSS="NOT ENTERED"
if SRSS
SET SRSS=$PIECE(^SRO(137.45,SRSS,0),"^")
+8 DO EN^DDIOL("Surgeon: "_SRSUR,"","!!")
DO EN^DDIOL("Surgical Specialty: "_SRSS,"","!")
+9 DO EN^DDIOL("Procedure: "_SROPS(1),"","!!")
+10 IF $DATA(SROPS(2))
DO EN^DDIOL(SROPS(2),"","!,?11")
+11 IF $DATA(SROPS(3))
DO EN^DDIOL(SROPS(3),"","!,?11")
+12 IF $DATA(SROPS(4))
DO EN^DDIOL(SROPS(4),"","!,?11")
+13 NEW SRW
SET SRW(1)=""
SET SRW(2)="If you answer 'YES', the information you entered for this field will also"
+14 SET SRW(3)="be stored for the concurrent case. If this information is not pertinent for"
+15 SET SRW(4)="the concurrent case, enter 'NO'."
SET SRW(5)=""
+16 DO EN^DDIOL(.SRW)
+17 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
