SROESUTL.m

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

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