SROESXA.m

SROESXA ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 03/02/04  09:23 AM ]

 ;;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 $$WHATITLE^TIUPUTU supported by DBIA #3351

 ; Reference to DELETE^TIUSRVP supported by DBIA #3535

 ; Reference to MAKE^TIUSRVP supported by DBIA #3535

 ; Reference to UPDATE^TIUSRVP supported by DBIA #3535

 ;

 Q

AESA ; set logic for AESA cross-reference

 N SRDIV,SRINUSE,SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 S SRTN=DA I $P($G(^SRF(SRTN,"NON")),"^")="Y" Q

 Q:'$$INUSE(SRTN)

 S ZTDESC="Surgery Anesthesia Report Stub",ZTRTN="AR^SROESXA",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD

 Q

INUSE(SRTN) ; is anesthesia report in use at this division?

 N SRDIV,SRINUSE

 S SRINUSE=0,SRDIV=$$SITE^SROUTL0(SRTN) S:SRDIV SRINUSE=$P($G(^SRO(133,SRDIV,.1)),"^",4)

 Q SRINUSE

AR ; create stub entry in TIU for anesthesia report

 N DFN,DIC,SR0,SRATT,SRAY,SRD,SRDOC,SRLOC,SRPRIN,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSTR,VSIT,X,Y

 I '$P($G(^SRF(SRTN,.2)),"^",4) D END Q

 S SRD=$P($G(^SRF(SRTN,"TIU")),"^",4) I SRD D END Q

 S SRX=$$WHATITLE^TIUPUTU("ANESTHESIA REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q

 S SRDIV=$$SITE^SROUTL0(SRTN),SR0=^SRF(SRTN,0),DFN=$P(SR0,"^") D LOC

 S X=$G(^SRF(SRTN,.3)),SRPRIN=$P(X,"^"),SRATT=$P(X,"^",4)

 S SRAY(.02)=DFN,SRAY(.05)=1,SRAY(1205)=SRLOC,SRAY(1301)=$P(SR0,"^",9),SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN

 S:SRPRIN (SRAY(1202),SRAY(1204))=SRPRIN S:SRATT (SRAY(1208),SRAY(1209))=SRATT

 S X=$G(^SRF(SRTN,.2)),SRAY(.07)=$P(X,"^",10),SRAY(.08)=$P(X,"^",12)

 S VDT=$P(SR0,"^",9),VSIT=$P(SR0,"^",15),VLOC=""

 I 'VSIT S VLOC=SRLOC

 I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";"_$S(+$D(^DPT(DFN,.1)):"I",1:"E")

 D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU D

 .F  L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",4)=SRTIU L -^SRF("TIU"_SRTN) Q

 .D ALERT

END S ZTREQ="@"

 Q

LOC ; get patient location

 N SRDEF,SROR,SRT,SRWARD,VAIP,X,Y

 S VAIP("D")=$P(SR0,"^",9) D IN5^VADPT

 S SRWARD=$P(VAIP(5),"^"),(SRDEF,SRLOC)="",SROR=$P(SR0,"^",2) I SROR S SROR=$P(^SRS(SROR,0),"^")

 I SRWARD K DA,DIC,DIQ,DR S DA=SRWARD,DIC=42,DR="44",DIQ="SRT",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR S SRLOC=$G(SRT(42,SRWARD,44,"I"))

 S SRDEF=$P($G(^SRO(133,SRDIV,0)),"^",23)

 I SRDEF="" S X="SURGERY OP REPORT NON-COUNT",DIC(0)="M",DIC="^SC(" D ^DIC K DIC I +Y>0 S SRDEF=+Y

 S SRLOC=$S(SRLOC:SRLOC,SRDEF:SRDEF,SROR:SROR,1:"")

 Q

ALERT ; issue alert to anesthesia personnel

 S XQAID="SRAR-"_SRTN,XQAKILL=0 D DELETEA^XQALERT K XQAID,XQAKILL

 N X,Y,Z S X=$G(^SRF(SRTN,.3)) F Y=1,4 S Z=$P(X,"^",Y) I Z S XQA(Z)=""

 S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNM=$E($P(VADM(1),"^"),1,15)_" ("_$E($P(VADM(1),"^"))_VA("BID")_"): "

 S SRLAB=SRNM_$E($P(^SRF(SRTN,"OP"),"^"),1,25)_" (ANES REPORT ready to complete)"

 S XQAMSG=SRLAB,XQAROU="ACTION^SROESXA",XQAID="SRAR-"_SRTN,XQADATA=SRTN D SETUP^XQALERT

 Q

STATUS(SRSTAT) ; update status

 K SRAY S SRAY(.05)=SRSTAT D UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)

 Q

