SROES.m

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

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