SROES ;BIR/ADM - SURGERY E-SIG UTILITY ;06/07/06
;;3.0; Surgery ;**100,153**;24 Jun 93;Build 11
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
; Reference to EXTRACT^TIULQ supported by DBIA #2693
;
SRA N SRRISK S SRRISK=1
ENTER Q:'$G(SRTN)
N SRSOUT D CHECK I $G(SRSOUT) K SRSOUT S XQUIT=""
Q
CHECK ; pre-edit capture of nurse and anesthesia reports for addenda
N I,SRA,SRAUDIT,SRCCASE,SRESAR,SRESNR,SRN,SROP,SRSIGN,SRTIU,SRX,SRY,X S (SRAUDIT,SRSOUT)=0
S (SRA(SRTN),SRAUDIT(SRTN),SRN(SRTN))=0,SRTIU=$G(^SRF(SRTN,"TIU")),SRESNR=$P(SRTIU,"^",2),SRESAR=$P(SRTIU,"^",4),SROP=SRTN D DOCS
S SRCCASE=$P($G(^SRF(SRTN,"CON")),"^") I SRCCASE S (SRA(SRCCASE),SRAUDIT(SRCCASE),SRN(SRCCASE))=0,SRTIU=$G(^SRF(SRCCASE,"TIU")),SRESNR=$P(SRTIU,"^",2),SRESAR=$P(SRTIU,"^",4),SROP=SRCCASE D DOCS
S X=0 F S X=$O(SRAUDIT(X)) Q:'X I SRAUDIT(X) S SRAUDIT=1 Q
Q:'SRAUDIT
D:'$G(SRRISK) WARN I SRSOUT Q
D KTMP
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK S XQUIT="",SRSOUT=1 Q
S SROP=0 F S SROP=$O(SRAUDIT(SROP)) Q:'SROP D PRE
Q
KTMP ; kill TMP globals
F I="SRADDEND","SRAR","SRNR","SRASAVE","SRNSAVE" K ^TMP(I,$J)
F I=1,2 F J="SRAD","SRADM","SRARAD","SRARMULT","SRNRAD","SRNRMULT" K ^TMP(J_I,$J)
Q
DOCS ; determine if signed
I SRESNR S SRX=SRESNR,SRSIGN=0 D SIGNED I SRSIGN S SRN(SROP)=1
I SRESAR S SRX=SRESAR,SRSIGN=0 D SIGNED I SRSIGN S SRA(SROP)=1
Q
SIGNED I SRX N SRERR D EXTRACT^TIULQ(SRX,"SRY",.SRERR,".05") I SRY(SRX,.05,"I")=7 S SRSIGN=1,SRAUDIT(SROP)=1
K SRY
Q
PRE ; save pr-edit copy of case data
N SRTN S SRTN=SROP
D:SRN(SRTN)=1 IN^SROESNR D:SRA(SRTN)=1 IN^SROESAR
Q
WARN ; warning message that addendum may be required
D HDR W !!!,?30,">>> WARNING <<<"
W !!," Electronically signed reports are associated with this case. Editing",!," of data that appear on electronically signed reports will require the",!," creation of addenda to the signed reports.",!!!
K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
HDR S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) X ^DD("DD") S SRSDATE=Y
W @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
Q
EXIT ; post-edit check to see if addenda to nurse/anes. reports are required
Q:'$D(SRTN) D WAIT^DICD
D:$D(^TMP("SRNRAD1",$J,SRTN)) EX^SROESNR
D:$D(^TMP("SRARAD1",$J,SRTN)) EX^SROESAR
I $D(^TMP("SRNRAD1",$J,SRTN))!$D(^TMP("SRARAD1",$J,SRTN))!$D(^TMP("SRNRAD2",$J,SRTN))!$D(^TMP("SRARAD2",$J,SRTN)) D ^SROESAD1
N SRCCASE,SRTN1 S SRCCASE=$P($G(^SRF(SRTN,"CON")),"^") I SRCCASE S SRTN1=SRTN S SRTN=SRCCASE D
.D:$D(^TMP("SRNRAD1",$J,SRTN)) EX^SROESNR
.D:$D(^TMP("SRARAD1",$J,SRTN)) EX^SROESAR
.I $D(^TMP("SRNRAD1",$J,SRTN))!$D(^TMP("SRARAD1",$J,SRTN)) D ^SROESAD1
.S SRTN=SRTN1
DOC N SRADOC,SRDOC,SRNDOC S (SRADOC,SRDOC,SRNDOC)=0
I $O(^TMP("SRNR",$J,SRTN,0)) S SRNDOC=SRNDOC+1,SRDOC=SRDOC+1,SRNDOC(SRTN)="Nurse Intraoperative Report - Case #"_SRTN
I SRCCASE,$O(^TMP("SRNR",$J,SRCCASE,0)) S SRNDOC=SRNDOC+1,SRDOC=SRDOC+1,SRNDOC(SRCCASE)="Nurse Intraoperative Report - Concurrent Case #"_SRCCASE
I $O(^TMP("SRAR",$J,SRTN,0)) S SRADOC=SRADOC+1,SRDOC=SRDOC+1,SRADOC(SRTN)="Anesthesia Report - Case #"_SRTN
I SRCCASE,$O(^TMP("SRAR",$J,SRCCASE,0)) S SRADOC=SRADOC+1,SRDOC=SRDOC+1,SRADOC(SRCCASE)="Anesthesia Report - Concurrent Case #"_SRCCASE
I 'SRDOC Q
D HDR W !!,"An addendum to each of the following electronically signed document(s) is",!,"required:",!
S X=0 F S X=$O(SRNDOC(X)) Q:'X W !,?10,SRNDOC(X)
S X=0 F S X=$O(SRADOC(X)) Q:'X W !,?10,SRADOC(X)
W !!,"If you choose not to create an addendum, the original data will be restored",!,"to the modified fields appearing on the signed reports.",!!
N SRESNOT S SRESNOT=0 K DIR S DIR(0)="Y",DIR("A")="Create addendum",DIR("B")="YES" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRESNOT=1 D ALLREV Q
D ^SROESAD I SRESNOT D REVRS,PRESS
I SRCCASE S SRTN1=SRTN,SRTN=SRCCASE,SRESNOT=0 D ^SROESAD D:SRESNOT REVRS,PRESS S SRTN=SRTN1
UNLOCK D UNLOCK^SROUTL(SRTN),KTMP
Q
PRESS W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue... " D ^DIR K DIR
Q
ALLREV ; restore modified fields for both concurrent cases
W !!,"No addendum created. Original data will be restored.",!!
D REVRS S SRCCASE=$P($G(^SRF(SRTN,"CON")),"^") I SRCCASE S SRTN1=SRTN,SRTN=SRCCASE D REVRS S SRTN=SRTN1
D UNLOCK,PRESS
Q
REVRS ; restore modified fields on signed reports
D REVRS^SROESNR0,REVRS^SROESAR0
S SROERR=SRTN D ^SROERR0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROES 4613 printed Apr 09, 2024@21:50:11 Page 2
SROES ;BIR/ADM - SURGERY E-SIG UTILITY ;06/07/06
+1 ;;3.0; Surgery ;**100,153**;24 Jun 93;Build 11
+2 ;
+3 ;** NOTICE: This routine is part of an implementation of a nationally
+4 ;** controlled procedure. Local modifications to this routine
+5 ;** are prohibited.
+6 ;
+7 ; Reference to EXTRACT^TIULQ supported by DBIA #2693
+8 ;
SRA NEW SRRISK
SET SRRISK=1
ENTER if '$GET(SRTN)
QUIT
+1 NEW SRSOUT
DO CHECK
IF $GET(SRSOUT)
KILL SRSOUT
SET XQUIT=""
+2 QUIT
CHECK ; pre-edit capture of nurse and anesthesia reports for addenda
+1 NEW I,SRA,SRAUDIT,SRCCASE,SRESAR,SRESNR,SRN,SROP,SRSIGN,SRTIU,SRX,SRY,X
SET (SRAUDIT,SRSOUT)=0
+2 SET (SRA(SRTN),SRAUDIT(SRTN),SRN(SRTN))=0
SET SRTIU=$GET(^SRF(SRTN,"TIU"))
SET SRESNR=$PIECE(SRTIU,"^",2)
SET SRESAR=$PIECE(SRTIU,"^",4)
SET SROP=SRTN
DO DOCS
+3 SET SRCCASE=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF SRCCASE
SET (SRA(SRCCASE),SRAUDIT(SRCCASE),SRN(SRCCASE))=0
SET SRTIU=$GET(^SRF(SRCCASE,"TIU"))
SET SRESNR=$PIECE(SRTIU,"^",2)
SET SRESAR=$PIECE(SRTIU,"^",4)
SET SROP=SRCCASE
DO DOCS
+4 SET X=0
FOR
SET X=$ORDER(SRAUDIT(X))
if 'X
QUIT
IF SRAUDIT(X)
SET SRAUDIT=1
QUIT
+5 if 'SRAUDIT
QUIT
+6 if '$GET(SRRISK)
DO WARN
IF SRSOUT
QUIT
+7 DO KTMP
+8 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
SET XQUIT=""
SET SRSOUT=1
QUIT
+9 SET SROP=0
FOR
SET SROP=$ORDER(SRAUDIT(SROP))
if 'SROP
QUIT
DO PRE
+10 QUIT
KTMP ; kill TMP globals
+1 FOR I="SRADDEND","SRAR","SRNR","SRASAVE","SRNSAVE"
KILL ^TMP(I,$JOB)
+2 FOR I=1,2
FOR J="SRAD","SRADM","SRARAD","SRARMULT","SRNRAD","SRNRMULT"
KILL ^TMP(J_I,$JOB)
+3 QUIT
DOCS ; determine if signed
+1 IF SRESNR
SET SRX=SRESNR
SET SRSIGN=0
DO SIGNED
IF SRSIGN
SET SRN(SROP)=1
+2 IF SRESAR
SET SRX=SRESAR
SET SRSIGN=0
DO SIGNED
IF SRSIGN
SET SRA(SROP)=1
+3 QUIT
SIGNED IF SRX
NEW SRERR
DO EXTRACT^TIULQ(SRX,"SRY",.SRERR,".05")
IF SRY(SRX,.05,"I")=7
SET SRSIGN=1
SET SRAUDIT(SROP)=1
+1 KILL SRY
+2 QUIT
PRE ; save pr-edit copy of case data
+1 NEW SRTN
SET SRTN=SROP
+2 if SRN(SRTN)=1
DO IN^SROESNR
if SRA(SRTN)=1
DO IN^SROESAR
+3 QUIT
WARN ; warning message that addendum may be required
+1 DO HDR
WRITE !!!,?30,">>> WARNING <<<"
+2 WRITE !!," Electronically signed reports are associated with this case. Editing",!," of data that appear on electronically signed reports will require the",!," creation of addenda to the signed reports.",!!!
+3 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+4 QUIT
HDR SET DFN=$PIECE(^SRF(SRTN,0),"^")
DO DEM^VADPT
SET Y=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
XECUTE ^DD("DD")
SET SRSDATE=Y
+1 WRITE @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
+2 QUIT
EXIT ; post-edit check to see if addenda to nurse/anes. reports are required
+1 if '$DATA(SRTN)
QUIT
DO WAIT^DICD
+2 if $DATA(^TMP("SRNRAD1",$JOB,SRTN))
DO EX^SROESNR
+3 if $DATA(^TMP("SRARAD1",$JOB,SRTN))
DO EX^SROESAR
+4 IF $DATA(^TMP("SRNRAD1",$JOB,SRTN))!$DATA(^TMP("SRARAD1",$JOB,SRTN))!$DATA(^TMP("SRNRAD2",$JOB,SRTN))!$DATA(^TMP("SRARAD2",$JOB,SRTN))
DO ^SROESAD1
+5 NEW SRCCASE,SRTN1
SET SRCCASE=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF SRCCASE
SET SRTN1=SRTN
SET SRTN=SRCCASE
Begin DoDot:1
+6 if $DATA(^TMP("SRNRAD1",$JOB,SRTN))
DO EX^SROESNR
+7 if $DATA(^TMP("SRARAD1",$JOB,SRTN))
DO EX^SROESAR
+8 IF $DATA(^TMP("SRNRAD1",$JOB,SRTN))!$DATA(^TMP("SRARAD1",$JOB,SRTN))
DO ^SROESAD1
+9 SET SRTN=SRTN1
End DoDot:1
DOC NEW SRADOC,SRDOC,SRNDOC
SET (SRADOC,SRDOC,SRNDOC)=0
+1 IF $ORDER(^TMP("SRNR",$JOB,SRTN,0))
SET SRNDOC=SRNDOC+1
SET SRDOC=SRDOC+1
SET SRNDOC(SRTN)="Nurse Intraoperative Report - Case #"_SRTN
+2 IF SRCCASE
IF $ORDER(^TMP("SRNR",$JOB,SRCCASE,0))
SET SRNDOC=SRNDOC+1
SET SRDOC=SRDOC+1
SET SRNDOC(SRCCASE)="Nurse Intraoperative Report - Concurrent Case #"_SRCCASE
+3 IF $ORDER(^TMP("SRAR",$JOB,SRTN,0))
SET SRADOC=SRADOC+1
SET SRDOC=SRDOC+1
SET SRADOC(SRTN)="Anesthesia Report - Case #"_SRTN
+4 IF SRCCASE
IF $ORDER(^TMP("SRAR",$JOB,SRCCASE,0))
SET SRADOC=SRADOC+1
SET SRDOC=SRDOC+1
SET SRADOC(SRCCASE)="Anesthesia Report - Concurrent Case #"_SRCCASE
+5 IF 'SRDOC
QUIT
+6 DO HDR
WRITE !!,"An addendum to each of the following electronically signed document(s) is",!,"required:",!
+7 SET X=0
FOR
SET X=$ORDER(SRNDOC(X))
if 'X
QUIT
WRITE !,?10,SRNDOC(X)
+8 SET X=0
FOR
SET X=$ORDER(SRADOC(X))
if 'X
QUIT
WRITE !,?10,SRADOC(X)
+9 WRITE !!,"If you choose not to create an addendum, the original data will be restored",!,"to the modified fields appearing on the signed reports.",!!
+10 NEW SRESNOT
SET SRESNOT=0
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Create addendum"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET SRESNOT=1
DO ALLREV
QUIT
+11 DO ^SROESAD
IF SRESNOT
DO REVRS
DO PRESS
+12 IF SRCCASE
SET SRTN1=SRTN
SET SRTN=SRCCASE
SET SRESNOT=0
DO ^SROESAD
if SRESNOT
DO REVRS
DO PRESS
SET SRTN=SRTN1
UNLOCK DO UNLOCK^SROUTL(SRTN)
DO KTMP
+1 QUIT
PRESS WRITE !
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press RETURN to continue... "
DO ^DIR
KILL DIR
+1 QUIT
ALLREV ; restore modified fields for both concurrent cases
+1 WRITE !!,"No addendum created. Original data will be restored.",!!
+2 DO REVRS
SET SRCCASE=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF SRCCASE
SET SRTN1=SRTN
SET SRTN=SRCCASE
DO REVRS
SET SRTN=SRTN1
+3 DO UNLOCK
DO PRESS
+4 QUIT
REVRS ; restore modified fields on signed reports
+1 DO REVRS^SROESNR0
DO REVRS^SROESAR0
+2 SET SROERR=SRTN
DO ^SROERR0
+3 QUIT
