SROESX0.m

SROESX0 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 02/13/02  12:03 PM ]

 ;;3.0; Surgery ;**100**;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 UPDATE^TIUSRVP supported by DBIA #3535

 ; Reference to EXTRACT^TIULQ supported by DBIA #2693

 ; Reference to FILE^TIUSRVP supported by DBIA #3540

 ;

 Q

SET ; set logic for AES1 and AES2 x-refs

 N SRPHY,SRSTAT,SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 S SRPHY=X2 D NEXT Q:'SRTIU

TASK ; task call to TIU

 S ZTDESC="Update Signer in TIU",ZTRTN="SIGNER^SROESX0",ZTIO="",ZTDTH=$H,(ZTSAVE("SRTIU"),ZTSAVE("SRPHY"))="" D ^%ZTLOAD

 Q

SIGNER ; make call to TIU to update author and expected signer

 D STATUS S SRAY(.05)=$S(SRSTAT:SRSTAT,1:1),(SRAY(1202),SRAY(1204))=SRPHY

 D UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)

END I $D(ZTQUEUED) S ZTREQ="@"

 Q

NEXT S SRTN=DA,SRX=$G(^SRF(SRTN,"TIU"))

 S SRTIU=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":$P(SRX,"^",3),1:$P(SRX,"^"))

 Q

STATUS ; get TIU document status

 D EXTRACT^TIULQ(SRTIU,"SRY",.SRERR,".05",1) S SRSTAT=$G(SRY(SRTIU,.05,"I"))

 Q

SET1 ; set logic for AES3 and AES4 and x-refs

 N SRPHY,SRSTAT,SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 S SRPHY=X2 D NEXT Q:'SRTIU

TASK1 ; task call to TIU

 S ZTDESC="Update Cosigner in TIU",ZTRTN="COSIG^SROESX0",ZTIO="",ZTDTH=$H,(ZTSAVE("SRTIU"),ZTSAVE("SRPHY"))="" D ^%ZTLOAD

 Q

COSIG ; make call to TIU to update attending and expected cosigner

 D STATUS S SRAY(.05)=$S(SRSTAT:SRSTAT,1:1),(SRAY(1208),SRAY(1209))=SRPHY

 D UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1) D END

 Q

SET2 ; set logic for AES5 x-ref

 N SRPHY,SRSTAT,SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 S SRPHY=X2,SRTN=DA,SRX=$G(^SRF(SRTN,"TIU")),SRTIU=$P(SRX,"^",4) Q:'SRTIU

 D TASK,ALTSK

 Q

SET3 ; set logic for AES6 x-ref

 N SRPHY,SRSTAT,SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 S SRPHY=X2,SRTN=DA,SRX=$G(^SRF(SRTN,"TIU")),SRTIU=$P(SRX,"^",4) Q:'SRTIU

 D TASK1

ALTSK S ZTDESC="Task Alerts to Anesthesia",ZTRTN="ANLRT^SROESX0",ZTIO="",ZTDTH=$H,(ZTSAVE("SRTIU"),ZTSAVE("SRTN"))="" D ^%ZTLOAD

 Q

ANLRT ; for anesthesia report, delete and re-issue alert

 N SRSTAT D STATUS I SRSTAT=1 D ALERT^SROESXA,END

 Q

SET4 ; set logic for AES7 x-ref

 N SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 S SRTN=DA(1),SRX=$G(^SRF(SRTN,"TIU")),SRTIU=$P(SRX,"^",2) Q:'SRTIU

 S ZTDESC="Update Nurse Report Signer in TIU",ZTRTN="RNSIG^SROESX0",ZTIO="",ZTDTH=$H,(ZTSAVE("SRTIU"),ZTSAVE("SRTN"))="" D ^%ZTLOAD

 S ZTDESC="Task Alerts to Circulating Nurses",ZTRTN="RNLRT^SROESX0",ZTIO="",ZTDTH=$H,(ZTSAVE("SRTIU"),ZTSAVE("SRTN"))="" D ^%ZTLOAD

 Q

RNSIG ; update signer/author of nurse report

 ; get first circulating nurse as author and expected signer

 S SRPHY="",SRRN=$O(^SRF(SRTN,19,0)) S:SRRN SRPHY=$P($G(^SRF(SRTN,19,SRRN,0)),"^")

 D SIGNER

 Q

RNLRT ; for nurse report, delete and re-issue alert

 N SRSTAT D STATUS I SRSTAT=1 D ALERT^SROESX,END

 Q

AES8 ; set logic for AES7 cross-reference

 N II,SR0,SRAY,SRTDA,SRTN,SRTIU

 S SRTN=$S($D(SRTN):SRTN,1:DA)

 S SR0=^SRF(SRTN,0),SRTIU=$G(^SRF(SRTN,"TIU")),SRAY(1301)=$P(SR0,"^",9)

 F II=1,2,3,4 I $P(SRTIU,"^",II) S SRTDA=$P(SRTIU,"^",II) D

 .D FILE^TIUSRVP(.SRERR,SRTDA,.SRAY,1)

 Q

SROESX0   ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 02/13/02  12:03 PM ]

 +1       ;;3.0; Surgery ;**100**;24 Jun 93

 +2       ;

 +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 UPDATE^TIUSRVP supported by DBIA #3535

 +8       ; Reference to EXTRACT^TIULQ supported by DBIA #2693

 +9       ; Reference to FILE^TIUSRVP supported by DBIA #3540

 +10      ;

 +11       QUIT 

SET       ; set logic for AES1 and AES2 x-refs

 +1        NEW SRPHY,SRSTAT,SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 +2        SET SRPHY=X2

           DO NEXT

           IF 'SRTIU

               QUIT 

