| [613] | 1 | SROESUTL ;BIR/ADM - SURGERY E-SIG UTILITY ;09/22/04
|
|---|
| 2 | ;;3.0; Surgery ;**100,134**;24 Jun 93
|
|---|
| 3 | ;** NOTICE: This routine is part of an implementation of a nationally
|
|---|
| 4 | ;** controlled procedure. Local modifications to this routine
|
|---|
| 5 | ;** are prohibited.
|
|---|
| 6 | ;
|
|---|
| 7 | ; Reference to EXTRACT^TIULQ supported by DBIA #2693
|
|---|
| 8 | ;
|
|---|
| 9 | TIU ; get document specifics from TIU
|
|---|
| 10 | D EXTRACT^TIULQ(SRTIU,"SRT",.SRERR)
|
|---|
| 11 | S SRDOC=SRT(SRTIU,.01,"E"),SRCASE=$P(SRT(SRTIU,1405,"I"),";")
|
|---|
| 12 | Q
|
|---|
| 13 | DELETE(SRTIU) ; delete action
|
|---|
| 14 | N SR,SRCASE,SRDOC,SRERR,SRFLD,SRT D TIU
|
|---|
| 15 | S SRFLD=$S(SRDOC["OPERATION":1000,SRDOC["NURSE INTRAOP":1001,SRDOC["PROCEDURE":1002,1:1003) D
|
|---|
| 16 | .S SR=$G(^SRF(SRCASE,"TIU"))
|
|---|
| 17 | .I SRFLD=1000,$P(SR,"^")=SRTIU D AT Q
|
|---|
| 18 | .I SRFLD=1001,$P(SR,"^",2)=SRTIU D AT Q
|
|---|
| 19 | .I SRFLD=1002,$P(SR,"^",3)=SRTIU D AT Q
|
|---|
| 20 | .I SRFLD=1003,$P(SR,"^",4)=SRTIU D AT
|
|---|
| 21 | Q
|
|---|
| 22 | AT N SRY S SRY(130,SROP_",",SRFLD)="@" D FILE^DIE("","SRY")
|
|---|
| 23 | Q
|
|---|
| 24 | RETRACT(SRTIU) ; retraction action
|
|---|
| 25 | D DELETE(SRTIU),ALERT(SRTIU)
|
|---|
| 26 | Q
|
|---|
| 27 | ALERT(SRTIU) ; issue alert to author of document
|
|---|
| 28 | N SRAUTHOR,SRDOC,SRCASE,SRERR,SRT
|
|---|
| 29 | D TIU S SRAUTHOR=SRT(SRTIU,1202,"I") Q:'SRAUTHOR
|
|---|
| 30 | S XQAMSG=SRDOC_" retracted on case #"_SRCASE_"."
|
|---|
| 31 | S XQA(SRAUTHOR)="",XQADATA=SRCASE_"^"_SRDOC,XQAROU="ACTION^SROESUTL"
|
|---|
| 32 | D SETUP^XQALERT
|
|---|
| 33 | Q
|
|---|
| 34 | ACTION ; alert action
|
|---|
| 35 | Q:'$D(XQADATA) N DFN,SR,SRSDT,SRTN,SRDOC,SRY,VA,VADM,Y
|
|---|
| 36 | S SRTN=$P(XQADATA,"^"),SRDOC=$P(XQADATA,"^",2) Q:'SRTN!(SRDOC="")
|
|---|
| 37 | S SR=$G(^SRF(SRTN,0)) Q:SR=""
|
|---|
| 38 | S DFN=$P(SR,"^") D DEM^VADPT S Y=$P(SR,"^",9) D DD^%DT S SRSDT=Y
|
|---|
| 39 | S SRY(1)=SRDOC_" retracted on case #"_SRTN,SRY(1,"F")="!!!"
|
|---|
| 40 | S SRY(2)=VADM(1)_" ("_VA("PID")_") Op Date: "_SRSDT
|
|---|
| 41 | S SRY(3)="Principal Procedure: "_$P(^SRF(SRTN,"OP"),"^"),SRY(4)=" " D EN^DDIOL(.SRY)
|
|---|
| 42 | Q
|
|---|
| 43 | STATUS(SRTIU) ; get signature status
|
|---|
| 44 | N SRT,STATUS
|
|---|
| 45 | D EXTRACT^TIULQ(SRTIU,"SRT",.SRERR,".05") S STATUS=SRT(SRTIU,.05,"I")
|
|---|
| 46 | Q STATUS
|
|---|
| 47 | SIGNED(SRCASE) ;is NIR or AR on this case or on concurrent case signed?
|
|---|
| 48 | N SRCONCC,SRI,SRND,SRSINED
|
|---|
| 49 | S SRSINED=0,SRND=$G(^SRF(SRCASE,"TIU"))
|
|---|
| 50 | F SRI=2,4 S SRTIU=$P(SRND,"^",SRI) I SRTIU,$$STATUS(SRTIU)=7 S SRSINED=1 Q
|
|---|
| 51 | S SRCONCC=$P($G(^SRF(SRCASE,"CON")),"^") I SRCONCC D
|
|---|
| 52 | .S SRND=$G(^SRF(SRCONCC,"TIU"))
|
|---|
| 53 | .F SRI=2,4 S SRTIU=$P(SRND,"^",SRI) I SRTIU,$$STATUS(SRTIU)=7 S SRSINED=1 Q
|
|---|
| 54 | Q SRSINED
|
|---|
