source: WorldVistAEHR/trunk/r/SURGERY-SR/SROESXA.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1SROESXA ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 03/02/04 09:23 AM ]
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 $$WHATITLE^TIUPUTU supported by DBIA #3351
9 ; Reference to DELETE^TIUSRVP supported by DBIA #3535
10 ; Reference to MAKE^TIUSRVP supported by DBIA #3535
11 ; Reference to UPDATE^TIUSRVP supported by DBIA #3535
12 ;
13 Q
14AESA ; set logic for AESA cross-reference
15 N SRDIV,SRINUSE,SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK
16 S SRTN=DA I $P($G(^SRF(SRTN,"NON")),"^")="Y" Q
17 Q:'$$INUSE(SRTN)
18 S ZTDESC="Surgery Anesthesia Report Stub",ZTRTN="AR^SROESXA",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD
19 Q
20INUSE(SRTN) ; is anesthesia report in use at this division?
21 N SRDIV,SRINUSE
22 S SRINUSE=0,SRDIV=$$SITE^SROUTL0(SRTN) S:SRDIV SRINUSE=$P($G(^SRO(133,SRDIV,.1)),"^",4)
23 Q SRINUSE
24AR ; create stub entry in TIU for anesthesia report
25 N DFN,DIC,SR0,SRATT,SRAY,SRD,SRDOC,SRLOC,SRPRIN,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSTR,VSIT,X,Y
26 I '$P($G(^SRF(SRTN,.2)),"^",4) D END Q
27 S SRD=$P($G(^SRF(SRTN,"TIU")),"^",4) I SRD D END Q
28 S SRX=$$WHATITLE^TIUPUTU("ANESTHESIA REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
29 S SRDIV=$$SITE^SROUTL0(SRTN),SR0=^SRF(SRTN,0),DFN=$P(SR0,"^") D LOC
30 S X=$G(^SRF(SRTN,.3)),SRPRIN=$P(X,"^"),SRATT=$P(X,"^",4)
31 S SRAY(.02)=DFN,SRAY(.05)=1,SRAY(1205)=SRLOC,SRAY(1301)=$P(SR0,"^",9),SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
32 S:SRPRIN (SRAY(1202),SRAY(1204))=SRPRIN S:SRATT (SRAY(1208),SRAY(1209))=SRATT
33 S X=$G(^SRF(SRTN,.2)),SRAY(.07)=$P(X,"^",10),SRAY(.08)=$P(X,"^",12)
34 S VDT=$P(SR0,"^",9),VSIT=$P(SR0,"^",15),VLOC=""
35 I 'VSIT S VLOC=SRLOC
36 I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";"_$S(+$D(^DPT(DFN,.1)):"I",1:"E")
37 D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU D
38 .F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",4)=SRTIU L -^SRF("TIU"_SRTN) Q
39 .D ALERT
40END S ZTREQ="@"
41 Q
42LOC ; get patient location
43 N SRDEF,SROR,SRT,SRWARD,VAIP,X,Y
44 S VAIP("D")=$P(SR0,"^",9) D IN5^VADPT
45 S SRWARD=$P(VAIP(5),"^"),(SRDEF,SRLOC)="",SROR=$P(SR0,"^",2) I SROR S SROR=$P(^SRS(SROR,0),"^")
46 I SRWARD K DA,DIC,DIQ,DR S DA=SRWARD,DIC=42,DR="44",DIQ="SRT",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR S SRLOC=$G(SRT(42,SRWARD,44,"I"))
47 S SRDEF=$P($G(^SRO(133,SRDIV,0)),"^",23)
48 I SRDEF="" S X="SURGERY OP REPORT NON-COUNT",DIC(0)="M",DIC="^SC(" D ^DIC K DIC I +Y>0 S SRDEF=+Y
49 S SRLOC=$S(SRLOC:SRLOC,SRDEF:SRDEF,SROR:SROR,1:"")
50 Q
51ALERT ; issue alert to anesthesia personnel
52 S XQAID="SRAR-"_SRTN,XQAKILL=0 D DELETEA^XQALERT K XQAID,XQAKILL
53 N X,Y,Z S X=$G(^SRF(SRTN,.3)) F Y=1,4 S Z=$P(X,"^",Y) I Z S XQA(Z)=""
54 S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNM=$E($P(VADM(1),"^"),1,15)_" ("_$E($P(VADM(1),"^"))_VA("BID")_"): "
55 S SRLAB=SRNM_$E($P(^SRF(SRTN,"OP"),"^"),1,25)_" (ANES REPORT ready to complete)"
56 S XQAMSG=SRLAB,XQAROU="ACTION^SROESXA",XQAID="SRAR-"_SRTN,XQADATA=SRTN D SETUP^XQALERT
57 Q
58STATUS(SRSTAT) ; update status
59 K SRAY S SRAY(.05)=SRSTAT D UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)
60 Q
61KAESA ; kill logic for the AESA cross-reference
62 N SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK S SRTN=DA
63 S ZTDESC="Surgery Anesthesia Report Delete Stub",ZTRTN="KSTUB^SROESXA",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD
64 Q
65KSTUB ; delete stubs in TIU for unsigned anesthesia report
66 N SRERR,SRODA,SRTIU
67 S SRODA=SRTN,SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",4) I SRTIU D
68 .D STATUS(5)
69 .D DELETE^TIUSRVP(.SRERR,SRTIU,,1) I 'SRERR D
70 ..F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",4)="" L -^SRF("TIU"_SRTN) Q
71 D DELRT,END
72 Q
73ACTION ; action alert
74 N SRTN,SRALRT K XQAKILL S SRTN=XQADATA,SRALRT=1 D ^SROARPT
75 S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",4) I SRTIU,$$STATUS^SROESUTL(SRTIU)=7 D DELRT
76 Q
77DELRT N XQAID,XQAKILL S XQAID="SRAR-"_SRTN,XQAKILL=0 D DELETEA^XQALERT
78 Q
Note: See TracBrowser for help on using the repository browser.