KAESA ; kill logic for the AESA cross-reference

 N SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK S SRTN=DA

 S ZTDESC="Surgery Anesthesia Report Delete Stub",ZTRTN="KSTUB^SROESXA",ZTIO="",ZTDTH=$H,ZTSAVE("SRTN")="" D ^%ZTLOAD

 Q

KSTUB ; delete stubs in TIU for unsigned anesthesia report

 N SRERR,SRODA,SRTIU

 S SRODA=SRTN,SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",4) I SRTIU D

 .D STATUS(5)

 .D DELETE^TIUSRVP(.SRERR,SRTIU,,1) I 'SRERR D

 ..F  L +^SRF("TIU"_SRTN):5 I $T S $P(^SRF(SRTN,"TIU"),"^",4)="" L -^SRF("TIU"_SRTN) Q

 D DELRT,END

 Q

ACTION ; action alert

 N SRTN,SRALRT K XQAKILL S SRTN=XQADATA,SRALRT=1 D ^SROARPT

 S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",4) I SRTIU,$$STATUS^SROESUTL(SRTIU)=7 D DELRT

 Q

DELRT N XQAID,XQAKILL S XQAID="SRAR-"_SRTN,XQAKILL=0 D DELETEA^XQALERT

 Q

SROESXA   ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 03/02/04  09:23 AM ]

 +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 $$WHATITLE^TIUPUTU supported by DBIA #3351

 +8       ; Reference to DELETE^TIUSRVP supported by DBIA #3535

 +9       ; Reference to MAKE^TIUSRVP supported by DBIA #3535

 +10      ; Reference to UPDATE^TIUSRVP supported by DBIA #3535

 +11      ;

 +12       QUIT 

AESA      ; set logic for AESA cross-reference

 +1        NEW SRDIV,SRINUSE,SRTN,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTSK

 +2        SET SRTN=DA

           IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"

               QUIT 

 +3        IF '$$INUSE(SRTN)

               QUIT 

 +4        SET ZTDESC="Surgery Anesthesia Report Stub"

           SET ZTRTN="AR^SROESXA"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           SET ZTSAVE("SRTN")=""

           DO ^%ZTLOAD

 +5        QUIT 

INUSE(SRTN) ; is anesthesia report in use at this division?

 +1        NEW SRDIV,SRINUSE

 +2        SET SRINUSE=0

           SET SRDIV=$$SITE^SROUTL0(SRTN)

           IF SRDIV

               SET SRINUSE=$PIECE($GET(^SRO(133,SRDIV,.1)),"^",4)

 +3        QUIT SRINUSE

AR        ; create stub entry in TIU for anesthesia report

 +1        NEW DFN,DIC,SR0,SRATT,SRAY,SRD,SRDOC,SRLOC,SRPRIN,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSTR,VSIT,X,Y

 +2        IF '$PIECE($GET(^SRF(SRTN,.2)),"^",4)

               DO END

               QUIT 

 +3        SET SRD=$PIECE($GET(^SRF(SRTN,"TIU")),"^",4)

           IF SRD

               DO END

               QUIT 

 +4        SET SRX=$$WHATITLE^TIUPUTU("ANESTHESIA REPORT")

           SET TITLE=$PIECE(SRX,"^")

           IF 'TITLE

               QUIT 

 +5        SET SRDIV=$$SITE^SROUTL0(SRTN)

           SET SR0=^SRF(SRTN,0)

           SET DFN=$PIECE(SR0,"^")

           DO LOC

 +6        SET X=$GET(^SRF(SRTN,.3))

           SET SRPRIN=$PIECE(X,"^")

           SET SRATT=$PIECE(X,"^",4)

 +7        SET SRAY(.02)=DFN

           SET SRAY(.05)=1

           SET SRAY(1205)=SRLOC

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

           SET SRAY(1405)=SRTN_";SRF("

           SET SRAY(1701)="Case #: "_SRTN

 +8        IF SRPRIN

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

           IF SRATT

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

 +9        SET X=$GET(^SRF(SRTN,.2))

           SET SRAY(.07)=$PIECE(X,"^",10)

           SET SRAY(.08)=$PIECE(X,"^",12)

 +10       SET VDT=$PIECE(SR0,"^",9)

           SET VSIT=$PIECE(SR0,"^",15)

           SET VLOC=""

 +11       IF 'VSIT

               SET VLOC=SRLOC

 +12       IF VLOC

               SET SRAY(1211)=VLOC

               SET VSTR=VLOC_";"_VDT_";"_$SELECT(+$DATA(^DPT(DFN,.1)):"I",1:"E")

 +13       DO MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$GET(VSTR),1,1)

           IF SRTIU

               Begin DoDot:1

 +14               FOR 

                       LOCK +^SRF("TIU"_SRTN):5

                       IF $TEST

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

                           LOCK -^SRF("TIU"_SRTN)

                           QUIT 

 +15               DO ALERT

               End DoDot:1

