Index: WorldVistAEHR/trunk/r/SURGERY-SR/SROESPR1.m
===================================================================
--- WorldVistAEHR/trunk/r/SURGERY-SR/SROESPR1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/SURGERY-SR/SROESPR1.m	(revision 623)
@@ -1,189 +1,188 @@
-SROESPR1	;BIR/ADM - SURGERY E-SIG UTILITY ; [ 04/21/04  12:08 PM ]
-	;;3.0; Surgery ;**100,128,162**;24 Jun 93;Build 4
-	;
-	;** 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
-	;
-	; This routine was cloned in part or in whole from TIUPRPN1.
-PRINT(SRFLAG,SRSPG)	; Print Summary
-	; ^TMP("SRPR",$J) is array of records passed by reference
-	; SRFLAG=1 --> Chart Copy     SRSPG=1 --> Contiguous
-	; SRFLAG=0 --> Work Copy      SRSPG=0 --> Fresh Page- each note
-	N SRI,SRJ,SRPAGE,SRFOOT,SRK,SRDA,SRCONT,SRPGRP,SRTYP
-	N SRPFHDR,SRPFNBR,SROPAGE
-	S SRFLAG=+$G(SRFLAG),SRSPG=+$G(SRSPG)
-	S SRI=0 F  S SRI=$O(^TMP("SRPR",$J,SRI)) Q:SRI=""  D  Q:'SRCONT
-	. N DFN,SR,SRERR
-	. I SRI["$" S SRPGRP=$P(SRI,"$"),SRPFHDR=$P($P(SRI,";"),"$",2)
-	. E  S SRPFHDR="Surgery Reports"
-	. I $G(SRPGRP)'=2 S SRSPG=0
-	. S DFN=$P(SRI,";",2)
-	. D PAT^SROESPR(.SRFOOT,DFN)
-	. I +$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR)
-	. S SRJ=0 F  S SRJ=$O(^TMP("SRPR",$J,SRI,SRJ)) Q:'SRJ  D  Q:'SRCONT
-	. . S SRK=0 F  S SRK=$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) Q:'SRK  D  Q:'+$G(SRCONT)
-	. . . N SRERR1,SRW K SRCONT1 S SRPFNBR=^(SRK)
-	. . . ; If the document has been deleted, QUIT
-	. . . D EXTRACT^TIULQ(SRK,"SRW",.SRERR1,".01") I $P($G(SRERR1),"^")=1 S SRCONT=1 Q
-	. . . I '+$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR)
-	. . . S SRDA=SRK
-	. . . D REPORT(SRDA) Q:'+$G(SRCONT)
-	. . . I '+$G(SRSPG) K SRCONT1 D SETCONT(1)
-	. . . I $E(IOST)="C",'$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) S SRCONT=0
-	. Q:'SRCONT  I $E(IOST)="C" S SRCONT=$$STOP^SROESPR2() Q:'SRCONT
-	. I +$G(SRSPG),$E(IOST)'="C" K SRCONT1 D SETCONT(1)
-	Q
-REPORT(SRDA)	; Report Text
-	N DIW,DIWF,DIWL,DIWR,DIWT,SRERR,SR,SRI,SRLINE,X,Z,SRY,LOC
-	K ^TMP("SRLQ",$J)
-	S SRLINE=0
-	D EXTRACT^TIULQ(+SRDA,"^TMP(""SRLQ"",$J)",.SRERR,"",SRLINE,1)
-	I +$G(SRERR) W !,$P(SRERR,U,2) Q
-	Q:'$D(^TMP("SRLQ",$J))
-	S SRY=4,SRCONT=1
-	D SETCONT() Q:'SRCONT
-	W "NOTE DATED: "
-	W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN")
-	W ?30,$$UP^XLFSTR(^TMP("SRLQ",$J,SRDA,.01,"E")),!
-	I +$G(^TMP("SRLQ",$J,SRDA,1205,"I")) D
-	.S LOC=$G(^TMP("SRLQ",$J,SRDA,1205,"I")) Q:'$D(^SC(LOC,0))
-	.W $S($P(^SC(LOC,0),U,3)="W":"ADMITTED: ",1:"VISIT: ")
-	.W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,.07,"I"),"MM/DD/CCYY HR:MIN")
-	.W " ",$G(^TMP("SRLQ",$J,SRDA,1205,"E"))
-	I ^TMP("SRLQ",$J,SRDA,1701,"E")]"" W !,"SUBJECT: ",^("E"),!
-	S SRCONT1=1
-	I $D(^TMP("SRLQ",$J,SRDA,"PROBLEM")) D  Q:'SRCONT
-	.D SETCONT() Q:'SRCONT
-	.W !,"ASSOCIATED PROBLEMS:"
-	.N SRI S SRI=0
-	.F  S SRI=$O(^TMP("SRLQ",$J,SRDA,"PROBLEM",SRI)) Q:'SRI  D  Q:'SRCONT
-	..W !,^(SRI,0)
-	..D SETCONT() Q:'SRCONT
-	W !
-	;
-	S SRI=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W")
-	F  S SRI=$O(^TMP("SRLQ",$J,SRDA,"TEXT",SRI)) Q:SRI'>0  D  Q:'SRCONT  ; D ^DIWW
-	. D SETCONT() Q:'SRCONT
-	. S X=^TMP("SRLQ",$J,SRDA,"TEXT",SRI,0) S:X="" X=" " D ^DIWP
-	D ^DIWW K ^UTILITY($J,"W")
-	Q:'SRCONT
-RPTSIG	; Signature should be on bottom of form, Addenda on Subsequent pages
-	N AUTHOR,EXPSIGNR,EXPCOSNR,SIGNDATE,SIGNEDBY,SIGNNAME,SIGTITL,SIGNMODE
-	N COSGDATE,COSGEDBY,COSGNAME,COSGTITL,COSGMODE,SIGCHRT,COSCHRT,SRLINE
-	S $P(SRLINE,"-",81)=""
-	S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,1202,"I"))_";"_$G(^("E"))
-	S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,1204,"I"))_";"_$G(^("E"))
-	S EXPCOSNR=$G(^TMP("SRLQ",$J,SRDA,1208,"I"))_";"_$G(^("E"))
-	S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,1501,"I"))
-	S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,1502,"I"))_";"_$G(^("E"))
-	S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,1503,"E"))
-	S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,1504,"E"))
-	S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,1505,"I"))_";"_$G(^("E"))
-	S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,1507,"I"))
-	S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,1508,"I"))_";"_$G(^("E"))
-	S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,1509,"E"))
-	S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,1510,"E"))
-	S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,1511,"I"))_";"_$G(^("E"))
-	S SIGCHRT=$G(^TMP("SRLQ",$J,SRDA,1512,"I"))_";"_$G(^("E"))
-	S COSCHRT=$G(^TMP("SRLQ",$J,SRDA,1513,"I"))_";"_$G(^("E"))
-	D SETCONT() Q:'SRCONT  W !
-	D SIGBLK Q:'SRCONT
-ADDENDA	; Surgery Reports Addenda
-	N DIW,DIWF,DIWL,DIWR,DIWT,X,Z,SRI,SRADD
-	S SRADD=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W")
-	F  S SRADD=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD)) Q:SRADD'>0  D  Q:'SRCONT
-	. S SRY=4 D SETCONT() Q:'SRCONT
-	. W !!,$$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"ADDENDUM"
-	. W ?41,"STATUS: ",^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,.05,"E")
-	. S SRI=0
-	. F  S SRI=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI)) Q:SRI'>0  D  Q:'SRCONT
-	. . D SETCONT() Q:'SRCONT
-	. . S X=^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI,0) S:X="" X=" " D ^DIWP
-	. D ^DIWW
-	. D:SRCONT ADDENSIG
-	K ^UTILITY($J,"W")
-	; Write 2 linefeeds between records
-	Q:'SRCONT  W !!
-	Q
-ADDENSIG	;
-	N AUTHOR,EXPSIGNR,ATTNDING,SIGNDATE,SIGNEDBY,SIGNNAME,SIGNMODE
-	N COSGDATE,COSGEDBY,COSGNAME,COSGMODE,SRLINE S $P(SRLINE,"-",80)=""
-	S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1202,"I"))_";"_$G(^("E"))
-	S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1204,"I"))_";"_$G(^("E"))
-	S ATTNDING=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1209,"I"))_";"_$G(^("E"))
-	S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1501,"I"))
-	S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1502,"I"))_";"_$G(^("E"))
-	S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1503,"E"))
-	S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1504,"E"))
-	S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1505,"I"))_";"_$G(^("E"))
-	S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1507,"I"))
-	S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1508,"I"))_";"_$G(^("E"))
-	S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1509,"E"))
-	S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1510,"E"))
-	S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1511,"I"))_";"_$G(^("E"))
-	S SRY=11
-SIGBLK	N SRGROOT S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA))
-	I '+SIGNDATE D  D SETCONT() Q:'SRCONT
-	.I $$STATUS^SROESUTL(SRDA)'=7 W !,"**DRAFT COPY - DRAFT COPY -- ABOVE NOTE IS UNSIGNED-- DRAFT COPY - DRAFT COPY**"
-	I SIGNEDBY]"",(+SIGNEDBY'=+AUTHOR)  D
-	. W ?21,"Author:      ",$P(AUTHOR,";",2),!
-	I +SIGNDATE D SETCONT() Q:'SRCONT  D
-	. W ?18,"Signed by:",$S($P(SIGNMODE,";")="C":" /s/  ",1:" /es/ "),?34,$S(SIGNNAME]"":SIGNNAME,1:$P(SIGNEDBY,";",2))
-	. W !?34,SIGTITL
-	. I $L(SIGTITL)>30 W !?34
-	. E  W " "
-	. W $$DATE^SROESPR(+SIGNDATE,"MM/DD/CCYY HR:MIN")
-	. I '+$G(SRFLAG)!($E(IOST)="C") D
-	. . I $P($$BEEP^SROESPR(+SIGNEDBY),U) W !?34,"Analog Pager:  ",$P($$BEEP^SROESPR(+SIGNEDBY),U)
-	. . I $P($$BEEP^SROESPR(+SIGNEDBY),U,2) W !?34,"Digital Pager: ",$P($$BEEP^SROESPR(+SIGNEDBY),U,2)
-	I $G(^TMP("SRLQ",$J,SRDA,.05,"E"))="UNCOSIGNED" D
-	. W !?34,"**REQUIRES COSIGNATURE**",!
-	I +SIGCHRT,$P(SIGNMODE,";")="C" D SETCONT() Q:'SRCONT  D
-	. W !?2,"Marked signed on chart by:",?34,$P(SIGCHRT,";",2)
-	I +$G(SRADD) S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD))
-	I +$D(@SRGROOT@("EXTRASGNR")) D
-	. N SRI S SRI=0
-	. D SETCONT() Q:'SRCONT  W !?4,"Receipt Acknowledged By:"
-	. F  S SRI=$O(@SRGROOT@("EXTRASGNR",SRI)) Q:'SRI  D
-	. . I +$G(@SRGROOT@("EXTRASGNR",SRI,"DATE"))'>0 Q
-	. . I SRI>1 D SETCONT() Q:'SRCONT  W !
-	. . W ?29,"/es/ ",$G(@SRGROOT@("EXTRASGNR",SRI,"NAME"))
-	. . W !?34,$G(@SRGROOT@("EXTRASGNR",SRI,"TITLE"))
-	. . I $L($G(@SRGROOT@("EXTRASGNR",SRI,"TITLE")))>30 W !?34
-	. . E  W " "
-	. . W $$DATE^SROESPR($G(@SRGROOT@("EXTRASGNR",SRI,"DATE")),"MM/DD/CCYY HR:MIN")
-	. . I '+$G(SRFLAG)!($E(IOST)="C") D
-	. . . N BEEP
-	. . . S BEEP=$$BEEP^SROESPR(+$G(@SRGROOT@("EXTRASGNR",SRI,"EXTRA")))
-	. . . I +BEEP W !?34,"Analog Pager:  ",$P(BEEP,U)
-	. . . I +$P(BEEP,U,2) W !?34,"Digital Pager: ",$P(BEEP,U,2)
-	. K @SRGROOT@("EXTRASGNR")
-	I +COSGDATE,(+COSGEDBY'=+SIGNEDBY) D SETCONT() Q:'SRCONT  D
-	. W !?16,"Cosigned by:",$S($P(COSGMODE,";")="C":" /s/  ",1:" /es/ "),?34,$S(COSGNAME]"":COSGNAME,1:$P(COSGEDBY,";",2))
-	. W !?34,COSGTITL," "
-	. W $$DATE^SROESPR(+COSGDATE,"MM/DD/CCYY HR:MIN")
-	. I '+$G(SRFLAG)!($E(IOST)="C") D
-	. . I $P($$BEEP^SROESPR(+COSGEDBY),U) W !?34,"Analog Pager: ",$P($$BEEP^SROESPR(+COSGEDBY),U)
-	. . I $P($$BEEP^SROESPR(+COSGEDBY),U,2) W !?34,"Digital Pager:",$P($$BEEP^SROESPR(+COSGEDBY),U,2)
-	I +COSCHRT,$P(COSGMODE,";")="C" D SETCONT() Q:'SRCONT  D
-	. W !,"Marked cosigned on chart by:",?34,$P(COSCHRT,";",2)
-	W !
-	K SRCONT1
-AMEND	; signature blocks of amender
-	S SRY=4 D SETCONT() Q:'SRCONT
-	I +$G(@SRGROOT@(1601,"I")) D
-	. W !!?12,"Amendment Filed:",?34,$$DATE^SROESPR(@SRGROOT@(1601,"I"),"MM/DD/CCYY HR:MIN")
-	. I $G(@SRGROOT@(1603,"E"))']"" D
-	. . W !!?29 F SRI=1:1:40 W "_"
-	. . W !?29,$$SIGNAME^SROESPR(@SRGROOT@(1602,"I"))
-	. . W !?29,$$SIGTITL^SROESPR(@SRGROOT@(1602,"I"))
-	. I $G(@SRGROOT@(1604,"E"))]"" D
-	. . W !?29,"/es/",?34,@SRGROOT@(1604,"E")
-	. . W !?34,@SRGROOT@(1605,"E")
-	Q
-SETCONT(SRHEAD)	;Does footer and sets SRCONT
-	S SRCONT=$$FOOTER^SROESPR2(.SRFOOT,SRFLAG,SRPFNBR,$G(SRHEAD),$G(SRCONT1),SRDA)
-	Q
+SROESPR1 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 04/21/04  12:08 PM ]
+ ;;3.0; Surgery ;**100,128**;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 EXTRACT^TIULQ supported by DBIA #2693
+ ;
+ ; This routine was cloned in part or in whole from TIUPRPN1.
+PRINT(SRFLAG,SRSPG) ; Print Summary
+ ; ^TMP("SRPR",$J) is array of records passed by reference
+ ; SRFLAG=1 --> Chart Copy     SRSPG=1 --> Contiguous
+ ; SRFLAG=0 --> Work Copy      SRSPG=0 --> Fresh Page- each note
+ N SRI,SRJ,SRPAGE,SRFOOT,SRK,SRDA,SRCONT,SRPGRP,SRTYP
+ N SRPFHDR,SRPFNBR,SROPAGE
+ S SRFLAG=+$G(SRFLAG),SRSPG=+$G(SRSPG)
+ S SRI=0 F  S SRI=$O(^TMP("SRPR",$J,SRI)) Q:SRI=""  D  Q:'SRCONT
+ . N DFN,SR,SRERR
+ . I SRI["$" S SRPGRP=$P(SRI,"$"),SRPFHDR=$P($P(SRI,";"),"$",2)
+ . E  S SRPFHDR="Surgery Reports"
+ . I $G(SRPGRP)'=2 S SRSPG=0
+ . S DFN=$P(SRI,";",2)
+ . D PAT^SROESPR(.SRFOOT,DFN)
+ . I +$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR)
+ . S SRJ=0 F  S SRJ=$O(^TMP("SRPR",$J,SRI,SRJ)) Q:'SRJ  D  Q:'SRCONT
+ . . S SRK=0 F  S SRK=$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) Q:'SRK  D  Q:'+$G(SRCONT)
+ . . . N SRERR1,SRW K SRCONT1 S SRPFNBR=^(SRK)
+ . . . ; If the document has been deleted, QUIT
+ . . . D EXTRACT^TIULQ(SRK,"SRW",.SRERR1,".01") I $P($G(SRERR1),"^")=1 S SRCONT=1 Q
+ . . . I '+$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR)
+ . . . S SRDA=SRK
+ . . . D REPORT(SRDA) Q:'+$G(SRCONT)
+ . . . I '+$G(SRSPG) K SRCONT1 D SETCONT(1)
+ . . . I $E(IOST)="C",'$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) S SRCONT=0
+ . Q:'SRCONT  I $E(IOST)="C" S SRCONT=$$STOP^SROESPR2() Q:'SRCONT
+ . I +$G(SRSPG),$E(IOST)'="C" K SRCONT1 D SETCONT(1)
+ Q
+REPORT(SRDA) ; Report Text
+ N DIW,DIWF,DIWL,DIWR,DIWT,SRERR,SR,SRI,SRLINE,X,Z,SRY,LOC
+ K ^TMP("SRLQ",$J)
+ S SRLINE=0
+ D EXTRACT^TIULQ(+SRDA,"^TMP(""SRLQ"",$J)",.SRERR,"",SRLINE,1)
+ I +$G(SRERR) W !,$P(SRERR,U,2) Q
+ Q:'$D(^TMP("SRLQ",$J))
+ S SRY=4,SRCONT=1
+ D SETCONT() Q:'SRCONT
+ W "NOTE DATED: "
+ W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN")
+ W ?30,$$UP^XLFSTR(^TMP("SRLQ",$J,SRDA,.01,"E")),!
+ I +$G(^TMP("SRLQ",$J,SRDA,1205,"I")) D
+ .S LOC=$G(^TMP("SRLQ",$J,SRDA,1205,"I")) Q:'$D(^SC(LOC,0))
+ .W $S($P(^SC(LOC,0),U,3)="W":"ADMITTED: ",1:"VISIT: ")
+ .W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,.07,"I"),"MM/DD/CCYY HR:MIN")
+ .W " ",$G(^TMP("SRLQ",$J,SRDA,1205,"E"))
+ I ^TMP("SRLQ",$J,SRDA,1701,"E")]"" W !,"SUBJECT: ",^("E"),!
+ S SRCONT1=1
+ I $D(^TMP("SRLQ",$J,SRDA,"PROBLEM")) D  Q:'SRCONT
+ .D SETCONT() Q:'SRCONT
+ .W !,"ASSOCIATED PROBLEMS:"
+ .N SRI S SRI=0
+ .F  S SRI=$O(^TMP("SRLQ",$J,SRDA,"PROBLEM",SRI)) Q:'SRI  D  Q:'SRCONT
+ ..W !,^(SRI,0)
+ ..D SETCONT() Q:'SRCONT
+ W !
+ ;
+ S SRI=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W")
+ F  S SRI=$O(^TMP("SRLQ",$J,SRDA,"TEXT",SRI)) Q:SRI'>0  D  Q:'SRCONT  ; D ^DIWW
+ . D SETCONT() Q:'SRCONT
+ . S X=^TMP("SRLQ",$J,SRDA,"TEXT",SRI,0) S:X="" X=" " D ^DIWP
+ D ^DIWW K ^UTILITY($J,"W")
+ Q:'SRCONT
+RPTSIG ; Signature should be on bottom of form, Addenda on Subsequent pages
+ N AUTHOR,EXPSIGNR,EXPCOSNR,SIGNDATE,SIGNEDBY,SIGNNAME,SIGTITL,SIGNMODE
+ N COSGDATE,COSGEDBY,COSGNAME,COSGTITL,COSGMODE,SIGCHRT,COSCHRT,SRLINE
+ S $P(SRLINE,"-",81)=""
+ S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,1202,"I"))_";"_$G(^("E"))
+ S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,1204,"I"))_";"_$G(^("E"))
+ S EXPCOSNR=$G(^TMP("SRLQ",$J,SRDA,1208,"I"))_";"_$G(^("E"))
+ S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,1501,"I"))
+ S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,1502,"I"))_";"_$G(^("E"))
+ S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,1503,"E"))
+ S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,1504,"E"))
+ S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,1505,"I"))_";"_$G(^("E"))
+ S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,1507,"I"))
+ S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,1508,"I"))_";"_$G(^("E"))
+ S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,1509,"E"))
+ S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,1510,"E"))
+ S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,1511,"I"))_";"_$G(^("E"))
+ S SIGCHRT=$G(^TMP("SRLQ",$J,SRDA,1512,"I"))_";"_$G(^("E"))
+ S COSCHRT=$G(^TMP("SRLQ",$J,SRDA,1513,"I"))_";"_$G(^("E"))
+ D SETCONT() Q:'SRCONT  W !
+ D SIGBLK Q:'SRCONT
+ADDENDA ; Surgery Reports Addenda
+ N DIW,DIWF,DIWL,DIWR,DIWT,X,Z,SRI,SRADD
+ S SRADD=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W")
+ F  S SRADD=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD)) Q:SRADD'>0  D  Q:'SRCONT
+ . S SRY=4 D SETCONT() Q:'SRCONT
+ . W !!,$$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"ADDENDUM"
+ . S SRI=0
+ . F  S SRI=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI)) Q:SRI'>0  D  Q:'SRCONT
+ . . D SETCONT() Q:'SRCONT
+ . . S X=^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI,0) S:X="" X=" " D ^DIWP
+ . D ^DIWW
+ . D:SRCONT ADDENSIG
+ K ^UTILITY($J,"W")
+ ; Write 2 linefeeds between records
+ Q:'SRCONT  W !!
+ Q
+ADDENSIG ;
+ N AUTHOR,EXPSIGNR,ATTNDING,SIGNDATE,SIGNEDBY,SIGNNAME,SIGNMODE
+ N COSGDATE,COSGEDBY,COSGNAME,COSGMODE,SRLINE S $P(SRLINE,"-",80)=""
+ S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1202,"I"))_";"_$G(^("E"))
+ S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1204,"I"))_";"_$G(^("E"))
+ S ATTNDING=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1209,"I"))_";"_$G(^("E"))
+ S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1501,"I"))
+ S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1502,"I"))_";"_$G(^("E"))
+ S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1503,"E"))
+ S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1504,"E"))
+ S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1505,"I"))_";"_$G(^("E"))
+ S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1507,"I"))
+ S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1508,"I"))_";"_$G(^("E"))
+ S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1509,"E"))
+ S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1510,"E"))
+ S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1511,"I"))_";"_$G(^("E"))
+ S SRY=11
+SIGBLK N SRGROOT S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA))
+ I '+SIGNDATE D  D SETCONT() Q:'SRCONT
+ .I $$STATUS^SROESUTL(SRDA)'=7 W !,"**DRAFT COPY - DRAFT COPY -- ABOVE NOTE IS UNSIGNED-- DRAFT COPY - DRAFT COPY**"
+ I SIGNEDBY]"",(+SIGNEDBY'=+AUTHOR)  D
+ . W ?21,"Author:      ",$P(AUTHOR,";",2),!
+ I +SIGNDATE D SETCONT() Q:'SRCONT  D
+ . W ?18,"Signed by:",$S($P(SIGNMODE,";")="C":" /s/  ",1:" /es/ "),?34,$S(SIGNNAME]"":SIGNNAME,1:$P(SIGNEDBY,";",2))
+ . W !?34,SIGTITL
+ . I $L(SIGTITL)>30 W !?34
+ . E  W " "
+ . W $$DATE^SROESPR(+SIGNDATE,"MM/DD/CCYY HR:MIN")
+ . I '+$G(SRFLAG)!($E(IOST)="C") D
+ . . I $P($$BEEP^SROESPR(+SIGNEDBY),U) W !?34,"Analog Pager:  ",$P($$BEEP^SROESPR(+SIGNEDBY),U)
+ . . I $P($$BEEP^SROESPR(+SIGNEDBY),U,2) W !?34,"Digital Pager: ",$P($$BEEP^SROESPR(+SIGNEDBY),U,2)
+ I $G(^TMP("SRLQ",$J,SRDA,.05,"E"))="UNCOSIGNED" D
+ . W !?34,"**REQUIRES COSIGNATURE**",!
+ I +SIGCHRT,$P(SIGNMODE,";")="C" D SETCONT() Q:'SRCONT  D
+ . W !?2,"Marked signed on chart by:",?34,$P(SIGCHRT,";",2)
+ I +$G(SRADD) S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD))
+ I +$D(@SRGROOT@("EXTRASGNR")) D
+ . N SRI S SRI=0
+ . D SETCONT() Q:'SRCONT  W !?4,"Receipt Acknowledged By:"
+ . F  S SRI=$O(@SRGROOT@("EXTRASGNR",SRI)) Q:'SRI  D
+ . . I +$G(@SRGROOT@("EXTRASGNR",SRI,"DATE"))'>0 Q
+ . . I SRI>1 D SETCONT() Q:'SRCONT  W !
+ . . W ?29,"/es/ ",$G(@SRGROOT@("EXTRASGNR",SRI,"NAME"))
+ . . W !?34,$G(@SRGROOT@("EXTRASGNR",SRI,"TITLE"))
+ . . I $L($G(@SRGROOT@("EXTRASGNR",SRI,"TITLE")))>30 W !?34
+ . . E  W " "
+ . . W $$DATE^SROESPR($G(@SRGROOT@("EXTRASGNR",SRI,"DATE")),"MM/DD/CCYY HR:MIN")
+ . . I '+$G(SRFLAG)!($E(IOST)="C") D
+ . . . N BEEP
+ . . . S BEEP=$$BEEP^SROESPR(+$G(@SRGROOT@("EXTRASGNR",SRI,"EXTRA")))
+ . . . I +BEEP W !?34,"Analog Pager:  ",$P(BEEP,U)
+ . . . I +$P(BEEP,U,2) W !?34,"Digital Pager: ",$P(BEEP,U,2)
+ . K @SRGROOT@("EXTRASGNR")
+ I +COSGDATE,(+COSGEDBY'=+SIGNEDBY) D SETCONT() Q:'SRCONT  D
+ . W !?16,"Cosigned by:",$S($P(COSGMODE,";")="C":" /s/  ",1:" /es/ "),?34,$S(COSGNAME]"":COSGNAME,1:$P(COSGEDBY,";",2))
+ . W !?34,COSGTITL," "
+ . W $$DATE^SROESPR(+COSGDATE,"MM/DD/CCYY HR:MIN")
+ . I '+$G(SRFLAG)!($E(IOST)="C") D
+ . . I $P($$BEEP^SROESPR(+COSGEDBY),U) W !?34,"Analog Pager: ",$P($$BEEP^SROESPR(+COSGEDBY),U)
+ . . I $P($$BEEP^SROESPR(+COSGEDBY),U,2) W !?34,"Digital Pager:",$P($$BEEP^SROESPR(+COSGEDBY),U,2)
+ I +COSCHRT,$P(COSGMODE,";")="C" D SETCONT() Q:'SRCONT  D
+ . W !,"Marked cosigned on chart by:",?34,$P(COSCHRT,";",2)
+ W !
+ K SRCONT1
+AMEND ; signature blocks of amender
+ S SRY=4 D SETCONT() Q:'SRCONT
+ I +$G(@SRGROOT@(1601,"I")) D
+ . W !!?12,"Amendment Filed:",?34,$$DATE^SROESPR(@SRGROOT@(1601,"I"),"MM/DD/CCYY HR:MIN")
+ . I $G(@SRGROOT@(1603,"E"))']"" D
+ . . W !!?29 F SRI=1:1:40 W "_"
+ . . W !?29,$$SIGNAME^SROESPR(@SRGROOT@(1602,"I"))
+ . . W !?29,$$SIGTITL^SROESPR(@SRGROOT@(1602,"I"))
+ . I $G(@SRGROOT@(1604,"E"))]"" D
+ . . W !?29,"/es/",?34,@SRGROOT@(1604,"E")
+ . . W !?34,@SRGROOT@(1605,"E")
+ Q
+SETCONT(SRHEAD) ;Does footer and sets SRCONT
+ S SRCONT=$$FOOTER^SROESPR2(.SRFOOT,SRFLAG,SRPFNBR,$G(SRHEAD),$G(SRCONT1),SRDA)
+ Q
