- 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 Feb 19, 2025@00:10:11 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