source: WorldVistAEHR/trunk/r/SURGERY-SR/SROESUTL.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: 2.1 KB
Line 
1SROESUTL ;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 ;
9TIU ; 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
13DELETE(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
22AT N SRY S SRY(130,SROP_",",SRFLD)="@" D FILE^DIE("","SRY")
23 Q
24RETRACT(SRTIU) ; retraction action
25 D DELETE(SRTIU),ALERT(SRTIU)
26 Q
27ALERT(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
34ACTION ; 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
43STATUS(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
47SIGNED(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
Note: See TracBrowser for help on using the repository browser.