- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROESUTL 2254 printed Feb 19, 2025@00:10:10 Page 2
- SROESUTL ;BIR/ADM - SURGERY E-SIG UTILITY ;09/22/04
- +1 ;;3.0; Surgery ;**100,134**;24 Jun 93
- +2 ;** NOTICE: This routine is part of an implementation of a nationally
- +3 ;** controlled procedure. Local modifications to this routine
- +4 ;** are prohibited.
- +5 ;
- +6 ; Reference to EXTRACT^TIULQ supported by DBIA #2693
- +7 ;
- TIU ; get document specifics from TIU
- +1 DO EXTRACT^TIULQ(SRTIU,"SRT",.SRERR)
- +2 SET SRDOC=SRT(SRTIU,.01,"E")
- SET SRCASE=$PIECE(SRT(SRTIU,1405,"I"),";")
- +3 QUIT
- DELETE(SRTIU) ; delete action
- +1 NEW SR,SRCASE,SRDOC,SRERR,SRFLD,SRT
- DO TIU
- +2 SET SRFLD=$SELECT(SRDOC["OPERATION":1000,SRDOC["NURSE INTRAOP":1001,SRDOC["PROCEDURE":1002,1:1003)
- Begin DoDot:1
- +3 SET SR=$GET(^SRF(SRCASE,"TIU"))
- +4 IF SRFLD=1000
- IF $PIECE(SR,"^")=SRTIU
- DO AT
- QUIT
- +5 IF SRFLD=1001
- IF $PIECE(SR,"^",2)=SRTIU
- DO AT
- QUIT
- +6 IF SRFLD=1002
- IF $PIECE(SR,"^",3)=SRTIU
- DO AT
- QUIT
- +7 IF SRFLD=1003
- IF $PIECE(SR,"^",4)=SRTIU
- DO AT
- End DoDot:1
- +8 QUIT
- AT NEW SRY
- SET SRY(130,SROP_",",SRFLD)="@"
- DO FILE^DIE("","SRY")
- +1 QUIT
- RETRACT(SRTIU) ; retraction action
- +1 DO DELETE(SRTIU)
- DO ALERT(SRTIU)
- +2 QUIT
- ALERT(SRTIU) ; issue alert to author of document
- +1 NEW SRAUTHOR,SRDOC,SRCASE,SRERR,SRT
- +2 DO TIU
- SET SRAUTHOR=SRT(SRTIU,1202,"I")
- if 'SRAUTHOR
- QUIT
- +3 SET XQAMSG=SRDOC_" retracted on case #"_SRCASE_"."
- +4 SET XQA(SRAUTHOR)=""
- SET XQADATA=SRCASE_"^"_SRDOC
- SET XQAROU="ACTION^SROESUTL"
- +5 DO SETUP^XQALERT
- +6 QUIT
- ACTION ; alert action
- +1 if '$DATA(XQADATA)
- QUIT
- NEW DFN,SR,SRSDT,SRTN,SRDOC,SRY,VA,VADM,Y
- +2 SET SRTN=$PIECE(XQADATA,"^")
- SET SRDOC=$PIECE(XQADATA,"^",2)
- if 'SRTN!(SRDOC="")
- QUIT
- +3 SET SR=$GET(^SRF(SRTN,0))
- if SR=""
- QUIT
- +4 SET DFN=$PIECE(SR,"^")
- DO DEM^VADPT
- SET Y=$PIECE(SR,"^",9)
- DO DD^%DT
- SET SRSDT=Y
- +5 SET SRY(1)=SRDOC_" retracted on case #"_SRTN
- SET SRY(1,"F")="!!!"
- +6 SET SRY(2)=VADM(1)_" ("_VA("PID")_") Op Date: "_SRSDT
- +7 SET SRY(3)="Principal Procedure: "_$PIECE(^SRF(SRTN,"OP"),"^")
- SET SRY(4)=" "
- DO EN^DDIOL(.SRY)
- +8 QUIT
- STATUS(SRTIU) ; get signature status
- +1 NEW SRT,STATUS
- +2 DO EXTRACT^TIULQ(SRTIU,"SRT",.SRERR,".05")
- SET STATUS=SRT(SRTIU,.05,"I")
- +3 QUIT STATUS
- SIGNED(SRCASE) ;is NIR or AR on this case or on concurrent case signed?
- +1 NEW SRCONCC,SRI,SRND,SRSINED
- +2 SET SRSINED=0
- SET SRND=$GET(^SRF(SRCASE,"TIU"))
- +3 FOR SRI=2,4
- SET SRTIU=$PIECE(SRND,"^",SRI)
- IF SRTIU
- IF $$STATUS(SRTIU)=7
- SET SRSINED=1
- QUIT
- +4 SET SRCONCC=$PIECE($GET(^SRF(SRCASE,"CON")),"^")
- IF SRCONCC
- Begin DoDot:1
- +5 SET SRND=$GET(^SRF(SRCONCC,"TIU"))
- +6 FOR SRI=2,4
- SET SRTIU=$PIECE(SRND,"^",SRI)
- IF SRTIU
- IF $$STATUS(SRTIU)=7
- SET SRSINED=1
- QUIT
- End DoDot:1
- +7 QUIT SRSINED