Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SRTOVRF

SRTOVRF.m

Go to the documentation of this file.
  1. SRTOVRF ;BIR/SJA - TIME OUT VERIFIED FOR SURGERY ;12/16/10
  1. ;;3.0;Surgery;**175,182,184**;24 Jun 93;Build 35
  1. ;
  1. ; entry point called by 'AE' x-ref of the 600-611 surgery fields
  1. IN N SRJ,SRK,SRTN1,SRYN S SRTN1=$S($D(SRTN):SRTN,1:DA) Q:'SRTN1
  1. S SRJ=85
  1. 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.",,"!!")
  1. D FIELD^DID("130.0"_SRJ,.01,"","TITLE","SRK")
  1. D EN^DDIOL("Do you want to enter "_SRK("TITLE")_" ? YES// ",,"!")
  1. R SRYN:DTIME I '$T!(SRYN["^") Q
  1. S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I SRYN["?" D HELP G ASK
  1. I "YyNn"'[SRYN D EN^DDIOL("Enter 'YES' to enter checklist comments now, 'NO' to quit, or '?' for more help.",,"!!") G ASK
  1. I "Nn"[SRYN Q
  1. ; edit the associated comments fields
  1. N DR,DIE,DA,DP,DC,DL,DE,DI,DIEL,DIETMP,DIFLD,DIP,DK,DM,DP,DQ,DU,DV,DW
  1. W ! S DIE=130,DA=SRTN1,DR=SRJ_"T" D ^DIE
  1. Q
  1. HELP D EN^DDIOL("Enter 'YES' to enter time out comments. Enter 'NO' to quit without entering time out comments.",,"!!")
  1. Q
  1. WSXR(SRTN) ; prompt the user for the wound sweep & intraoperative X-Ray fields
  1. N SRC,SRSSDT
  1. Q:'$D(^TMP("SR182",$J))
  1. S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) D D^DIQ S SRSSDT=Y
  1. W @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSSDT
  1. 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")="!!"
  1. S SRC(2)=" - SPONGE FINAL COUNT CORRECT, OR",SRC(2,"F")="!!?5"
  1. S SRC(3)=" - SHARPS FINAL COUNT CORRECT, OR",SRC(3,"F")="!?5"
  1. S SRC(4)=" - INSTRUMENT FINAL COUNT CORRECT",SRC(4,"F")="!?5"
  1. S SRC(5)=""
  1. D EN^DDIOL(.SRC,,"!")
  1. K DR,DA,DIE S DR="633T;636T",DA=SRTN,DIE=130 D ^DIE K DR,DA
  1. D:$P($G(^SRF(SRTN,25)),"^",7)="N" COM(635)
  1. D:$P($G(^SRF(SRTN,25)),"^",8)="N" COM(637)
  1. W !!,"Press <RET> to continue " R X:DTIME
  1. Q
  1. COM(SRJ) ;prompt the user for the wound sweep/Intraoperative X-Ray comments fields
  1. 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.",,"!!")
  1. D FIELD^DID("130.0"_SRJ,.01,"","TITLE","SRK")
  1. D EN^DDIOL("Do you want to enter "_SRK("TITLE")_" ? YES// ",,"!")
  1. R SRYN:DTIME I '$T!(SRYN["^") Q
  1. S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I SRYN["?" D G SK
  1. .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.",,"!!")
  1. 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
  1. I "Nn"[SRYN Q
  1. ; edit the related comments field
  1. W ! S DIE=130,DA=SRTN,DR=SRJ_"T" D ^DIE
  1. Q
  1. ABORT(SRTN) ; check if the case is aborted
  1. N SRNP2 S SRNP2=$G(^SRF(SRTN,.2))
  1. 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
  1. Q 0
  1. ;
  1. VER1(SRTN) ; check before displaying [SROMEN-VERF1] fields
  1. N SRCPT
  1. S SRCPT=$P($G(^SRF(SRTN,"OP")),"^",2) I 'SRCPT Q 0
  1. I ",32851,32852,32853,32854,33935,33945,44135,44136,47135,47136,48160,48554,50360,50365,"[(","_SRCPT_",") Q 1
  1. Q 0
  1. ;
  1. VER2(SRTN) ; check before displaying [SROMEN-VERF2] fields
  1. N SRCPT
  1. S SRCPT=$P($G(^SRF(SRTN,"OP")),"^",2) I 'SRCPT Q 0
  1. I ",44133,47140,47141,47142,48550,50320,50547,"[(","_SRCPT_",") Q 1
  1. Q 0
  1. ;
  1. SPIN(SRCPT) ; check to see if the case is spinal case
  1. N SRF,SCPT S SRF=0
  1. S SRTN=$S($D(SRTN):SRTN,$D(DA):DA,1:"") I SRTN S SROP=$G(^SRF(SRTN,"OP"))
  1. S SCPT=$S($D(SRCPT):SRCPT,$P(SROP,"^",2):$P(SROP,"^",2),1:"")
  1. S:'SCPT SRF=0
  1. I $G(SCPT),$D(^SRO(131.4,SCPT,0)) S SRF=1
  1. I SRF=0 S $P(^SRF(SRTN,1.1),"^",4)=""
  1. Q SRF
  1. ;
  1. SCR(SRF) ; screen items that are not matching case specialty
  1. N SRSPEC
  1. S SRSPEC=$P($G(^SRF($S($D(SRTN):SRTN,1:DA),0)),"^",4)
  1. I '$O(^SRO(SRF,Y,1,"B",0)) Q 1
  1. I '$D(^SRO(SRF,Y,1,"B",SRSPEC)) Q 0
  1. Q 1