SROESAD ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 09/04/03 1:03 PM ]
;;3.0; Surgery ;**100,173**;24 Jun 93;Build 8
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
; Reference to MAKEADD^TIUSRVP supported by DBIA #3535
; Reference to ES^TIUSROI supported by DBIA #3537
;
Q:'$D(SRNDOC(SRTN))&'$D(SRADOC(SRTN)) D DISPLAY I SRESNOT D NOAD Q
ASK N SRSCOM W @IOF,! S DIR(0)="Y",DIR("A")="Do you want to add a comment for this case",DIR("B")="NO" D ^DIR K DIR S SRSCOM=Y I $D(DTOUT) D NOAD Q
I $D(DUOUT) D SURE I 'SRESNOT G ASK
I SRESNOT D NOAD Q
I 'SRSCOM G SIG
I SRSCOM W !! S DIR(0)="F^3:80",DIR("A")="Comment" D ^DIR K DIR I $D(DTOUT) S SRESNOT=1 Q
I X=""!$D(DUOUT) G SIG
D COM
REV2 ; display addendum with comment for 2nd review
D DISPLAY I SRESNOT D NOAD Q
SIG ; enter e-sig
N SRNOW,SRSBN,SRSIG
D SIG^XUSESIG I X1="" D NOAD Q
S SRSBN=X1,SRNOW=$$NOW^XLFDT
I $D(SRNDOC(SRTN)) D POSTN(SRTN,SRSBN,SRNOW) I SRESNOT=1 Q
I $D(SRADOC(SRTN)) D POSTA(SRTN,SRSBN,SRNOW) I SRESNOT=1 Q
W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue... " D ^DIR K DIR
Q
NOAD ; no addendum created
W !!,"No addendum created for case #"_SRTN_". Original data will be restored.",!! S SRESNOT=1
Q
COM ; add comment to end of addendum
N SRCOM S SRCOM=X I $D(SRNDOC(SRTN)) S SRLN=$O(^TMP("SRNR",$J,SRTN,""),-1) I SRLN D
.I ^TMP("SRNR",$J,SRTN,SRLN)'="" S SRLN=SRLN+1,^TMP("SRNR",$J,SRTN,SRLN)=""
.S SRLN=SRLN+1,^TMP("SRNR",$J,SRTN,SRLN)="Addendum Comment: "_$S($L(SRCOM)<63:SRCOM,1:"")
.I $L(SRCOM)>62 S SRLN=SRLN+1,^TMP("SRNR",$J,SRTN,SRLN)=SRCOM
I $D(SRADOC(SRTN)) S SRLN=$O(^TMP("SRAR",$J,SRTN,""),-1) I SRLN D
.I ^TMP("SRAR",$J,SRTN,SRLN)'="" S SRLN=SRLN+1,^TMP("SRAR",$J,SRTN,SRLN)=""
.S SRLN=SRLN+1,^TMP("SRAR",$J,SRTN,SRLN)="Addendum Comment: "_$S($L(SRCOM)<63:SRCOM,1:"")
.I $L(SRCOM)>62 S SRLN=SRLN+1,^TMP("SRAR",$J,SRTN,SRLN)=SRCOM
S SRLN=$O(^TMP("SRADDEND",$J,SRTN,""),-1) I SRLN D
.I ^TMP("SRADDEND",$J,SRTN,SRLN)'="" S SRLN=SRLN+1,^TMP("SRADDEND",$J,SRTN,SRLN)=""
.S SRLN=SRLN+1,^TMP("SRADDEND",$J,SRTN,SRLN)="Addendum Comment: "_$S($L(SRCOM)<63:SRCOM,1:"")
.I $L(SRCOM)>62 S SRLN=SRLN+1,^TMP("SRADDEND",$J,SRTN,SRLN)=SRCOM
Q
GET ; gather data for modified fields for addendum display before signing
F SRS=1,2 F SRPRE="SRARAD","SRNRAD" S SRFLD="",SRSUB=SRPRE_SRS F S SRFLD=$O(^TMP(SRSUB,$J,SRTN,130,SRFLD)) Q:SRFLD="" D
.I SRFLD[";W" S SRLN="" D Q
..F S SRLN=$O(^TMP(SRSUB,$J,SRTN,130,SRFLD,SRLN)) Q:SRLN="" S ^TMP("SRAD"_SRS,$J,SRTN,130,SRFLD,SRLN)=^TMP(SRSUB,$J,SRTN,130,SRFLD,SRLN)
.S ^TMP("SRAD"_SRS,$J,SRTN,130,SRFLD)=^TMP(SRSUB,$J,SRTN,130,SRFLD)
F SRS=1,2 F SRPRE="SRARAD","SRNRAD" S SRMULT="A",SRSUB=SRPRE_SRS F S SRMULT=$O(^TMP(SRSUB,$J,SRTN,SRMULT)) Q:SRMULT="" S SRE="" D
.F S SRE=$O(^TMP(SRSUB,$J,SRTN,SRMULT,SRE)) Q:'SRE S SRE1="" F S SRE1=$O(^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1)) Q:SRE1="" S SRFLD="" F S SRFLD=$O(^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)) Q:SRFLD="" D
..I SRFLD[";W" S SRLN="" D Q
...F S SRLN=$O(^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)) Q:SRLN="" S ^TMP("SRAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)=^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)
..S ^TMP("SRAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)=^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)
F SRS=1,2 F SRPRE="SRARMULT","SRNRMULT" S SRMULT="A",SRSUB=SRPRE_SRS F S SRMULT=$O(^TMP(SRSUB,$J,SRTN,SRMULT)) Q:SRMULT="" S SRE="" D
.F S SRE=$O(^TMP(SRSUB,$J,SRTN,SRMULT,SRE)) Q:'SRE S SRE1="" F S SRE1=$O(^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1)) Q:SRE1="" S SRFLD="" F S SRFLD=$O(^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)) Q:SRFLD="" D
..I SRFLD[";W" S SRLN="" D Q
...F S SRLN=$O(^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)) Q:SRLN="" S ^TMP("SRADM"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)=^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)
..S ^TMP("SRADM"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)=^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)
Q
DISPLAY ; display addenda to nurse/anesthesia report(s)
S SRLN=0
D HDR F S SRLN=$O(^TMP("SRADDEND",$J,SRTN,SRLN)) Q:'SRLN D Q:SRESNOT
.I $Y+4>IOSL D PAGE Q:SRESNOT D HDR
.W !,^TMP("SRADDEND",$J,SRTN,SRLN)
D:'SRESNOT PAGE
Q
PAGE W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT) S SRESNOT=1 Q
I $D(DUOUT) D SURE
Q
SURE W ! S DIR("A",1)="No addendum will be created and the original data will be restored.",DIR("A")="Are you sure you want to exit",DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I Y!$D(DTOUT)!$D(DUOUT) S SRESNOT=1
Q
HDR ; header for addendum display
W @IOF,!,"Addendum for Case #"_SRTN_" - "_SRSDATE,!,"Patient: "_VADM(1)_" ("_VA("PID")_")",!
F I=1:1:80 W "-"
Q
POSTA(SRTN,SRSBN,SRNOW) ;post signed addendum to anesthesia report
N SRADD,SRAY,SRTIU,SRMSGS
S SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
F I=1:1 Q:'$D(^TMP("SRAR",$J,SRTN,I)) S SRAY("TEXT",I,0)=^TMP("SRAR",$J,SRTN,I)
S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",4) Q:'SRTIU
D MAKEADD^TIUSRVP(.SRADD,SRTIU,.SRAY,1) I +SRADD'>0 D Q
.S SRMSGS=$P($G(SRADD),U,2)
.W !!!!,SRMSGS
.D NOAD
.Q
S SRTIU=+SRADD K SRAY
D ES^TIUSROI(SRTIU,DUZ)
Q
POSTN(SRTN,SRSBN,SRNOW) ; post signed addendum
N SRADD,SRAY,SRTIU,SRMSGS
S SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
F I=1:1 Q:'$D(^TMP("SRNR",$J,SRTN,I)) S SRAY("TEXT",I,0)=^TMP("SRNR",$J,SRTN,I)
S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",2) Q:'SRTIU
D MAKEADD^TIUSRVP(.SRADD,SRTIU,.SRAY,1) I +SRADD'>0 D Q
.S SRMSGS=$P($G(SRADD),U,2)
.W !!!!,SRMSGS
.D NOAD
.Q
S SRTIU=+SRADD K SRAY
D ES^TIUSROI(SRTIU,DUZ)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROESAD 5663 printed Apr 09, 2024@21:49:52 Page 2
SROESAD ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 09/04/03 1:03 PM ]
+1 ;;3.0; Surgery ;**100,173**;24 Jun 93;Build 8
+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 MAKEADD^TIUSRVP supported by DBIA #3535
+8 ; Reference to ES^TIUSROI supported by DBIA #3537
+9 ;
+10 if '$DATA(SRNDOC(SRTN))&'$DATA(SRADOC(SRTN))
QUIT
DO DISPLAY
IF SRESNOT
DO NOAD
QUIT
ASK NEW SRSCOM
WRITE @IOF,!
SET DIR(0)="Y"
SET DIR("A")="Do you want to add a comment for this case"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
SET SRSCOM=Y
IF $DATA(DTOUT)
DO NOAD
QUIT
+1 IF $DATA(DUOUT)
DO SURE
IF 'SRESNOT
GOTO ASK
+2 IF SRESNOT
DO NOAD
QUIT
+3 IF 'SRSCOM
GOTO SIG
+4 IF SRSCOM
WRITE !!
SET DIR(0)="F^3:80"
SET DIR("A")="Comment"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET SRESNOT=1
QUIT
+5 IF X=""!$DATA(DUOUT)
GOTO SIG
+6 DO COM
REV2 ; display addendum with comment for 2nd review
+1 DO DISPLAY
IF SRESNOT
DO NOAD
QUIT
SIG ; enter e-sig
+1 NEW SRNOW,SRSBN,SRSIG
+2 DO SIG^XUSESIG
IF X1=""
DO NOAD
QUIT
+3 SET SRSBN=X1
SET SRNOW=$$NOW^XLFDT
+4 IF $DATA(SRNDOC(SRTN))
DO POSTN(SRTN,SRSBN,SRNOW)
IF SRESNOT=1
QUIT
+5 IF $DATA(SRADOC(SRTN))
DO POSTA(SRTN,SRSBN,SRNOW)
IF SRESNOT=1
QUIT
+6 WRITE !
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press RETURN to continue... "
DO ^DIR
KILL DIR
+7 QUIT
NOAD ; no addendum created
+1 WRITE !!,"No addendum created for case #"_SRTN_". Original data will be restored.",!!
SET SRESNOT=1
+2 QUIT
COM ; add comment to end of addendum
+1 NEW SRCOM
SET SRCOM=X
IF $DATA(SRNDOC(SRTN))
SET SRLN=$ORDER(^TMP("SRNR",$JOB,SRTN,""),-1)
IF SRLN
Begin DoDot:1
+2 IF ^TMP("SRNR",$JOB,SRTN,SRLN)'=""
SET SRLN=SRLN+1
SET ^TMP("SRNR",$JOB,SRTN,SRLN)=""
+3 SET SRLN=SRLN+1
SET ^TMP("SRNR",$JOB,SRTN,SRLN)="Addendum Comment: "_$SELECT($LENGTH(SRCOM)<63:SRCOM,1:"")
+4 IF $LENGTH(SRCOM)>62
SET SRLN=SRLN+1
SET ^TMP("SRNR",$JOB,SRTN,SRLN)=SRCOM
End DoDot:1
+5 IF $DATA(SRADOC(SRTN))
SET SRLN=$ORDER(^TMP("SRAR",$JOB,SRTN,""),-1)
IF SRLN
Begin DoDot:1
+6 IF ^TMP("SRAR",$JOB,SRTN,SRLN)'=""
SET SRLN=SRLN+1
SET ^TMP("SRAR",$JOB,SRTN,SRLN)=""
+7 SET SRLN=SRLN+1
SET ^TMP("SRAR",$JOB,SRTN,SRLN)="Addendum Comment: "_$SELECT($LENGTH(SRCOM)<63:SRCOM,1:"")
+8 IF $LENGTH(SRCOM)>62
SET SRLN=SRLN+1
SET ^TMP("SRAR",$JOB,SRTN,SRLN)=SRCOM
End DoDot:1
+9 SET SRLN=$ORDER(^TMP("SRADDEND",$JOB,SRTN,""),-1)
IF SRLN
Begin DoDot:1
+10 IF ^TMP("SRADDEND",$JOB,SRTN,SRLN)'=""
SET SRLN=SRLN+1
SET ^TMP("SRADDEND",$JOB,SRTN,SRLN)=""
+11 SET SRLN=SRLN+1
SET ^TMP("SRADDEND",$JOB,SRTN,SRLN)="Addendum Comment: "_$SELECT($LENGTH(SRCOM)<63:SRCOM,1:"")
+12 IF $LENGTH(SRCOM)>62
SET SRLN=SRLN+1
SET ^TMP("SRADDEND",$JOB,SRTN,SRLN)=SRCOM
End DoDot:1
+13 QUIT
GET ; gather data for modified fields for addendum display before signing
+1 FOR SRS=1,2
FOR SRPRE="SRARAD","SRNRAD"
SET SRFLD=""
SET SRSUB=SRPRE_SRS
FOR
SET SRFLD=$ORDER(^TMP(SRSUB,$JOB,SRTN,130,SRFLD))
if SRFLD=""
QUIT
Begin DoDot:1
+2 IF SRFLD[";W"
SET SRLN=""
Begin DoDot:2
+3 FOR
SET SRLN=$ORDER(^TMP(SRSUB,$JOB,SRTN,130,SRFLD,SRLN))
if SRLN=""
QUIT
SET ^TMP("SRAD"_SRS,$JOB,SRTN,130,SRFLD,SRLN)=^TMP(SRSUB,$JOB,SRTN,130,SRFLD,SRLN)
End DoDot:2
QUIT
+4 SET ^TMP("SRAD"_SRS,$JOB,SRTN,130,SRFLD)=^TMP(SRSUB,$JOB,SRTN,130,SRFLD)
End DoDot:1
+5 FOR SRS=1,2
FOR SRPRE="SRARAD","SRNRAD"
SET SRMULT="A"
SET SRSUB=SRPRE_SRS
FOR
SET SRMULT=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT))
if SRMULT=""
QUIT
SET SRE=""
Begin DoDot:1
+6 FOR
SET SRE=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE))
if 'SRE
QUIT
SET SRE1=""
FOR
SET SRE1=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1))
if SRE1=""
QUIT
SET SRFLD=""
FOR
SET SRFLD=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
if SRFLD=""
QUIT
Begin DoDot:2
+7 IF SRFLD[";W"
SET SRLN=""
Begin DoDot:3
+8 FOR
SET SRLN=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
if SRLN=""
QUIT
SET ^TMP("SRAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)=^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)
End DoDot:3
QUIT
+9 SET ^TMP("SRAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)=^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)
End DoDot:2
End DoDot:1
+10 FOR SRS=1,2
FOR SRPRE="SRARMULT","SRNRMULT"
SET SRMULT="A"
SET SRSUB=SRPRE_SRS
FOR
SET SRMULT=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT))
if SRMULT=""
QUIT
SET SRE=""
Begin DoDot:1
+11 FOR
SET SRE=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE))
if 'SRE
QUIT
SET SRE1=""
FOR
SET SRE1=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1))
if SRE1=""
QUIT
SET SRFLD=""
FOR
SET SRFLD=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
if SRFLD=""
QUIT
Begin DoDot:2
+12 IF SRFLD[";W"
SET SRLN=""
Begin DoDot:3
+13 FOR
SET SRLN=$ORDER(^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
if SRLN=""
QUIT
SET ^TMP("SRADM"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)=^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)
End DoDot:3
QUIT
+14 SET ^TMP("SRADM"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)=^TMP(SRSUB,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)
End DoDot:2
End DoDot:1
+15 QUIT
DISPLAY ; display addenda to nurse/anesthesia report(s)
+1 SET SRLN=0
+2 DO HDR
FOR
SET SRLN=$ORDER(^TMP("SRADDEND",$JOB,SRTN,SRLN))
if 'SRLN
QUIT
Begin DoDot:1
+3 IF $Y+4>IOSL
DO PAGE
if SRESNOT
QUIT
DO HDR
+4 WRITE !,^TMP("SRADDEND",$JOB,SRTN,SRLN)
End DoDot:1
if SRESNOT
QUIT
+5 if 'SRESNOT
DO PAGE
+6 QUIT
PAGE WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET SRESNOT=1
QUIT
+1 IF $DATA(DUOUT)
DO SURE
+2 QUIT
SURE WRITE !
SET DIR("A",1)="No addendum will be created and the original data will be restored."
SET DIR("A")="Are you sure you want to exit"
SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
IF Y!$DATA(DTOUT)!$DATA(DUOUT)
SET SRESNOT=1
+1 QUIT
HDR ; header for addendum display
+1 WRITE @IOF,!,"Addendum for Case #"_SRTN_" - "_SRSDATE,!,"Patient: "_VADM(1)_" ("_VA("PID")_")",!
+2 FOR I=1:1:80
WRITE "-"
+3 QUIT
POSTA(SRTN,SRSBN,SRNOW) ;post signed addendum to anesthesia report
+1 NEW SRADD,SRAY,SRTIU,SRMSGS
+2 SET SRAY(1405)=SRTN_";SRF("
SET SRAY(1701)="Case #: "_SRTN
+3 FOR I=1:1
if '$DATA(^TMP("SRAR",$JOB,SRTN,I))
QUIT
SET SRAY("TEXT",I,0)=^TMP("SRAR",$JOB,SRTN,I)
+4 SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",4)
if 'SRTIU
QUIT
+5 DO MAKEADD^TIUSRVP(.SRADD,SRTIU,.SRAY,1)
IF +SRADD'>0
Begin DoDot:1
+6 SET SRMSGS=$PIECE($GET(SRADD),U,2)
+7 WRITE !!!!,SRMSGS
+8 DO NOAD
+9 QUIT
End DoDot:1
QUIT
+10 SET SRTIU=+SRADD
KILL SRAY
+11 DO ES^TIUSROI(SRTIU,DUZ)
+12 QUIT
POSTN(SRTN,SRSBN,SRNOW) ; post signed addendum
+1 NEW SRADD,SRAY,SRTIU,SRMSGS
+2 SET SRAY(1405)=SRTN_";SRF("
SET SRAY(1701)="Case #: "_SRTN
+3 FOR I=1:1
if '$DATA(^TMP("SRNR",$JOB,SRTN,I))
QUIT
SET SRAY("TEXT",I,0)=^TMP("SRNR",$JOB,SRTN,I)
+4 SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",2)
if 'SRTIU
QUIT
+5 DO MAKEADD^TIUSRVP(.SRADD,SRTIU,.SRAY,1)
IF +SRADD'>0
Begin DoDot:1
+6 SET SRMSGS=$PIECE($GET(SRADD),U,2)
+7 WRITE !!!!,SRMSGS
+8 DO NOAD
+9 QUIT
End DoDot:1
QUIT
+10 SET SRTIU=+SRADD
KILL SRAY
+11 DO ES^TIUSROI(SRTIU,DUZ)
+12 QUIT
