- SROESAD ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 09/04/03 1:03 PM ]
- ;;3.0; Surgery ;**100**;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 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 $D(SRADOC(SRTN)) D POSTA(SRTN,SRSBN,SRNOW)
- 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
- 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) Q:'+SRADD
- S SRTIU=+SRADD K SRAY
- D ES^TIUSROI(SRTIU,DUZ)
- Q
- POSTN(SRTN,SRSBN,SRNOW) ; post signed addendum
- N SRADD,SRAY,SRTIU
- 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) Q:'+SRADD
- S SRTIU=+SRADD K SRAY
- D ES^TIUSROI(SRTIU,DUZ)
- Q
- SROESAD ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 09/04/03 1:03 PM ]
- +1 ;;3.0; Surgery ;**100**;24 Jun 93
- +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)
- +5 IF $DATA(SRADOC(SRTN))
- DO POSTA(SRTN,SRSBN,SRNOW)
- +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
- +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
- QUIT
- +6 SET SRTIU=+SRADD
- KILL SRAY
- +7 DO ES^TIUSROI(SRTIU,DUZ)
- +8 QUIT
- POSTN(SRTN,SRSBN,SRNOW) ; post signed addendum
- +1 NEW SRADD,SRAY,SRTIU
- +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
- QUIT
- +6 SET SRTIU=+SRADD
- KILL SRAY
- +7 DO ES^TIUSROI(SRTIU,DUZ)
- +8 QUIT
