Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROESPR1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROESPR1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROESPR1.m
r613 r623 1 SROESPR1 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 04/21/04 12:08 PM ] 2 ;;3.0; Surgery ;**100,128,162**;24 Jun 93;Build 4 3 ; 4 ;** NOTICE: This routine is part of an implementation of a nationally 5 ;** controlled procedure. Local modifications to this routine 6 ;** are prohibited. 7 ; 8 ; Reference to EXTRACT^TIULQ supported by DBIA #2693 9 ; 10 ; This routine was cloned in part or in whole from TIUPRPN1. 11 PRINT(SRFLAG,SRSPG) ; Print Summary 12 ; ^TMP("SRPR",$J) is array of records passed by reference 13 ; SRFLAG=1 --> Chart Copy SRSPG=1 --> Contiguous 14 ; SRFLAG=0 --> Work Copy SRSPG=0 --> Fresh Page- each note 15 N SRI,SRJ,SRPAGE,SRFOOT,SRK,SRDA,SRCONT,SRPGRP,SRTYP 16 N SRPFHDR,SRPFNBR,SROPAGE 17 S SRFLAG=+$G(SRFLAG),SRSPG=+$G(SRSPG) 18 S SRI=0 F S SRI=$O(^TMP("SRPR",$J,SRI)) Q:SRI="" D Q:'SRCONT 19 . N DFN,SR,SRERR 20 . I SRI["$" S SRPGRP=$P(SRI,"$"),SRPFHDR=$P($P(SRI,";"),"$",2) 21 . E S SRPFHDR="Surgery Reports" 22 . I $G(SRPGRP)'=2 S SRSPG=0 23 . S DFN=$P(SRI,";",2) 24 . D PAT^SROESPR(.SRFOOT,DFN) 25 . I +$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR) 26 . S SRJ=0 F S SRJ=$O(^TMP("SRPR",$J,SRI,SRJ)) Q:'SRJ D Q:'SRCONT 27 . . S SRK=0 F S SRK=$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) Q:'SRK D Q:'+$G(SRCONT) 28 . . . N SRERR1,SRW K SRCONT1 S SRPFNBR=^(SRK) 29 . . . ; If the document has been deleted, QUIT 30 . . . D EXTRACT^TIULQ(SRK,"SRW",.SRERR1,".01") I $P($G(SRERR1),"^")=1 S SRCONT=1 Q 31 . . . I '+$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR) 32 . . . S SRDA=SRK 33 . . . D REPORT(SRDA) Q:'+$G(SRCONT) 34 . . . I '+$G(SRSPG) K SRCONT1 D SETCONT(1) 35 . . . I $E(IOST)="C",'$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) S SRCONT=0 36 . Q:'SRCONT I $E(IOST)="C" S SRCONT=$$STOP^SROESPR2() Q:'SRCONT 37 . I +$G(SRSPG),$E(IOST)'="C" K SRCONT1 D SETCONT(1) 38 Q 39 REPORT(SRDA) ; Report Text 40 N DIW,DIWF,DIWL,DIWR,DIWT,SRERR,SR,SRI,SRLINE,X,Z,SRY,LOC 41 K ^TMP("SRLQ",$J) 42 S SRLINE=0 43 D EXTRACT^TIULQ(+SRDA,"^TMP(""SRLQ"",$J)",.SRERR,"",SRLINE,1) 44 I +$G(SRERR) W !,$P(SRERR,U,2) Q 45 Q:'$D(^TMP("SRLQ",$J)) 46 S SRY=4,SRCONT=1 47 D SETCONT() Q:'SRCONT 48 W "NOTE DATED: " 49 W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN") 50 W ?30,$$UP^XLFSTR(^TMP("SRLQ",$J,SRDA,.01,"E")),! 51 I +$G(^TMP("SRLQ",$J,SRDA,1205,"I")) D 52 .S LOC=$G(^TMP("SRLQ",$J,SRDA,1205,"I")) Q:'$D(^SC(LOC,0)) 53 .W $S($P(^SC(LOC,0),U,3)="W":"ADMITTED: ",1:"VISIT: ") 54 .W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,.07,"I"),"MM/DD/CCYY HR:MIN") 55 .W " ",$G(^TMP("SRLQ",$J,SRDA,1205,"E")) 56 I ^TMP("SRLQ",$J,SRDA,1701,"E")]"" W !,"SUBJECT: ",^("E"),! 57 S SRCONT1=1 58 I $D(^TMP("SRLQ",$J,SRDA,"PROBLEM")) D Q:'SRCONT 59 .D SETCONT() Q:'SRCONT 60 .W !,"ASSOCIATED PROBLEMS:" 61 .N SRI S SRI=0 62 .F S SRI=$O(^TMP("SRLQ",$J,SRDA,"PROBLEM",SRI)) Q:'SRI D Q:'SRCONT 63 ..W !,^(SRI,0) 64 ..D SETCONT() Q:'SRCONT 65 W ! 66 ; 67 S SRI=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W") 68 F S SRI=$O(^TMP("SRLQ",$J,SRDA,"TEXT",SRI)) Q:SRI'>0 D Q:'SRCONT ; D ^DIWW 69 . D SETCONT() Q:'SRCONT 70 . S X=^TMP("SRLQ",$J,SRDA,"TEXT",SRI,0) S:X="" X=" " D ^DIWP 71 D ^DIWW K ^UTILITY($J,"W") 72 Q:'SRCONT 73 RPTSIG ; Signature should be on bottom of form, Addenda on Subsequent pages 74 N AUTHOR,EXPSIGNR,EXPCOSNR,SIGNDATE,SIGNEDBY,SIGNNAME,SIGTITL,SIGNMODE 75 N COSGDATE,COSGEDBY,COSGNAME,COSGTITL,COSGMODE,SIGCHRT,COSCHRT,SRLINE 76 S $P(SRLINE,"-",81)="" 77 S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,1202,"I"))_";"_$G(^("E")) 78 S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,1204,"I"))_";"_$G(^("E")) 79 S EXPCOSNR=$G(^TMP("SRLQ",$J,SRDA,1208,"I"))_";"_$G(^("E")) 80 S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,1501,"I")) 81 S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,1502,"I"))_";"_$G(^("E")) 82 S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,1503,"E")) 83 S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,1504,"E")) 84 S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,1505,"I"))_";"_$G(^("E")) 85 S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,1507,"I")) 86 S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,1508,"I"))_";"_$G(^("E")) 87 S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,1509,"E")) 88 S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,1510,"E")) 89 S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,1511,"I"))_";"_$G(^("E")) 90 S SIGCHRT=$G(^TMP("SRLQ",$J,SRDA,1512,"I"))_";"_$G(^("E")) 91 S COSCHRT=$G(^TMP("SRLQ",$J,SRDA,1513,"I"))_";"_$G(^("E")) 92 D SETCONT() Q:'SRCONT W ! 93 D SIGBLK Q:'SRCONT 94 ADDENDA ; Surgery Reports Addenda 95 N DIW,DIWF,DIWL,DIWR,DIWT,X,Z,SRI,SRADD 96 S SRADD=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W") 97 F S SRADD=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD)) Q:SRADD'>0 D Q:'SRCONT 98 . S SRY=4 D SETCONT() Q:'SRCONT 99 . W !!,$$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"ADDENDUM" 100 . W ?41,"STATUS: ",^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,.05,"E") 101 . S SRI=0 102 . F S SRI=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI)) Q:SRI'>0 D Q:'SRCONT 103 . . D SETCONT() Q:'SRCONT 104 . . S X=^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI,0) S:X="" X=" " D ^DIWP 105 . D ^DIWW 106 . D:SRCONT ADDENSIG 107 K ^UTILITY($J,"W") 108 ; Write 2 linefeeds between records 109 Q:'SRCONT W !! 110 Q 111 ADDENSIG ; 112 N AUTHOR,EXPSIGNR,ATTNDING,SIGNDATE,SIGNEDBY,SIGNNAME,SIGNMODE 113 N COSGDATE,COSGEDBY,COSGNAME,COSGMODE,SRLINE S $P(SRLINE,"-",80)="" 114 S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1202,"I"))_";"_$G(^("E")) 115 S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1204,"I"))_";"_$G(^("E")) 116 S ATTNDING=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1209,"I"))_";"_$G(^("E")) 117 S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1501,"I")) 118 S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1502,"I"))_";"_$G(^("E")) 119 S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1503,"E")) 120 S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1504,"E")) 121 S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1505,"I"))_";"_$G(^("E")) 122 S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1507,"I")) 123 S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1508,"I"))_";"_$G(^("E")) 124 S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1509,"E")) 125 S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1510,"E")) 126 S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1511,"I"))_";"_$G(^("E")) 127 S SRY=11 128 SIGBLK N SRGROOT S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA)) 129 I '+SIGNDATE D D SETCONT() Q:'SRCONT 130 .I $$STATUS^SROESUTL(SRDA)'=7 W !,"**DRAFT COPY - DRAFT COPY -- ABOVE NOTE IS UNSIGNED-- DRAFT COPY - DRAFT COPY**" 131 I SIGNEDBY]"",(+SIGNEDBY'=+AUTHOR) D 132 . W ?21,"Author: ",$P(AUTHOR,";",2),! 133 I +SIGNDATE D SETCONT() Q:'SRCONT D 134 . W ?18,"Signed by:",$S($P(SIGNMODE,";")="C":" /s/ ",1:" /es/ "),?34,$S(SIGNNAME]"":SIGNNAME,1:$P(SIGNEDBY,";",2)) 135 . W !?34,SIGTITL 136 . I $L(SIGTITL)>30 W !?34 137 . E W " " 138 . W $$DATE^SROESPR(+SIGNDATE,"MM/DD/CCYY HR:MIN") 139 . I '+$G(SRFLAG)!($E(IOST)="C") D 140 . . I $P($$BEEP^SROESPR(+SIGNEDBY),U) W !?34,"Analog Pager: ",$P($$BEEP^SROESPR(+SIGNEDBY),U) 141 . . I $P($$BEEP^SROESPR(+SIGNEDBY),U,2) W !?34,"Digital Pager: ",$P($$BEEP^SROESPR(+SIGNEDBY),U,2) 142 I $G(^TMP("SRLQ",$J,SRDA,.05,"E"))="UNCOSIGNED" D 143 . W !?34,"**REQUIRES COSIGNATURE**",! 144 I +SIGCHRT,$P(SIGNMODE,";")="C" D SETCONT() Q:'SRCONT D 145 . W !?2,"Marked signed on chart by:",?34,$P(SIGCHRT,";",2) 146 I +$G(SRADD) S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD)) 147 I +$D(@SRGROOT@("EXTRASGNR")) D 148 . N SRI S SRI=0 149 . D SETCONT() Q:'SRCONT W !?4,"Receipt Acknowledged By:" 150 . F S SRI=$O(@SRGROOT@("EXTRASGNR",SRI)) Q:'SRI D 151 . . I +$G(@SRGROOT@("EXTRASGNR",SRI,"DATE"))'>0 Q 152 . . I SRI>1 D SETCONT() Q:'SRCONT W ! 153 . . W ?29,"/es/ ",$G(@SRGROOT@("EXTRASGNR",SRI,"NAME")) 154 . . W !?34,$G(@SRGROOT@("EXTRASGNR",SRI,"TITLE")) 155 . . I $L($G(@SRGROOT@("EXTRASGNR",SRI,"TITLE")))>30 W !?34 156 . . E W " " 157 . . W $$DATE^SROESPR($G(@SRGROOT@("EXTRASGNR",SRI,"DATE")),"MM/DD/CCYY HR:MIN") 158 . . I '+$G(SRFLAG)!($E(IOST)="C") D 159 . . . N BEEP 160 . . . S BEEP=$$BEEP^SROESPR(+$G(@SRGROOT@("EXTRASGNR",SRI,"EXTRA"))) 161 . . . I +BEEP W !?34,"Analog Pager: ",$P(BEEP,U) 162 . . . I +$P(BEEP,U,2) W !?34,"Digital Pager: ",$P(BEEP,U,2) 163 . K @SRGROOT@("EXTRASGNR") 164 I +COSGDATE,(+COSGEDBY'=+SIGNEDBY) D SETCONT() Q:'SRCONT D 165 . W !?16,"Cosigned by:",$S($P(COSGMODE,";")="C":" /s/ ",1:" /es/ "),?34,$S(COSGNAME]"":COSGNAME,1:$P(COSGEDBY,";",2)) 166 . W !?34,COSGTITL," " 167 . W $$DATE^SROESPR(+COSGDATE,"MM/DD/CCYY HR:MIN") 168 . I '+$G(SRFLAG)!($E(IOST)="C") D 169 . . I $P($$BEEP^SROESPR(+COSGEDBY),U) W !?34,"Analog Pager: ",$P($$BEEP^SROESPR(+COSGEDBY),U) 170 . . I $P($$BEEP^SROESPR(+COSGEDBY),U,2) W !?34,"Digital Pager:",$P($$BEEP^SROESPR(+COSGEDBY),U,2) 171 I +COSCHRT,$P(COSGMODE,";")="C" D SETCONT() Q:'SRCONT D 172 . W !,"Marked cosigned on chart by:",?34,$P(COSCHRT,";",2) 173 W ! 174 K SRCONT1 175 AMEND ; signature blocks of amender 176 S SRY=4 D SETCONT() Q:'SRCONT 177 I +$G(@SRGROOT@(1601,"I")) D 178 . W !!?12,"Amendment Filed:",?34,$$DATE^SROESPR(@SRGROOT@(1601,"I"),"MM/DD/CCYY HR:MIN") 179 . I $G(@SRGROOT@(1603,"E"))']"" D 180 . . W !!?29 F SRI=1:1:40 W "_" 181 . . W !?29,$$SIGNAME^SROESPR(@SRGROOT@(1602,"I")) 182 . . W !?29,$$SIGTITL^SROESPR(@SRGROOT@(1602,"I")) 183 . I $G(@SRGROOT@(1604,"E"))]"" D 184 . . W !?29,"/es/",?34,@SRGROOT@(1604,"E") 185 . . W !?34,@SRGROOT@(1605,"E") 186 Q 187 SETCONT(SRHEAD) ;Does footer and sets SRCONT 188 S SRCONT=$$FOOTER^SROESPR2(.SRFOOT,SRFLAG,SRPFNBR,$G(SRHEAD),$G(SRCONT1),SRDA) 189 Q 1 SROESPR1 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 04/21/04 12:08 PM ] 2 ;;3.0; Surgery ;**100,128**;24 Jun 93 3 ; 4 ;** NOTICE: This routine is part of an implementation of a nationally 5 ;** controlled procedure. Local modifications to this routine 6 ;** are prohibited. 7 ; 8 ; Reference to EXTRACT^TIULQ supported by DBIA #2693 9 ; 10 ; This routine was cloned in part or in whole from TIUPRPN1. 11 PRINT(SRFLAG,SRSPG) ; Print Summary 12 ; ^TMP("SRPR",$J) is array of records passed by reference 13 ; SRFLAG=1 --> Chart Copy SRSPG=1 --> Contiguous 14 ; SRFLAG=0 --> Work Copy SRSPG=0 --> Fresh Page- each note 15 N SRI,SRJ,SRPAGE,SRFOOT,SRK,SRDA,SRCONT,SRPGRP,SRTYP 16 N SRPFHDR,SRPFNBR,SROPAGE 17 S SRFLAG=+$G(SRFLAG),SRSPG=+$G(SRSPG) 18 S SRI=0 F S SRI=$O(^TMP("SRPR",$J,SRI)) Q:SRI="" D Q:'SRCONT 19 . N DFN,SR,SRERR 20 . I SRI["$" S SRPGRP=$P(SRI,"$"),SRPFHDR=$P($P(SRI,";"),"$",2) 21 . E S SRPFHDR="Surgery Reports" 22 . I $G(SRPGRP)'=2 S SRSPG=0 23 . S DFN=$P(SRI,";",2) 24 . D PAT^SROESPR(.SRFOOT,DFN) 25 . I +$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR) 26 . S SRJ=0 F S SRJ=$O(^TMP("SRPR",$J,SRI,SRJ)) Q:'SRJ D Q:'SRCONT 27 . . S SRK=0 F S SRK=$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) Q:'SRK D Q:'+$G(SRCONT) 28 . . . N SRERR1,SRW K SRCONT1 S SRPFNBR=^(SRK) 29 . . . ; If the document has been deleted, QUIT 30 . . . D EXTRACT^TIULQ(SRK,"SRW",.SRERR1,".01") I $P($G(SRERR1),"^")=1 S SRCONT=1 Q 31 . . . I '+$G(SRSPG) D HEADER^SROESPR2(.SRFOOT,SRFLAG,.SRPFHDR) 32 . . . S SRDA=SRK 33 . . . D REPORT(SRDA) Q:'+$G(SRCONT) 34 . . . I '+$G(SRSPG) K SRCONT1 D SETCONT(1) 35 . . . I $E(IOST)="C",'$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) S SRCONT=0 36 . Q:'SRCONT I $E(IOST)="C" S SRCONT=$$STOP^SROESPR2() Q:'SRCONT 37 . I +$G(SRSPG),$E(IOST)'="C" K SRCONT1 D SETCONT(1) 38 Q 39 REPORT(SRDA) ; Report Text 40 N DIW,DIWF,DIWL,DIWR,DIWT,SRERR,SR,SRI,SRLINE,X,Z,SRY,LOC 41 K ^TMP("SRLQ",$J) 42 S SRLINE=0 43 D EXTRACT^TIULQ(+SRDA,"^TMP(""SRLQ"",$J)",.SRERR,"",SRLINE,1) 44 I +$G(SRERR) W !,$P(SRERR,U,2) Q 45 Q:'$D(^TMP("SRLQ",$J)) 46 S SRY=4,SRCONT=1 47 D SETCONT() Q:'SRCONT 48 W "NOTE DATED: " 49 W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN") 50 W ?30,$$UP^XLFSTR(^TMP("SRLQ",$J,SRDA,.01,"E")),! 51 I +$G(^TMP("SRLQ",$J,SRDA,1205,"I")) D 52 .S LOC=$G(^TMP("SRLQ",$J,SRDA,1205,"I")) Q:'$D(^SC(LOC,0)) 53 .W $S($P(^SC(LOC,0),U,3)="W":"ADMITTED: ",1:"VISIT: ") 54 .W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,.07,"I"),"MM/DD/CCYY HR:MIN") 55 .W " ",$G(^TMP("SRLQ",$J,SRDA,1205,"E")) 56 I ^TMP("SRLQ",$J,SRDA,1701,"E")]"" W !,"SUBJECT: ",^("E"),! 57 S SRCONT1=1 58 I $D(^TMP("SRLQ",$J,SRDA,"PROBLEM")) D Q:'SRCONT 59 .D SETCONT() Q:'SRCONT 60 .W !,"ASSOCIATED PROBLEMS:" 61 .N SRI S SRI=0 62 .F S SRI=$O(^TMP("SRLQ",$J,SRDA,"PROBLEM",SRI)) Q:'SRI D Q:'SRCONT 63 ..W !,^(SRI,0) 64 ..D SETCONT() Q:'SRCONT 65 W ! 66 ; 67 S SRI=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W") 68 F S SRI=$O(^TMP("SRLQ",$J,SRDA,"TEXT",SRI)) Q:SRI'>0 D Q:'SRCONT ; D ^DIWW 69 . D SETCONT() Q:'SRCONT 70 . S X=^TMP("SRLQ",$J,SRDA,"TEXT",SRI,0) S:X="" X=" " D ^DIWP 71 D ^DIWW K ^UTILITY($J,"W") 72 Q:'SRCONT 73 RPTSIG ; Signature should be on bottom of form, Addenda on Subsequent pages 74 N AUTHOR,EXPSIGNR,EXPCOSNR,SIGNDATE,SIGNEDBY,SIGNNAME,SIGTITL,SIGNMODE 75 N COSGDATE,COSGEDBY,COSGNAME,COSGTITL,COSGMODE,SIGCHRT,COSCHRT,SRLINE 76 S $P(SRLINE,"-",81)="" 77 S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,1202,"I"))_";"_$G(^("E")) 78 S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,1204,"I"))_";"_$G(^("E")) 79 S EXPCOSNR=$G(^TMP("SRLQ",$J,SRDA,1208,"I"))_";"_$G(^("E")) 80 S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,1501,"I")) 81 S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,1502,"I"))_";"_$G(^("E")) 82 S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,1503,"E")) 83 S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,1504,"E")) 84 S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,1505,"I"))_";"_$G(^("E")) 85 S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,1507,"I")) 86 S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,1508,"I"))_";"_$G(^("E")) 87 S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,1509,"E")) 88 S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,1510,"E")) 89 S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,1511,"I"))_";"_$G(^("E")) 90 S SIGCHRT=$G(^TMP("SRLQ",$J,SRDA,1512,"I"))_";"_$G(^("E")) 91 S COSCHRT=$G(^TMP("SRLQ",$J,SRDA,1513,"I"))_";"_$G(^("E")) 92 D SETCONT() Q:'SRCONT W ! 93 D SIGBLK Q:'SRCONT 94 ADDENDA ; Surgery Reports Addenda 95 N DIW,DIWF,DIWL,DIWR,DIWT,X,Z,SRI,SRADD 96 S SRADD=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W") 97 F S SRADD=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD)) Q:SRADD'>0 D Q:'SRCONT 98 . S SRY=4 D SETCONT() Q:'SRCONT 99 . W !!,$$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"ADDENDUM" 100 . S SRI=0 101 . F S SRI=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI)) Q:SRI'>0 D Q:'SRCONT 102 . . D SETCONT() Q:'SRCONT 103 . . S X=^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI,0) S:X="" X=" " D ^DIWP 104 . D ^DIWW 105 . D:SRCONT ADDENSIG 106 K ^UTILITY($J,"W") 107 ; Write 2 linefeeds between records 108 Q:'SRCONT W !! 109 Q 110 ADDENSIG ; 111 N AUTHOR,EXPSIGNR,ATTNDING,SIGNDATE,SIGNEDBY,SIGNNAME,SIGNMODE 112 N COSGDATE,COSGEDBY,COSGNAME,COSGMODE,SRLINE S $P(SRLINE,"-",80)="" 113 S AUTHOR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1202,"I"))_";"_$G(^("E")) 114 S EXPSIGNR=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1204,"I"))_";"_$G(^("E")) 115 S ATTNDING=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1209,"I"))_";"_$G(^("E")) 116 S SIGNDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1501,"I")) 117 S SIGNEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1502,"I"))_";"_$G(^("E")) 118 S SIGNNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1503,"E")) 119 S SIGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1504,"E")) 120 S SIGNMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1505,"I"))_";"_$G(^("E")) 121 S COSGDATE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1507,"I")) 122 S COSGEDBY=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1508,"I"))_";"_$G(^("E")) 123 S COSGNAME=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1509,"E")) 124 S COSGTITL=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1510,"E")) 125 S COSGMODE=$G(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1511,"I"))_";"_$G(^("E")) 126 S SRY=11 127 SIGBLK N SRGROOT S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA)) 128 I '+SIGNDATE D D SETCONT() Q:'SRCONT 129 .I $$STATUS^SROESUTL(SRDA)'=7 W !,"**DRAFT COPY - DRAFT COPY -- ABOVE NOTE IS UNSIGNED-- DRAFT COPY - DRAFT COPY**" 130 I SIGNEDBY]"",(+SIGNEDBY'=+AUTHOR) D 131 . W ?21,"Author: ",$P(AUTHOR,";",2),! 132 I +SIGNDATE D SETCONT() Q:'SRCONT D 133 . W ?18,"Signed by:",$S($P(SIGNMODE,";")="C":" /s/ ",1:" /es/ "),?34,$S(SIGNNAME]"":SIGNNAME,1:$P(SIGNEDBY,";",2)) 134 . W !?34,SIGTITL 135 . I $L(SIGTITL)>30 W !?34 136 . E W " " 137 . W $$DATE^SROESPR(+SIGNDATE,"MM/DD/CCYY HR:MIN") 138 . I '+$G(SRFLAG)!($E(IOST)="C") D 139 . . I $P($$BEEP^SROESPR(+SIGNEDBY),U) W !?34,"Analog Pager: ",$P($$BEEP^SROESPR(+SIGNEDBY),U) 140 . . I $P($$BEEP^SROESPR(+SIGNEDBY),U,2) W !?34,"Digital Pager: ",$P($$BEEP^SROESPR(+SIGNEDBY),U,2) 141 I $G(^TMP("SRLQ",$J,SRDA,.05,"E"))="UNCOSIGNED" D 142 . W !?34,"**REQUIRES COSIGNATURE**",! 143 I +SIGCHRT,$P(SIGNMODE,";")="C" D SETCONT() Q:'SRCONT D 144 . W !?2,"Marked signed on chart by:",?34,$P(SIGCHRT,";",2) 145 I +$G(SRADD) S SRGROOT=$NA(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD)) 146 I +$D(@SRGROOT@("EXTRASGNR")) D 147 . N SRI S SRI=0 148 . D SETCONT() Q:'SRCONT W !?4,"Receipt Acknowledged By:" 149 . F S SRI=$O(@SRGROOT@("EXTRASGNR",SRI)) Q:'SRI D 150 . . I +$G(@SRGROOT@("EXTRASGNR",SRI,"DATE"))'>0 Q 151 . . I SRI>1 D SETCONT() Q:'SRCONT W ! 152 . . W ?29,"/es/ ",$G(@SRGROOT@("EXTRASGNR",SRI,"NAME")) 153 . . W !?34,$G(@SRGROOT@("EXTRASGNR",SRI,"TITLE")) 154 . . I $L($G(@SRGROOT@("EXTRASGNR",SRI,"TITLE")))>30 W !?34 155 . . E W " " 156 . . W $$DATE^SROESPR($G(@SRGROOT@("EXTRASGNR",SRI,"DATE")),"MM/DD/CCYY HR:MIN") 157 . . I '+$G(SRFLAG)!($E(IOST)="C") D 158 . . . N BEEP 159 . . . S BEEP=$$BEEP^SROESPR(+$G(@SRGROOT@("EXTRASGNR",SRI,"EXTRA"))) 160 . . . I +BEEP W !?34,"Analog Pager: ",$P(BEEP,U) 161 . . . I +$P(BEEP,U,2) W !?34,"Digital Pager: ",$P(BEEP,U,2) 162 . K @SRGROOT@("EXTRASGNR") 163 I +COSGDATE,(+COSGEDBY'=+SIGNEDBY) D SETCONT() Q:'SRCONT D 164 . W !?16,"Cosigned by:",$S($P(COSGMODE,";")="C":" /s/ ",1:" /es/ "),?34,$S(COSGNAME]"":COSGNAME,1:$P(COSGEDBY,";",2)) 165 . W !?34,COSGTITL," " 166 . W $$DATE^SROESPR(+COSGDATE,"MM/DD/CCYY HR:MIN") 167 . I '+$G(SRFLAG)!($E(IOST)="C") D 168 . . I $P($$BEEP^SROESPR(+COSGEDBY),U) W !?34,"Analog Pager: ",$P($$BEEP^SROESPR(+COSGEDBY),U) 169 . . I $P($$BEEP^SROESPR(+COSGEDBY),U,2) W !?34,"Digital Pager:",$P($$BEEP^SROESPR(+COSGEDBY),U,2) 170 I +COSCHRT,$P(COSGMODE,";")="C" D SETCONT() Q:'SRCONT D 171 . W !,"Marked cosigned on chart by:",?34,$P(COSCHRT,";",2) 172 W ! 173 K SRCONT1 174 AMEND ; signature blocks of amender 175 S SRY=4 D SETCONT() Q:'SRCONT 176 I +$G(@SRGROOT@(1601,"I")) D 177 . W !!?12,"Amendment Filed:",?34,$$DATE^SROESPR(@SRGROOT@(1601,"I"),"MM/DD/CCYY HR:MIN") 178 . I $G(@SRGROOT@(1603,"E"))']"" D 179 . . W !!?29 F SRI=1:1:40 W "_" 180 . . W !?29,$$SIGNAME^SROESPR(@SRGROOT@(1602,"I")) 181 . . W !?29,$$SIGTITL^SROESPR(@SRGROOT@(1602,"I")) 182 . I $G(@SRGROOT@(1604,"E"))]"" D 183 . . W !?29,"/es/",?34,@SRGROOT@(1604,"E") 184 . . W !?34,@SRGROOT@(1605,"E") 185 Q 186 SETCONT(SRHEAD) ;Does footer and sets SRCONT 187 S SRCONT=$$FOOTER^SROESPR2(.SRFOOT,SRFLAG,SRPFNBR,$G(SRHEAD),$G(SRCONT1),SRDA) 188 Q
Note:
See TracChangeset
for help on using the changeset viewer.
