- 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 Mar 13, 2025@21:48:08 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