TASK      ; task call to TIU

 +1        SET ZTDESC="Update Signer in TIU"

           SET ZTRTN="SIGNER^SROESX0"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           SET (ZTSAVE("SRTIU"),ZTSAVE("SRPHY"))=""

           DO ^%ZTLOAD

 +2        QUIT 

SIGNER    ; make call to TIU to update author and expected signer

 +1        DO STATUS

           SET SRAY(.05)=$SELECT(SRSTAT:SRSTAT,1:1)

           SET (SRAY(1202),SRAY(1204))=SRPHY

 +2        DO UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)

END        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +1        QUIT 

NEXT       SET SRTN=DA

           SET SRX=$GET(^SRF(SRTN,"TIU"))

 +1        SET SRTIU=$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":$PIECE(SRX,"^",3),1:$PIECE(SRX,"^"))

 +2        QUIT 

STATUS    ; get TIU document status

 +1        DO EXTRACT^TIULQ(SRTIU,"SRY",.SRERR,".05",1)

           SET SRSTAT=$GET(SRY(SRTIU,.05,"I"))

 +2        QUIT 

SET1      ; set logic for AES3 and AES4 and x-refs

 +1        NEW SRPHY,SRSTAT,SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 +2        SET SRPHY=X2

           DO NEXT

           IF 'SRTIU

               QUIT 

TASK1     ; task call to TIU

 +1        SET ZTDESC="Update Cosigner in TIU"

           SET ZTRTN="COSIG^SROESX0"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           SET (ZTSAVE("SRTIU"),ZTSAVE("SRPHY"))=""

           DO ^%ZTLOAD

 +2        QUIT 

COSIG     ; make call to TIU to update attending and expected cosigner

 +1        DO STATUS

           SET SRAY(.05)=$SELECT(SRSTAT:SRSTAT,1:1)

           SET (SRAY(1208),SRAY(1209))=SRPHY

 +2        DO UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)

           DO END

 +3        QUIT 

SET2      ; set logic for AES5 x-ref

 +1        NEW SRPHY,SRSTAT,SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 +2        SET SRPHY=X2

           SET SRTN=DA

           SET SRX=$GET(^SRF(SRTN,"TIU"))

           SET SRTIU=$PIECE(SRX,"^",4)

           IF 'SRTIU

               QUIT 

 +3        DO TASK

           DO ALTSK

 +4        QUIT 

SET3      ; set logic for AES6 x-ref

 +1        NEW SRPHY,SRSTAT,SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 +2        SET SRPHY=X2

           SET SRTN=DA

           SET SRX=$GET(^SRF(SRTN,"TIU"))

           SET SRTIU=$PIECE(SRX,"^",4)

           IF 'SRTIU

               QUIT 

 +3        DO TASK1

ALTSK      SET ZTDESC="Task Alerts to Anesthesia"

           SET ZTRTN="ANLRT^SROESX0"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           SET (ZTSAVE("SRTIU"),ZTSAVE("SRTN"))=""

           DO ^%ZTLOAD

 +1        QUIT 

ANLRT     ; for anesthesia report, delete and re-issue alert

 +1        NEW SRSTAT

           DO STATUS

           IF SRSTAT=1

               DO ALERT^SROESXA

               DO END

 +2        QUIT 

SET4      ; set logic for AES7 x-ref

 +1        NEW SRTN,SRTIU,SRX,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 +2        SET SRTN=DA(1)

           SET SRX=$GET(^SRF(SRTN,"TIU"))

           SET SRTIU=$PIECE(SRX,"^",2)

           IF 'SRTIU

               QUIT 

 +3        SET ZTDESC="Update Nurse Report Signer in TIU"

           SET ZTRTN="RNSIG^SROESX0"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           SET (ZTSAVE("SRTIU"),ZTSAVE("SRTN"))=""

           DO ^%ZTLOAD

 +4        SET ZTDESC="Task Alerts to Circulating Nurses"

           SET ZTRTN="RNLRT^SROESX0"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           SET (ZTSAVE("SRTIU"),ZTSAVE("SRTN"))=""

           DO ^%ZTLOAD

 +5        QUIT 

RNSIG     ; update signer/author of nurse report

 +1       ; get first circulating nurse as author and expected signer

 +2        SET SRPHY=""

           SET SRRN=$ORDER(^SRF(SRTN,19,0))

           IF SRRN

               SET SRPHY=$PIECE($GET(^SRF(SRTN,19,SRRN,0)),"^")

 +3        DO SIGNER

 +4        QUIT 

RNLRT     ; for nurse report, delete and re-issue alert

 +1        NEW SRSTAT

           DO STATUS

           IF SRSTAT=1

               DO ALERT^SROESX

               DO END

 +2        QUIT 

AES8      ; set logic for AES7 cross-reference

 +1        NEW II,SR0,SRAY,SRTDA,SRTN,SRTIU

 +2        SET SRTN=$SELECT($DATA(SRTN):SRTN,1:DA)

 +3        SET SR0=^SRF(SRTN,0)

           SET SRTIU=$GET(^SRF(SRTN,"TIU"))

           SET SRAY(1301)=$PIECE(SR0,"^",9)

 +4        FOR II=1,2,3,4

               IF $PIECE(SRTIU,"^",II)

                   SET SRTDA=$PIECE(SRTIU,"^",II)

                   Begin DoDot:1

 +5                    DO FILE^TIUSRVP(.SRERR,SRTDA,.SRAY,1)

                   End DoDot:1

 +6        QUIT