source: WorldVistAEHR/trunk/r/SURGERY-SR/SROESAD.m@ 660

Last change on this file since 660 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1SROESAD ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 09/04/03 1:03 PM ]
2 ;;3.0; Surgery ;**100**;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 MAKEADD^TIUSRVP supported by DBIA #3535
9 ; Reference to ES^TIUSROI supported by DBIA #3537
10 ;
11 Q:'$D(SRNDOC(SRTN))&'$D(SRADOC(SRTN)) D DISPLAY I SRESNOT D NOAD Q
12ASK 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
13 I $D(DUOUT) D SURE I 'SRESNOT G ASK
14 I SRESNOT D NOAD Q
15 I 'SRSCOM G SIG
16 I SRSCOM W !! S DIR(0)="F^3:80",DIR("A")="Comment" D ^DIR K DIR I $D(DTOUT) S SRESNOT=1 Q
17 I X=""!$D(DUOUT) G SIG
18 D COM
19REV2 ; display addendum with comment for 2nd review
20 D DISPLAY I SRESNOT D NOAD Q
21SIG ; enter e-sig
22 N SRNOW,SRSBN,SRSIG
23 D SIG^XUSESIG I X1="" D NOAD Q
24 S SRSBN=X1,SRNOW=$$NOW^XLFDT
25 I $D(SRNDOC(SRTN)) D POSTN(SRTN,SRSBN,SRNOW)
26 I $D(SRADOC(SRTN)) D POSTA(SRTN,SRSBN,SRNOW)
27 W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue... " D ^DIR K DIR
28 Q
29NOAD ; no addendum created
30 W !!,"No addendum created for case #"_SRTN_". Original data will be restored.",!! S SRESNOT=1
31 Q
32COM ; add comment to end of addendum
33 N SRCOM S SRCOM=X I $D(SRNDOC(SRTN)) S SRLN=$O(^TMP("SRNR",$J,SRTN,""),-1) I SRLN D
34 .I ^TMP("SRNR",$J,SRTN,SRLN)'="" S SRLN=SRLN+1,^TMP("SRNR",$J,SRTN,SRLN)=""
35 .S SRLN=SRLN+1,^TMP("SRNR",$J,SRTN,SRLN)="Addendum Comment: "_$S($L(SRCOM)<63:SRCOM,1:"")
36 .I $L(SRCOM)>62 S SRLN=SRLN+1,^TMP("SRNR",$J,SRTN,SRLN)=SRCOM
37 I $D(SRADOC(SRTN)) S SRLN=$O(^TMP("SRAR",$J,SRTN,""),-1) I SRLN D
38 .I ^TMP("SRAR",$J,SRTN,SRLN)'="" S SRLN=SRLN+1,^TMP("SRAR",$J,SRTN,SRLN)=""
39 .S SRLN=SRLN+1,^TMP("SRAR",$J,SRTN,SRLN)="Addendum Comment: "_$S($L(SRCOM)<63:SRCOM,1:"")
40 .I $L(SRCOM)>62 S SRLN=SRLN+1,^TMP("SRAR",$J,SRTN,SRLN)=SRCOM
41 S SRLN=$O(^TMP("SRADDEND",$J,SRTN,""),-1) I SRLN D
42 .I ^TMP("SRADDEND",$J,SRTN,SRLN)'="" S SRLN=SRLN+1,^TMP("SRADDEND",$J,SRTN,SRLN)=""
43 .S SRLN=SRLN+1,^TMP("SRADDEND",$J,SRTN,SRLN)="Addendum Comment: "_$S($L(SRCOM)<63:SRCOM,1:"")
44 .I $L(SRCOM)>62 S SRLN=SRLN+1,^TMP("SRADDEND",$J,SRTN,SRLN)=SRCOM
45 Q
46GET ; gather data for modified fields for addendum display before signing
47 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
48 .I SRFLD[";W" S SRLN="" D Q
49 ..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)
50 .S ^TMP("SRAD"_SRS,$J,SRTN,130,SRFLD)=^TMP(SRSUB,$J,SRTN,130,SRFLD)
51 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
52 .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
53 ..I SRFLD[";W" S SRLN="" D Q
54 ...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)
55 ..S ^TMP("SRAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)=^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)
56 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
57 .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
58 ..I SRFLD[";W" S SRLN="" D Q
59 ...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)
60 ..S ^TMP("SRADM"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)=^TMP(SRSUB,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)
61 Q
62DISPLAY ; display addenda to nurse/anesthesia report(s)
63 S SRLN=0
64 D HDR F S SRLN=$O(^TMP("SRADDEND",$J,SRTN,SRLN)) Q:'SRLN D Q:SRESNOT
65 .I $Y+4>IOSL D PAGE Q:SRESNOT D HDR
66 .W !,^TMP("SRADDEND",$J,SRTN,SRLN)
67 D:'SRESNOT PAGE
68 Q
69PAGE W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT) S SRESNOT=1 Q
70 I $D(DUOUT) D SURE
71 Q
72SURE 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
73 Q
74HDR ; header for addendum display
75 W @IOF,!,"Addendum for Case #"_SRTN_" - "_SRSDATE,!,"Patient: "_VADM(1)_" ("_VA("PID")_")",!
76 F I=1:1:80 W "-"
77 Q
78POSTA(SRTN,SRSBN,SRNOW) ;post signed addendum to anesthesia report
79 N SRADD,SRAY,SRTIU
80 S SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
81 F I=1:1 Q:'$D(^TMP("SRAR",$J,SRTN,I)) S SRAY("TEXT",I,0)=^TMP("SRAR",$J,SRTN,I)
82 S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",4) Q:'SRTIU
83 D MAKEADD^TIUSRVP(.SRADD,SRTIU,.SRAY,1) Q:'+SRADD
84 S SRTIU=+SRADD K SRAY
85 D ES^TIUSROI(SRTIU,DUZ)
86 Q
87POSTN(SRTN,SRSBN,SRNOW) ; post signed addendum
88 N SRADD,SRAY,SRTIU
89 S SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
90 F I=1:1 Q:'$D(^TMP("SRNR",$J,SRTN,I)) S SRAY("TEXT",I,0)=^TMP("SRNR",$J,SRTN,I)
91 S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",2) Q:'SRTIU
92 D MAKEADD^TIUSRVP(.SRADD,SRTIU,.SRAY,1) Q:'+SRADD
93 S SRTIU=+SRADD K SRAY
94 D ES^TIUSROI(SRTIU,DUZ)
95 Q
Note: See TracBrowser for help on using the repository browser.