source: FOIAVistA/trunk/r/SURGERY-SR/SROES.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1SROES ;BIR/ADM - SURGERY E-SIG UTILITY ;06/07/06
2 ;;3.0; Surgery ;**100,153**;24 Jun 93;Build 11
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 ;
10SRA N SRRISK S SRRISK=1
11ENTER Q:'$G(SRTN)
12 N SRSOUT D CHECK I $G(SRSOUT) K SRSOUT S XQUIT=""
13 Q
14CHECK ; pre-edit capture of nurse and anesthesia reports for addenda
15 N I,SRA,SRAUDIT,SRCCASE,SRESAR,SRESNR,SRN,SROP,SRSIGN,SRTIU,SRX,SRY,X S (SRAUDIT,SRSOUT)=0
16 S (SRA(SRTN),SRAUDIT(SRTN),SRN(SRTN))=0,SRTIU=$G(^SRF(SRTN,"TIU")),SRESNR=$P(SRTIU,"^",2),SRESAR=$P(SRTIU,"^",4),SROP=SRTN D DOCS
17 S SRCCASE=$P($G(^SRF(SRTN,"CON")),"^") I SRCCASE S (SRA(SRCCASE),SRAUDIT(SRCCASE),SRN(SRCCASE))=0,SRTIU=$G(^SRF(SRCCASE,"TIU")),SRESNR=$P(SRTIU,"^",2),SRESAR=$P(SRTIU,"^",4),SROP=SRCCASE D DOCS
18 S X=0 F S X=$O(SRAUDIT(X)) Q:'X I SRAUDIT(X) S SRAUDIT=1 Q
19 Q:'SRAUDIT
20 D:'$G(SRRISK) WARN I SRSOUT Q
21 D KTMP
22 N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK S XQUIT="",SRSOUT=1 Q
23 S SROP=0 F S SROP=$O(SRAUDIT(SROP)) Q:'SROP D PRE
24 Q
25KTMP ; kill TMP globals
26 F I="SRADDEND","SRAR","SRNR","SRASAVE","SRNSAVE" K ^TMP(I,$J)
27 F I=1,2 F J="SRAD","SRADM","SRARAD","SRARMULT","SRNRAD","SRNRMULT" K ^TMP(J_I,$J)
28 Q
29DOCS ; determine if signed
30 I SRESNR S SRX=SRESNR,SRSIGN=0 D SIGNED I SRSIGN S SRN(SROP)=1
31 I SRESAR S SRX=SRESAR,SRSIGN=0 D SIGNED I SRSIGN S SRA(SROP)=1
32 Q
33SIGNED I SRX N SRERR D EXTRACT^TIULQ(SRX,"SRY",.SRERR,".05") I SRY(SRX,.05,"I")=7 S SRSIGN=1,SRAUDIT(SROP)=1
34 K SRY
35 Q
36PRE ; save pr-edit copy of case data
37 N SRTN S SRTN=SROP
38 D:SRN(SRTN)=1 IN^SROESNR D:SRA(SRTN)=1 IN^SROESAR
39 Q
40WARN ; warning message that addendum may be required
41 D HDR W !!!,?30,">>> WARNING <<<"
42 W !!," Electronically signed reports are associated with this case. Editing",!," of data that appear on electronically signed reports will require the",!," creation of addenda to the signed reports.",!!!
43 K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
44 Q
45HDR S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) X ^DD("DD") S SRSDATE=Y
46 W @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
47 Q
48EXIT ; post-edit check to see if addenda to nurse/anes. reports are required
49 Q:'$D(SRTN) D WAIT^DICD
50 D:$D(^TMP("SRNRAD1",$J,SRTN)) EX^SROESNR
51 D:$D(^TMP("SRARAD1",$J,SRTN)) EX^SROESAR
52 I $D(^TMP("SRNRAD1",$J,SRTN))!$D(^TMP("SRARAD1",$J,SRTN))!$D(^TMP("SRNRAD2",$J,SRTN))!$D(^TMP("SRARAD2",$J,SRTN)) D ^SROESAD1
53 N SRCCASE,SRTN1 S SRCCASE=$P($G(^SRF(SRTN,"CON")),"^") I SRCCASE S SRTN1=SRTN S SRTN=SRCCASE D
54 .D:$D(^TMP("SRNRAD1",$J,SRTN)) EX^SROESNR
55 .D:$D(^TMP("SRARAD1",$J,SRTN)) EX^SROESAR
56 .I $D(^TMP("SRNRAD1",$J,SRTN))!$D(^TMP("SRARAD1",$J,SRTN)) D ^SROESAD1
57 .S SRTN=SRTN1
58DOC N SRADOC,SRDOC,SRNDOC S (SRADOC,SRDOC,SRNDOC)=0
59 I $O(^TMP("SRNR",$J,SRTN,0)) S SRNDOC=SRNDOC+1,SRDOC=SRDOC+1,SRNDOC(SRTN)="Nurse Intraoperative Report - Case #"_SRTN
60 I SRCCASE,$O(^TMP("SRNR",$J,SRCCASE,0)) S SRNDOC=SRNDOC+1,SRDOC=SRDOC+1,SRNDOC(SRCCASE)="Nurse Intraoperative Report - Concurrent Case #"_SRCCASE
61 I $O(^TMP("SRAR",$J,SRTN,0)) S SRADOC=SRADOC+1,SRDOC=SRDOC+1,SRADOC(SRTN)="Anesthesia Report - Case #"_SRTN
62 I SRCCASE,$O(^TMP("SRAR",$J,SRCCASE,0)) S SRADOC=SRADOC+1,SRDOC=SRDOC+1,SRADOC(SRCCASE)="Anesthesia Report - Concurrent Case #"_SRCCASE
63 I 'SRDOC Q
64 D HDR W !!,"An addendum to each of the following electronically signed document(s) is",!,"required:",!
65 S X=0 F S X=$O(SRNDOC(X)) Q:'X W !,?10,SRNDOC(X)
66 S X=0 F S X=$O(SRADOC(X)) Q:'X W !,?10,SRADOC(X)
67 W !!,"If you choose not to create an addendum, the original data will be restored",!,"to the modified fields appearing on the signed reports.",!!
68 N SRESNOT S SRESNOT=0 K DIR S DIR(0)="Y",DIR("A")="Create addendum",DIR("B")="YES" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRESNOT=1 D ALLREV Q
69 D ^SROESAD I SRESNOT D REVRS,PRESS
70 I SRCCASE S SRTN1=SRTN,SRTN=SRCCASE,SRESNOT=0 D ^SROESAD D:SRESNOT REVRS,PRESS S SRTN=SRTN1
71UNLOCK D UNLOCK^SROUTL(SRTN),KTMP
72 Q
73PRESS W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue... " D ^DIR K DIR
74 Q
75ALLREV ; restore modified fields for both concurrent cases
76 W !!,"No addendum created. Original data will be restored.",!!
77 D REVRS S SRCCASE=$P($G(^SRF(SRTN,"CON")),"^") I SRCCASE S SRTN1=SRTN,SRTN=SRCCASE D REVRS S SRTN=SRTN1
78 D UNLOCK,PRESS
79 Q
80REVRS ; restore modified fields on signed reports
81 D REVRS^SROESNR0,REVRS^SROESAR0
82 S SROERR=SRTN D ^SROERR0
83 Q
Note: See TracBrowser for help on using the repository browser.