55 lines
2.1 KiB
Mathematica
55 lines
2.1 KiB
Mathematica
SROESUTL ;BIR/ADM - SURGERY E-SIG UTILITY ;09/22/04
|
|
;;3.0; Surgery ;**100,134**;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 EXTRACT^TIULQ supported by DBIA #2693
|
|
;
|
|
TIU ; get document specifics from TIU
|
|
D EXTRACT^TIULQ(SRTIU,"SRT",.SRERR)
|
|
S SRDOC=SRT(SRTIU,.01,"E"),SRCASE=$P(SRT(SRTIU,1405,"I"),";")
|
|
Q
|
|
DELETE(SRTIU) ; delete action
|
|
N SR,SRCASE,SRDOC,SRERR,SRFLD,SRT D TIU
|
|
S SRFLD=$S(SRDOC["OPERATION":1000,SRDOC["NURSE INTRAOP":1001,SRDOC["PROCEDURE":1002,1:1003) D
|
|
.S SR=$G(^SRF(SRCASE,"TIU"))
|
|
.I SRFLD=1000,$P(SR,"^")=SRTIU D AT Q
|
|
.I SRFLD=1001,$P(SR,"^",2)=SRTIU D AT Q
|
|
.I SRFLD=1002,$P(SR,"^",3)=SRTIU D AT Q
|
|
.I SRFLD=1003,$P(SR,"^",4)=SRTIU D AT
|
|
Q
|
|
AT N SRY S SRY(130,SROP_",",SRFLD)="@" D FILE^DIE("","SRY")
|
|
Q
|
|
RETRACT(SRTIU) ; retraction action
|
|
D DELETE(SRTIU),ALERT(SRTIU)
|
|
Q
|
|
ALERT(SRTIU) ; issue alert to author of document
|
|
N SRAUTHOR,SRDOC,SRCASE,SRERR,SRT
|
|
D TIU S SRAUTHOR=SRT(SRTIU,1202,"I") Q:'SRAUTHOR
|
|
S XQAMSG=SRDOC_" retracted on case #"_SRCASE_"."
|
|
S XQA(SRAUTHOR)="",XQADATA=SRCASE_"^"_SRDOC,XQAROU="ACTION^SROESUTL"
|
|
D SETUP^XQALERT
|
|
Q
|
|
ACTION ; alert action
|
|
Q:'$D(XQADATA) N DFN,SR,SRSDT,SRTN,SRDOC,SRY,VA,VADM,Y
|
|
S SRTN=$P(XQADATA,"^"),SRDOC=$P(XQADATA,"^",2) Q:'SRTN!(SRDOC="")
|
|
S SR=$G(^SRF(SRTN,0)) Q:SR=""
|
|
S DFN=$P(SR,"^") D DEM^VADPT S Y=$P(SR,"^",9) D DD^%DT S SRSDT=Y
|
|
S SRY(1)=SRDOC_" retracted on case #"_SRTN,SRY(1,"F")="!!!"
|
|
S SRY(2)=VADM(1)_" ("_VA("PID")_") Op Date: "_SRSDT
|
|
S SRY(3)="Principal Procedure: "_$P(^SRF(SRTN,"OP"),"^"),SRY(4)=" " D EN^DDIOL(.SRY)
|
|
Q
|
|
STATUS(SRTIU) ; get signature status
|
|
N SRT,STATUS
|
|
D EXTRACT^TIULQ(SRTIU,"SRT",.SRERR,".05") S STATUS=SRT(SRTIU,.05,"I")
|
|
Q STATUS
|
|
SIGNED(SRCASE) ;is NIR or AR on this case or on concurrent case signed?
|
|
N SRCONCC,SRI,SRND,SRSINED
|
|
S SRSINED=0,SRND=$G(^SRF(SRCASE,"TIU"))
|
|
F SRI=2,4 S SRTIU=$P(SRND,"^",SRI) I SRTIU,$$STATUS(SRTIU)=7 S SRSINED=1 Q
|
|
S SRCONCC=$P($G(^SRF(SRCASE,"CON")),"^") I SRCONCC D
|
|
.S SRND=$G(^SRF(SRCONCC,"TIU"))
|
|
.F SRI=2,4 S SRTIU=$P(SRND,"^",SRI) I SRTIU,$$STATUS(SRTIU)=7 S SRSINED=1 Q
|
|
Q SRSINED
|