END        SET ZTREQ="@"

 +1        QUIT 

LOC       ; get patient location

 +1        NEW SRDEF,SROR,SRT,SRWARD,VAIP,X,Y

 +2        SET VAIP("D")=$PIECE(SR0,"^",9)

           DO IN5^VADPT

 +3        SET SRWARD=$PIECE(VAIP(5),"^")

           SET (SRDEF,SRLOC)=""

           SET SROR=$PIECE(SR0,"^",2)

           IF SROR

               SET SROR=$PIECE(^SRS(SROR,0),"^")

 +4        IF SRWARD

               KILL DA,DIC,DIQ,DR

               SET DA=SRWARD

               SET DIC=42

               SET DR="44"

               SET DIQ="SRT"

               SET DIQ(0)="I"

               DO EN^DIQ1

               KILL DA,DIC,DIQ,DR

               SET SRLOC=$GET(SRT(42,SRWARD,44,"I"))

 +5        SET SRDEF=$PIECE($GET(^SRO(133,SRDIV,0)),"^",23)

 +6        IF SRDEF=""

               SET X="SURGERY OP REPORT NON-COUNT"

               SET DIC(0)="M"

               SET DIC="^SC("

               DO ^DIC

               KILL DIC

               IF +Y>0

                   SET SRDEF=+Y

 +7        SET SRLOC=$SELECT(SRLOC:SRLOC,SRDEF:SRDEF,SROR:SROR,1:"")

 +8        QUIT 

ALERT     ; issue alert to anesthesia personnel

 +1        SET XQAID="SRAR-"_SRTN

           SET XQAKILL=0

           DO DELETEA^XQALERT

           KILL XQAID,XQAKILL

 +2        NEW X,Y,Z

           SET X=$GET(^SRF(SRTN,.3))

           FOR Y=1,4

               SET Z=$PIECE(X,"^",Y)

               IF Z

                   SET XQA(Z)=""

 +3        SET DFN=$PIECE(^SRF(SRTN,0),"^")

           DO DEM^VADPT

           SET SRNM=$EXTRACT($PIECE(VADM(1),"^"),1,15)_" ("_$EXTRACT($PIECE(VADM(1),"^"))_VA("BID")_"): "

 +4        SET SRLAB=SRNM_$EXTRACT($PIECE(^SRF(SRTN,"OP"),"^"),1,25)_" (ANES REPORT ready to complete)"

 +5        SET XQAMSG=SRLAB

           SET XQAROU="ACTION^SROESXA"

           SET XQAID="SRAR-"_SRTN

           SET XQADATA=SRTN

           DO SETUP^XQALERT

 +6        QUIT 

STATUS(SRSTAT) ; update status

 +1        KILL SRAY

           SET SRAY(.05)=SRSTAT

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

 +2        QUIT 

KAESA     ; kill logic for the AESA cross-reference

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

           SET SRTN=DA

 +2        SET ZTDESC="Surgery Anesthesia Report Delete Stub"

           SET ZTRTN="KSTUB^SROESXA"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           SET ZTSAVE("SRTN")=""

           DO ^%ZTLOAD

 +3        QUIT 

KSTUB     ; delete stubs in TIU for unsigned anesthesia report

 +1        NEW SRERR,SRODA,SRTIU

 +2        SET SRODA=SRTN

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

           IF SRTIU

               Begin DoDot:1

 +3                DO STATUS(5)

 +4                DO DELETE^TIUSRVP(.SRERR,SRTIU,,1)

                   IF 'SRERR

                       Begin DoDot:2

 +5                        FOR 

                               LOCK +^SRF("TIU"_SRTN):5

                               IF $TEST

                                   SET $PIECE(^SRF(SRTN,"TIU"),"^",4)=""

                                   LOCK -^SRF("TIU"_SRTN)

                                   QUIT 

                       End DoDot:2

               End DoDot:1

 +6        DO DELRT

           DO END

 +7        QUIT 

ACTION    ; action alert

 +1        NEW SRTN,SRALRT

           KILL XQAKILL

           SET SRTN=XQADATA

           SET SRALRT=1

           DO ^SROARPT

 +2        SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",4)

           IF SRTIU

               IF $$STATUS^SROESUTL(SRTIU)=7

                   DO DELRT

 +3        QUIT 

DELRT      NEW XQAID,XQAKILL

           SET XQAID="SRAR-"_SRTN

           SET XQAKILL=0

           DO DELETEA^XQALERT

 +1        QUIT