75 lines
3.5 KiB
Mathematica
75 lines
3.5 KiB
Mathematica
SROESXP ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/16/04 09:30 AM ]
|
|
;;3.0; Surgery ;**100,129**;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 $$WHATITLE^TIUPUTU supported by DBIA #3351
|
|
; Reference to DELETE^TIUSRVP supported by DBIA #3535
|
|
; Reference to MAKE^TIUSRVP supported by DBIA #3535
|
|
; Reference to UPDATE^TIUSRVP supported by DBIA #3535
|
|
;
|
|
Q
|
|
SCOND(X1,X2) ; set condition for AESP x-ref
|
|
N SRADD,SRI,X1NULL,X2NULL S (X1NULL,X2NULL)=0
|
|
F SRI=1,2 S:X1(SRI)="" X1NULL=1 S:X2(SRI)="" X2NULL=1
|
|
I X1NULL&'X2NULL S SRADD=1
|
|
E S SRADD=0
|
|
I SRADD,'X(2) S SRADD=0
|
|
I X1(1)=X2(1),'X1(2),X2(2) S SRADD=1
|
|
Q SRADD
|
|
KCOND(X1,X2) ; kill condition for AESP x-ref
|
|
N SRDEL,SRI,X1NULL,X2NULL S (X1NULL,X2NULL)=0
|
|
F SRI=1,2 S:X1(SRI)="" X1NULL=1 S:X2(SRI)="" X2NULL=1
|
|
I X2NULL&'X1NULL S SRDEL=1
|
|
E S SRDEL=0
|
|
I SRDEL,'X(2) S SRDEL=0
|
|
I X1(1)=X2(1),'X2(2),X1(2) S SRDEL=1
|
|
Q SRDEL
|
|
AESP ; set logic for AESP cross-reference
|
|
N SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK
|
|
S SRTN=DA I '$P($G(^SRF(SRTN,"NON")),"^",5)!'$P($G(^SRF(SRTN,"TIU")),"^",5) Q
|
|
S ZTDESC="Surgery Non-OR Procedure Report Stub",ZTRTN="PR^SROESXP",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD
|
|
Q
|
|
PR ; create stub entry in TIU for non-OR procedure report
|
|
N DFN,DIC,SR0,SRACODE,SRATT,SRAY,SRD,SRDIV,SRDOC,SRLOC,SRPROV,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,VSTR,X,Y
|
|
I '$P($G(^SRF(SRTN,"NON")),"^",5)!'$P($G(^SRF(SRTN,"TIU")),"^",5) D END Q
|
|
S SRD=$P($G(^SRF(SRTN,"TIU")),"^",3) I SRD D END Q
|
|
S SRX=$$WHATITLE^TIUPUTU("PROCEDURE REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
|
|
S SRDIV=$$SITE^SROUTL0(SRTN),SR0=^SRF(SRTN,0),DFN=$P(SR0,"^") D LOC
|
|
S X=$G(^SRF(SRTN,"NON")),SRATT=$P(X,"^",7),SRPROV=$P(X,"^",6)
|
|
S SRACODE=$P($G(^SRF(SRTN,.1)),"^",10)
|
|
I 'SRATT D
|
|
.I "159"[SRACODE S SRATT=SRPROV Q
|
|
.I SRDIV,'$P(^SRO(133,SRDIV,0),"^",19) S SRATT=SRPROV
|
|
S SRAY(.02)=DFN,SRAY(.05)=1,(SRAY(1202),SRAY(1204))=SRPROV,SRAY(1205)=SRLOC,(SRAY(1208),SRAY(1209))=SRATT,SRAY(1301)=$P(SR0,"^",9),SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
|
|
S (VDT,VLOC,VSIT)=""
|
|
S (SRAY(1301),VDT)=$P($G(^SRF(SRTN,"NON")),"^",4),VSIT=$P(SR0,"^",15)
|
|
I 'VSIT S VLOC=SRLOC
|
|
I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";"_$S(+$D(^DPT(DFN,.1)):"I",1:"E")
|
|
D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU D
|
|
.F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",3)=SRTIU L -^SRF("TIU"_SRTN) Q
|
|
END S ZTREQ="@"
|
|
Q
|
|
LOC ; get patient location
|
|
N SRDEF,SROR,SRT,SRWARD,VAIP S VAIP("D")=$P($G(^SRF(SRTN,"NON")),"^",4) D IN5^VADPT
|
|
S SRWARD=$P(VAIP(5),"^"),(SRDEF,SRLOC)="",SROR=$P($G(^SRF(SRTN,"NON")),"^",2)
|
|
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"))
|
|
S SRDEF=$P($G(^SRO(133,SRDIV,0)),"^",23)
|
|
I SRDEF="" S X="SURGERY OP REPORT NON-COUNT",DIC(0)="M",DIC="^SC(" D ^DIC K DIC I +Y>0 S SRDEF=+Y
|
|
S SRLOC=$S(SRLOC:SRLOC,SRDEF:SRDEF,SROR:SROR,1:"")
|
|
Q
|
|
STATUS(SRSTAT) ; update status
|
|
K SRAY S SRAY(.05)=SRSTAT D UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)
|
|
Q
|
|
KAESP ; kill logic for the AESP cross-reference
|
|
N SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK S SRTN=DA
|
|
S ZTDESC="Surgery Non-OR Procedure Report Delete Stub",ZTRTN="KSTUB^SROESXP",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD
|
|
Q
|
|
KSTUB ; delete stub in TIU for unsigned procedure report (non-OR)
|
|
N SRERR,SRTIU
|
|
S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",3) I SRTIU D DELETE^TIUSRVP(.SRERR,SRTIU,,1) I 'SRERR D
|
|
.F L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",3)="" L -^SRF("TIU"_SRTN) Q
|
|
D END
|
|
Q
|