SROESX ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/16/04 09:21 AM ]
;;3.0; Surgery ;**100,129**;24 Jun 93
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
; Reference to $$WHATITLE^TIUPUTU supported by DBIA #3351
; Reference to DELETE^TIUSRVP supported by DBIA #3535
; Reference to MAKE^TIUSRVP supported by DBIA #3535
; Reference to UPDATE^TIUSRVP supported by DBIA #3535
; Reference to $$CANDEL^TIUSRVP1 supported by DBIA #4175
;
Q
AES ; set logic for AES cross-reference
N SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK
S SRTN=DA I $P($G(^SRF(SRTN,"NON")),"^")="Y" Q
S ZTDESC="Surgery Nurse Intraop Report Stub",ZTRTN="NR^SROESX",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD
S ZTDESC="Surgery Operation Report Stub",ZTRTN="OR^SROESX",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD
Q
NR ; create stub entry in TIU for nurse intraop report
N DFN,DIC,SR0,SRAY,SRCIRC,SRD,SRDOC,SRLOC,SRRN,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,VSTR,X,Y
I '$P($G(^SRF(SRTN,.2)),"^",12) D END Q
S SRD=$P($G(^SRF(SRTN,"TIU")),"^",2) I SRD D END Q
S SRX=$$WHATITLE^TIUPUTU("NURSE INTRAOPERATIVE REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
S SRDIV=$$SITE^SROUTL0(SRTN),SR0=^SRF(SRTN,0),DFN=$P(SR0,"^") D LOC
S SRAY(.02)=DFN,SRAY(.05)=1,SRAY(1205)=SRLOC,SRAY(1301)=$P(SR0,"^",9),SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
S X=$G(^SRF(SRTN,.2)),SRAY(.07)=$P(X,"^",10),SRAY(.08)=$P(X,"^",12)
S VDT=$P(SR0,"^",9),VSIT=$P(SR0,"^",15),VLOC=""
I 'VSIT S VLOC=SRLOC
I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";"_$S(+$D(^DPT(DFN,.1)):"I",1:"E")
S SRCIRC="",SRRN=$O(^SRF(SRTN,19,0)) S:SRRN SRCIRC=$P($G(^SRF(SRTN,19,SRRN,0)),"^") S (SRAY(1202),SRAY(1204))=SRCIRC
D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU D
.F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",2)=SRTIU L -^SRF("TIU"_SRTN) Q
.D ALERT
END I $D(ZTQUEUED) S ZTREQ="@"
Q
LOC ; get patient location
N SRDEF,SROR,SRT,SRWARD,VAIP,X,Y
S VAIP("D")=$P(SR0,"^",9) D IN5^VADPT
S (SRDEF,SRLOC)="",SRWARD=$P(VAIP(5),"^"),SROR=$P(SR0,"^",2) I SROR S SROR=$P(^SRS(SROR,0),"^")
I SRWARD K DA,DIC,DIQ,DR S DA=SRWARD,DIC=42,DR="44",DIQ="SRT",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR S SRLOC=$G(SRT(42,SRWARD,44,"I"))
S SRDEF=$P($G(^SRO(133,SRDIV,0)),"^",23)
I SRDEF="" S X="SURGERY OP REPORT NON-COUNT",DIC(0)="M",DIC="^SC(" D ^DIC K DIC I +Y>0 S SRDEF=+Y
S SRLOC=$S(SRLOC:SRLOC,SRDEF:SRDEF,SROR:SROR,1:"")
Q
ALERT ; issue alert to circulating nurse(s)
S XQAID="SRNIR-"_SRTN,XQAKILL=0 D DELETEA^XQALERT K XQAID,XQAKILL
N DFN,SRNM,SRRN,SRX S SRRN=0 F S SRRN=$O(^SRF(SRTN,19,SRRN)) Q:'SRRN S SRX=$P($G(^SRF(SRTN,19,SRRN,0)),"^") I SRX S XQA(SRX)=""
I '$D(XQA) S XQA(DUZ)=""
S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNM=$E($P(VADM(1),"^"),1,15)_" ("_$E($P(VADM(1),"^"))_VA("BID")_"): "
S SRLAB=SRNM_$E($P(^SRF(SRTN,"OP"),"^"),1,25)_" (NIR ready to complete)"
S XQAMSG=SRLAB,XQAROU="ACTION^SROESX",XQAID="SRNIR-"_SRTN,XQADATA=SRTN D SETUP^XQALERT
Q
STATUS(SRSTAT) ; update status
K SRAY S SRAY(.05)=SRSTAT D UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)
Q
OR ; create stub entry in TIU for Operation Report
N DFN,DIC,SR0,SRACODE,SRATT,SRAY,SRD,SRDIV,SRDOC,SRLOC,SRSURG,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,VSTR,X,Y
I '$P($G(^SRF(SRTN,.2)),"^",12) D END Q
S SRD=$P($G(^SRF(SRTN,"TIU")),"^") I SRD D END Q
S SRX=$$WHATITLE^TIUPUTU("OPERATION REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
S SRDIV=$$SITE^SROUTL0(SRTN),SR0=^SRF(SRTN,0),DFN=$P(SR0,"^") D LOC
S X=$G(^SRF(SRTN,.1)),SRATT=$P(X,"^",13),SRSURG=$P(X,"^",4),SRACODE=$P(X,"^",10)
I 'SRATT D
.I "159"[SRACODE S SRATT=SRSURG Q
.I SRDIV,'$P(^SRO(133,SRDIV,0),"^",19) S SRATT=SRSURG
S SRAY(.02)=DFN,SRAY(.05)=1,(SRAY(1202),SRAY(1204))=SRSURG,SRAY(1205)=SRLOC,(SRAY(1208),SRAY(1209))=SRATT,SRAY(1301)=$P(SR0,"^",9),SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
S X=$G(^SRF(SRTN,.2)),SRAY(.07)=$P(X,"^",10),SRAY(.08)=$P(X,"^",12)
S VDT=$P(SR0,"^",9),VSIT=$P(SR0,"^",15),VLOC=""
I 'VSIT S VLOC=SRLOC
I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";"_$S(+$D(^DPT(DFN,.1)):"I",1:"E")
D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU D
.F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^")=SRTIU L -^SRF("TIU"_SRTN) Q
D END
Q
KAES ; kill logic for the AES cross-reference
N SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK S SRTN=DA
F SRI=1,2 S ZTDESC="Surgery "_$S(SRI=2:"Nurse Intraop",1:"Op")_" Report Delete Stub",ZTRTN="KSTUB^SROESX",ZTIO="",ZTDTH=$H,(ZTSAVE("SRTN"),ZTSAVE("SRI"))="" D ^%ZTLOAD
Q
KSTUB ; delete stubs in TIU for unsigned nurse intraop & op reports
N SRERR,SRODA,SRTIU
S SRODA=SRTN,SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",SRI) I SRTIU D
.D STATUS(5)
.D DELETE^TIUSRVP(.SRERR,SRTIU,,1) I 'SRERR D
..F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",SRI)="" L -^SRF("TIU"_SRTN) Q
D DELRT,END
Q
ACTION ; alert action
N SRALRT,SRTN K XQAKILL S SRTN=XQADATA,SRALRT=1 D ^SRONIN
S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",2) I SRTIU,$$STATUS^SROESUTL(SRTIU)=7 D DELRT
Q
DELRT N XQAID,XQAKILL S XQAID="SRNIR-"_SRTN,XQAKILL=0 D DELETEA^XQALERT
Q
DEL(SRTN,SP) ; check document status to determine if OK to delete/edit field
; SRTN - surgery case ien
; SP - piece number in ^SRF(SRTN,"TIU"), comma delimited if multiple pieces
;
N FLG,II,SRTIU,PCE S FLG=0
S SRTIU=$G(^SRF(SRTN,"TIU")) F II=1:1:$L(SP,",") S PCE=$P(SP,",",II) I $P(SRTIU,"^",PCE) I $$CANDEL^TIUSRVP1($P(SRTIU,"^",PCE))=0 S FLG=1
Q FLG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROESX 5597 printed Sep 23, 2025@20:20:08 Page 2
SROESX ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/16/04 09:21 AM ]
+1 ;;3.0; Surgery ;**100,129**;24 Jun 93
+2 ;** NOTICE: This routine is part of an implementation of a nationally
+3 ;** controlled procedure. Local modifications to this routine
+4 ;** are prohibited.
+5 ;
+6 ; Reference to $$WHATITLE^TIUPUTU supported by DBIA #3351
+7 ; Reference to DELETE^TIUSRVP supported by DBIA #3535
+8 ; Reference to MAKE^TIUSRVP supported by DBIA #3535
+9 ; Reference to UPDATE^TIUSRVP supported by DBIA #3535
+10 ; Reference to $$CANDEL^TIUSRVP1 supported by DBIA #4175
+11 ;
+12 QUIT
AES ; set logic for AES cross-reference
+1 NEW SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK
+2 SET SRTN=DA
IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
QUIT
+3 SET ZTDESC="Surgery Nurse Intraop Report Stub"
SET ZTRTN="NR^SROESX"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("SRTN")=""
DO ^%ZTLOAD
+4 SET ZTDESC="Surgery Operation Report Stub"
SET ZTRTN="OR^SROESX"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("SRTN")=""
DO ^%ZTLOAD
+5 QUIT
NR ; create stub entry in TIU for nurse intraop report
+1 NEW DFN,DIC,SR0,SRAY,SRCIRC,SRD,SRDOC,SRLOC,SRRN,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,VSTR,X,Y
+2 IF '$PIECE($GET(^SRF(SRTN,.2)),"^",12)
DO END
QUIT
+3 SET SRD=$PIECE($GET(^SRF(SRTN,"TIU")),"^",2)
IF SRD
DO END
QUIT
+4 SET SRX=$$WHATITLE^TIUPUTU("NURSE INTRAOPERATIVE REPORT")
SET TITLE=$PIECE(SRX,"^")
IF 'TITLE
QUIT
+5 SET SRDIV=$$SITE^SROUTL0(SRTN)
SET SR0=^SRF(SRTN,0)
SET DFN=$PIECE(SR0,"^")
DO LOC
+6 SET SRAY(.02)=DFN
SET SRAY(.05)=1
SET SRAY(1205)=SRLOC
SET SRAY(1301)=$PIECE(SR0,"^",9)
SET SRAY(1405)=SRTN_";SRF("
SET SRAY(1701)="Case #: "_SRTN
+7 SET X=$GET(^SRF(SRTN,.2))
SET SRAY(.07)=$PIECE(X,"^",10)
SET SRAY(.08)=$PIECE(X,"^",12)
+8 SET VDT=$PIECE(SR0,"^",9)
SET VSIT=$PIECE(SR0,"^",15)
SET VLOC=""
+9 IF 'VSIT
SET VLOC=SRLOC
+10 IF VLOC
SET SRAY(1211)=VLOC
SET VSTR=VLOC_";"_VDT_";"_$SELECT(+$DATA(^DPT(DFN,.1)):"I",1:"E")
+11 SET SRCIRC=""
SET SRRN=$ORDER(^SRF(SRTN,19,0))
if SRRN
SET SRCIRC=$PIECE($GET(^SRF(SRTN,19,SRRN,0)),"^")
SET (SRAY(1202),SRAY(1204))=SRCIRC
+12 DO MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$GET(VSTR),1,1)
IF SRTIU
Begin DoDot:1
+13 FOR
LOCK +^SRF("TIU"_SRTN):5
IF $TEST
SET $PIECE(^SRF(SRTN,"TIU"),"^",2)=SRTIU
LOCK -^SRF("TIU"_SRTN)
QUIT
+14 DO ALERT
End DoDot:1
END IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT
LOC ; get patient location
+1 NEW SRDEF,SROR,SRT,SRWARD,VAIP,X,Y
+2 SET VAIP("D")=$PIECE(SR0,"^",9)
DO IN5^VADPT
+3 SET (SRDEF,SRLOC)=""
SET SRWARD=$PIECE(VAIP(5),"^")
SET SROR=$PIECE(SR0,"^",2)
IF SROR
SET SROR=$PIECE(^SRS(SROR,0),"^")
+4 IF SRWARD
KILL DA,DIC,DIQ,DR
SET DA=SRWARD
SET DIC=42
SET DR="44"
SET DIQ="SRT"
SET DIQ(0)="I"
DO EN^DIQ1
KILL DA,DIC,DIQ,DR
SET SRLOC=$GET(SRT(42,SRWARD,44,"I"))
+5 SET SRDEF=$PIECE($GET(^SRO(133,SRDIV,0)),"^",23)
+6 IF SRDEF=""
SET X="SURGERY OP REPORT NON-COUNT"
SET DIC(0)="M"
SET DIC="^SC("
DO ^DIC
KILL DIC
IF +Y>0
SET SRDEF=+Y
+7 SET SRLOC=$SELECT(SRLOC:SRLOC,SRDEF:SRDEF,SROR:SROR,1:"")
+8 QUIT
ALERT ; issue alert to circulating nurse(s)
+1 SET XQAID="SRNIR-"_SRTN
SET XQAKILL=0
DO DELETEA^XQALERT
KILL XQAID,XQAKILL
+2 NEW DFN,SRNM,SRRN,SRX
SET SRRN=0
FOR
SET SRRN=$ORDER(^SRF(SRTN,19,SRRN))
if 'SRRN
QUIT
SET SRX=$PIECE($GET(^SRF(SRTN,19,SRRN,0)),"^")
IF SRX
SET XQA(SRX)=""
+3 IF '$DATA(XQA)
SET XQA(DUZ)=""
+4 SET DFN=$PIECE(^SRF(SRTN,0),"^")
DO DEM^VADPT
SET SRNM=$EXTRACT($PIECE(VADM(1),"^"),1,15)_" ("_$EXTRACT($PIECE(VADM(1),"^"))_VA("BID")_"): "
+5 SET SRLAB=SRNM_$EXTRACT($PIECE(^SRF(SRTN,"OP"),"^"),1,25)_" (NIR ready to complete)"
+6 SET XQAMSG=SRLAB
SET XQAROU="ACTION^SROESX"
SET XQAID="SRNIR-"_SRTN
SET XQADATA=SRTN
DO SETUP^XQALERT
+7 QUIT
STATUS(SRSTAT) ; update status
+1 KILL SRAY
SET SRAY(.05)=SRSTAT
DO UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)
+2 QUIT
OR ; create stub entry in TIU for Operation Report
+1 NEW DFN,DIC,SR0,SRACODE,SRATT,SRAY,SRD,SRDIV,SRDOC,SRLOC,SRSURG,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,VSTR,X,Y
+2 IF '$PIECE($GET(^SRF(SRTN,.2)),"^",12)
DO END
QUIT
+3 SET SRD=$PIECE($GET(^SRF(SRTN,"TIU")),"^")
IF SRD
DO END
QUIT
+4 SET SRX=$$WHATITLE^TIUPUTU("OPERATION REPORT")
SET TITLE=$PIECE(SRX,"^")
IF 'TITLE
QUIT
+5 SET SRDIV=$$SITE^SROUTL0(SRTN)
SET SR0=^SRF(SRTN,0)
SET DFN=$PIECE(SR0,"^")
DO LOC
+6 SET X=$GET(^SRF(SRTN,.1))
SET SRATT=$PIECE(X,"^",13)
SET SRSURG=$PIECE(X,"^",4)
SET SRACODE=$PIECE(X,"^",10)
+7 IF 'SRATT
Begin DoDot:1
+8 IF "159"[SRACODE
SET SRATT=SRSURG
QUIT
+9 IF SRDIV
IF '$PIECE(^SRO(133,SRDIV,0),"^",19)
SET SRATT=SRSURG
End DoDot:1
+10 SET SRAY(.02)=DFN
SET SRAY(.05)=1
SET (SRAY(1202),SRAY(1204))=SRSURG
SET SRAY(1205)=SRLOC
SET (SRAY(1208),SRAY(1209))=SRATT
SET SRAY(1301)=$PIECE(SR0,"^",9)
SET SRAY(1405)=SRTN_";SRF("
SET SRAY(1701)="Case #: "_SRTN
+11 SET X=$GET(^SRF(SRTN,.2))
SET SRAY(.07)=$PIECE(X,"^",10)
SET SRAY(.08)=$PIECE(X,"^",12)
+12 SET VDT=$PIECE(SR0,"^",9)
SET VSIT=$PIECE(SR0,"^",15)
SET VLOC=""
+13 IF 'VSIT
SET VLOC=SRLOC
+14 IF VLOC
SET SRAY(1211)=VLOC
SET VSTR=VLOC_";"_VDT_";"_$SELECT(+$DATA(^DPT(DFN,.1)):"I",1:"E")
+15 DO MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$GET(VSTR),1,1)
IF SRTIU
Begin DoDot:1
+16 FOR
LOCK +^SRF("TIU"_SRTN):5
IF $TEST
SET $PIECE(^SRF(SRTN,"TIU"),"^")=SRTIU
LOCK -^SRF("TIU"_SRTN)
QUIT
End DoDot:1
+17 DO END
+18 QUIT
KAES ; kill logic for the AES cross-reference
+1 NEW SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK
SET SRTN=DA
+2 FOR SRI=1,2
SET ZTDESC="Surgery "_$SELECT(SRI=2:"Nurse Intraop",1:"Op")_" Report Delete Stub"
SET ZTRTN="KSTUB^SROESX"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET (ZTSAVE("SRTN"),ZTSAVE("SRI"))=""
DO ^%ZTLOAD
+3 QUIT
KSTUB ; delete stubs in TIU for unsigned nurse intraop & op reports
+1 NEW SRERR,SRODA,SRTIU
+2 SET SRODA=SRTN
SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",SRI)
IF SRTIU
Begin DoDot:1
+3 DO STATUS(5)
+4 DO DELETE^TIUSRVP(.SRERR,SRTIU,,1)
IF 'SRERR
Begin DoDot:2
+5 FOR
LOCK +^SRF("TIU"_SRTN):5
IF $TEST
SET $PIECE(^SRF(SRTN,"TIU"),"^",SRI)=""
LOCK -^SRF("TIU"_SRTN)
QUIT
End DoDot:2
End DoDot:1
+6 DO DELRT
DO END
+7 QUIT
ACTION ; alert action
+1 NEW SRALRT,SRTN
KILL XQAKILL
SET SRTN=XQADATA
SET SRALRT=1
DO ^SRONIN
+2 SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",2)
IF SRTIU
IF $$STATUS^SROESUTL(SRTIU)=7
DO DELRT
+3 QUIT
DELRT NEW XQAID,XQAKILL
SET XQAID="SRNIR-"_SRTN
SET XQAKILL=0
DO DELETEA^XQALERT
+1 QUIT
DEL(SRTN,SP) ; check document status to determine if OK to delete/edit field
+1 ; SRTN - surgery case ien
+2 ; SP - piece number in ^SRF(SRTN,"TIU"), comma delimited if multiple pieces
+3 ;
+4 NEW FLG,II,SRTIU,PCE
SET FLG=0
+5 SET SRTIU=$GET(^SRF(SRTN,"TIU"))
FOR II=1:1:$LENGTH(SP,",")
SET PCE=$PIECE(SP,",",II)
IF $PIECE(SRTIU,"^",PCE)
IF $$CANDEL^TIUSRVP1($PIECE(SRTIU,"^",PCE))=0
SET FLG=1
+6 QUIT FLG
