SRTOVRF ;BIR/SJA - TIME OUT VERIFIED FOR SURGERY ;12/16/10
;;3.0;Surgery;**175,182,184**;24 Jun 93;Build 35
;
; entry point called by 'AE' x-ref of the 600-611 surgery fields
IN N SRJ,SRK,SRTN1,SRYN S SRTN1=$S($D(SRTN):SRTN,1:DA) Q:'SRTN1
S SRJ=85
ASK D EN^DDIOL("Checklist Comments should be entered when a ""NO"" response is entered for any of the Time Out Verified Utilizing Checklist fields.",,"!!")
D FIELD^DID("130.0"_SRJ,.01,"","TITLE","SRK")
D EN^DDIOL("Do you want to enter "_SRK("TITLE")_" ? YES// ",,"!")
R SRYN:DTIME I '$T!(SRYN["^") Q
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I SRYN["?" D HELP G ASK
I "YyNn"'[SRYN D EN^DDIOL("Enter 'YES' to enter checklist comments now, 'NO' to quit, or '?' for more help.",,"!!") G ASK
I "Nn"[SRYN Q
; edit the associated comments fields
N DR,DIE,DA,DP,DC,DL,DE,DI,DIEL,DIETMP,DIFLD,DIP,DK,DM,DP,DQ,DU,DV,DW
W ! S DIE=130,DA=SRTN1,DR=SRJ_"T" D ^DIE
Q
HELP D EN^DDIOL("Enter 'YES' to enter time out comments. Enter 'NO' to quit without entering time out comments.",,"!!")
Q
WSXR(SRTN) ; prompt the user for the wound sweep & intraoperative X-Ray fields
N SRC,SRSSDT
Q:'$D(^TMP("SR182",$J))
S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) D D^DIQ S SRSSDT=Y
W @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSSDT
S SRC(1)="Wound Sweep & Intraoperative X-Ray fields must be entered when a ""NO"" response is entered for any of the following fields: ",SRC(1,"F")="!!"
S SRC(2)=" - SPONGE FINAL COUNT CORRECT, OR",SRC(2,"F")="!!?5"
S SRC(3)=" - SHARPS FINAL COUNT CORRECT, OR",SRC(3,"F")="!?5"
S SRC(4)=" - INSTRUMENT FINAL COUNT CORRECT",SRC(4,"F")="!?5"
S SRC(5)=""
D EN^DDIOL(.SRC,,"!")
K DR,DA,DIE S DR="633T;636T",DA=SRTN,DIE=130 D ^DIE K DR,DA
D:$P($G(^SRF(SRTN,25)),"^",7)="N" COM(635)
D:$P($G(^SRF(SRTN,25)),"^",8)="N" COM(637)
W !!,"Press <RET> to continue " R X:DTIME
Q
COM(SRJ) ;prompt the user for the wound sweep/Intraoperative X-Ray comments fields
SK D EN^DDIOL($S(SRJ=635:"Wound Sweep",1:"Intraoperative X-Ray")_" comments should be entered when a ""NO"" response is entered for the "_$S(SRJ=635:"Wound Sweep",1:"Intraoperative X-Ray")_" field.",,"!!")
D FIELD^DID("130.0"_SRJ,.01,"","TITLE","SRK")
D EN^DDIOL("Do you want to enter "_SRK("TITLE")_" ? YES// ",,"!")
R SRYN:DTIME I '$T!(SRYN["^") Q
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I SRYN["?" D G SK
.D EN^DDIOL("Enter 'YES' to enter"_$S(SRJ=635:"Wound Sweep",1:"Intraoperative X-Ray")_" comments. Enter 'NO' to quit without entering time out comments.",,"!!")
I "YyNn"'[SRYN D EN^DDIOL("Enter 'YES' to enter"_$S(SRJ=635:"Wound Sweep",1:"Intraoperative X-Ray")_" Comments now, 'NO' to quit, or '?' for more help.",,"!!") G SK
I "Nn"[SRYN Q
; edit the related comments field
W ! S DIE=130,DA=SRTN,DR=SRJ_"T" D ^DIE
Q
ABORT(SRTN) ; check if the case is aborted
N SRNP2 S SRNP2=$G(^SRF(SRTN,.2))
I $P($G(^SRF(SRTN,30)),"^")'=""!($P($G(^SRF(SRTN,31)),"^",8)'="") I $P(SRNP2,"^")!($P(SRNP2,"^",10))&($P($G(^SRF(SRTN,30)),"^",6)>1) Q 1
Q 0
;
VER1(SRTN) ; check before displaying [SROMEN-VERF1] fields
N SRCPT
S SRCPT=$P($G(^SRF(SRTN,"OP")),"^",2) I 'SRCPT Q 0
I ",32851,32852,32853,32854,33935,33945,44135,44136,47135,47136,48160,48554,50360,50365,"[(","_SRCPT_",") Q 1
Q 0
;
VER2(SRTN) ; check before displaying [SROMEN-VERF2] fields
N SRCPT
S SRCPT=$P($G(^SRF(SRTN,"OP")),"^",2) I 'SRCPT Q 0
I ",44133,47140,47141,47142,48550,50320,50547,"[(","_SRCPT_",") Q 1
Q 0
;
SPIN(SRCPT) ; check to see if the case is spinal case
N SRF,SCPT S SRF=0
S SRTN=$S($D(SRTN):SRTN,$D(DA):DA,1:"") I SRTN S SROP=$G(^SRF(SRTN,"OP"))
S SCPT=$S($D(SRCPT):SRCPT,$P(SROP,"^",2):$P(SROP,"^",2),1:"")
S:'SCPT SRF=0
I $G(SCPT),$D(^SRO(131.4,SCPT,0)) S SRF=1
I SRF=0 S $P(^SRF(SRTN,1.1),"^",4)=""
Q SRF
;
SCR(SRF) ; screen items that are not matching case specialty
N SRSPEC
S SRSPEC=$P($G(^SRF($S($D(SRTN):SRTN,1:DA),0)),"^",4)
I '$O(^SRO(SRF,Y,1,"B",0)) Q 1
I '$D(^SRO(SRF,Y,1,"B",SRSPEC)) Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTOVRF 4025 printed Dec 13, 2024@02:48:11 Page 2
SRTOVRF ;BIR/SJA - TIME OUT VERIFIED FOR SURGERY ;12/16/10
+1 ;;3.0;Surgery;**175,182,184**;24 Jun 93;Build 35
+2 ;
+3 ; entry point called by 'AE' x-ref of the 600-611 surgery fields
IN NEW SRJ,SRK,SRTN1,SRYN
SET SRTN1=$SELECT($DATA(SRTN):SRTN,1:DA)
if 'SRTN1
QUIT
+1 SET SRJ=85
ASK DO EN^DDIOL("Checklist Comments should be entered when a ""NO"" response is entered for any of the Time Out Verified Utilizing Checklist fields.",,"!!")
+1 DO FIELD^DID("130.0"_SRJ,.01,"","TITLE","SRK")
+2 DO EN^DDIOL("Do you want to enter "_SRK("TITLE")_" ? YES// ",,"!")
+3 READ SRYN:DTIME
IF '$TEST!(SRYN["^")
QUIT
+4 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
IF SRYN["?"
DO HELP
GOTO ASK
+5 IF "YyNn"'[SRYN
DO EN^DDIOL("Enter 'YES' to enter checklist comments now, 'NO' to quit, or '?' for more help.",,"!!")
GOTO ASK
+6 IF "Nn"[SRYN
QUIT
+7 ; edit the associated comments fields
+8 NEW DR,DIE,DA,DP,DC,DL,DE,DI,DIEL,DIETMP,DIFLD,DIP,DK,DM,DP,DQ,DU,DV,DW
+9 WRITE !
SET DIE=130
SET DA=SRTN1
SET DR=SRJ_"T"
DO ^DIE
+10 QUIT
HELP DO EN^DDIOL("Enter 'YES' to enter time out comments. Enter 'NO' to quit without entering time out comments.",,"!!")
+1 QUIT
WSXR(SRTN) ; prompt the user for the wound sweep & intraoperative X-Ray fields
+1 NEW SRC,SRSSDT
+2 if '$DATA(^TMP("SR182",$JOB))
QUIT
+3 SET Y=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
DO D^DIQ
SET SRSSDT=Y
+4 WRITE @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSSDT
+5 SET SRC(1)="Wound Sweep & Intraoperative X-Ray fields must be entered when a ""NO"" response is entered for any of the following fields: "
SET SRC(1,"F")="!!"
+6 SET SRC(2)=" - SPONGE FINAL COUNT CORRECT, OR"
SET SRC(2,"F")="!!?5"
+7 SET SRC(3)=" - SHARPS FINAL COUNT CORRECT, OR"
SET SRC(3,"F")="!?5"
+8 SET SRC(4)=" - INSTRUMENT FINAL COUNT CORRECT"
SET SRC(4,"F")="!?5"
+9 SET SRC(5)=""
+10 DO EN^DDIOL(.SRC,,"!")
+11 KILL DR,DA,DIE
SET DR="633T;636T"
SET DA=SRTN
SET DIE=130
DO ^DIE
KILL DR,DA
+12 if $PIECE($GET(^SRF(SRTN,25)),"^",7)="N"
DO COM(635)
+13 if $PIECE($GET(^SRF(SRTN,25)),"^",8)="N"
DO COM(637)
+14 WRITE !!,"Press <RET> to continue "
READ X:DTIME
+15 QUIT
COM(SRJ) ;prompt the user for the wound sweep/Intraoperative X-Ray comments fields
SK DO EN^DDIOL($SELECT(SRJ=635:"Wound Sweep",1:"Intraoperative X-Ray")_" comments should be entered when a ""NO"" response is entered for the "_$SELECT(SRJ=635:"Wound Sweep",1:"Intraoperative X-Ray")_" field.",,"!!")
+1 DO FIELD^DID("130.0"_SRJ,.01,"","TITLE","SRK")
+2 DO EN^DDIOL("Do you want to enter "_SRK("TITLE")_" ? YES// ",,"!")
+3 READ SRYN:DTIME
IF '$TEST!(SRYN["^")
QUIT
+4 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
IF SRYN["?"
Begin DoDot:1
+5 DO EN^DDIOL("Enter 'YES' to enter"_$SELECT(SRJ=635:"Wound Sweep",1:"Intraoperative X-Ray")_" comments. Enter 'NO' to quit without entering time out comments.",,"!!")
End DoDot:1
GOTO SK
+6 IF "YyNn"'[SRYN
DO EN^DDIOL("Enter 'YES' to enter"_$SELECT(SRJ=635:"Wound Sweep",1:"Intraoperative X-Ray")_" Comments now, 'NO' to quit, or '?' for more help.",,"!!")
GOTO SK
+7 IF "Nn"[SRYN
QUIT
+8 ; edit the related comments field
+9 WRITE !
SET DIE=130
SET DA=SRTN
SET DR=SRJ_"T"
DO ^DIE
+10 QUIT
ABORT(SRTN) ; check if the case is aborted
+1 NEW SRNP2
SET SRNP2=$GET(^SRF(SRTN,.2))
+2 IF $PIECE($GET(^SRF(SRTN,30)),"^")'=""!($PIECE($GET(^SRF(SRTN,31)),"^",8)'="")
IF $PIECE(SRNP2,"^")!($PIECE(SRNP2,"^",10))&($PIECE($GET(^SRF(SRTN,30)),"^",6)>1)
QUIT 1
+3 QUIT 0
+4 ;
VER1(SRTN) ; check before displaying [SROMEN-VERF1] fields
+1 NEW SRCPT
+2 SET SRCPT=$PIECE($GET(^SRF(SRTN,"OP")),"^",2)
IF 'SRCPT
QUIT 0
+3 IF ",32851,32852,32853,32854,33935,33945,44135,44136,47135,47136,48160,48554,50360,50365,"[(","_SRCPT_",")
QUIT 1
+4 QUIT 0
+5 ;
VER2(SRTN) ; check before displaying [SROMEN-VERF2] fields
+1 NEW SRCPT
+2 SET SRCPT=$PIECE($GET(^SRF(SRTN,"OP")),"^",2)
IF 'SRCPT
QUIT 0
+3 IF ",44133,47140,47141,47142,48550,50320,50547,"[(","_SRCPT_",")
QUIT 1
+4 QUIT 0
+5 ;
SPIN(SRCPT) ; check to see if the case is spinal case
+1 NEW SRF,SCPT
SET SRF=0
+2 SET SRTN=$SELECT($DATA(SRTN):SRTN,$DATA(DA):DA,1:"")
IF SRTN
SET SROP=$GET(^SRF(SRTN,"OP"))
+3 SET SCPT=$SELECT($DATA(SRCPT):SRCPT,$PIECE(SROP,"^",2):$PIECE(SROP,"^",2),1:"")
+4 if 'SCPT
SET SRF=0
+5 IF $GET(SCPT)
IF $DATA(^SRO(131.4,SCPT,0))
SET SRF=1
+6 IF SRF=0
SET $PIECE(^SRF(SRTN,1.1),"^",4)=""
+7 QUIT SRF
+8 ;
SCR(SRF) ; screen items that are not matching case specialty
+1 NEW SRSPEC
+2 SET SRSPEC=$PIECE($GET(^SRF($SELECT($DATA(SRTN):SRTN,1:DA),0)),"^",4)
+3 IF '$ORDER(^SRO(SRF,Y,1,"B",0))
QUIT 1
+4 IF '$DATA(^SRO(SRF,Y,1,"B",SRSPEC))
QUIT 0
+5 QUIT 1
