SR83UTL.m

SR83UTL ;BIR/ADM-Utility Routine for SR*3*83 ; [ 08/04/98  9:06 AM ]

 ;;3.0; Surgery ;**83**;24 Jun 93

 ; environmental check for SR*3*83 to confirm that SR*3*79 is installed

 I '$$PATCH^XPDUTL("SR*3.0*79") D BMES^XPDUTL("Patch SR*3*79 must be installed before installing this patch!") S XPDQUIT=2

 Q

EN1 ; transmit list of aborted 1-liner cases in the following format:

 ;   site-id^divison^assessment number^date of operation

 S SITE=+$P($$SITE^SROVAR,"^",3),SRI=0 K ^TMP("SRA",$J)

 S SRSDATE=2971000 F  S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>2981000)  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN  D

 .I $P($G(^SRF(SRTN,30)),"^")!($P($G(^SRF(SRTN,31)),"^",8)),$P($G(^SRF(SRTN,.4)),"^",2)="T" D

 ..K SRLINE S SRDIV=$P($G(^SRF(SRTN,8)),"^") I SRDIV S SRDIV=$$GET1^DIQ(4,SRDIV,99)

 ..S SRLINE=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRSDATE

 ..S SRI=SRI+1,^TMP("SRA",$J,SRI)=SRLINE

TRANS ; place list in mail message

 S XMSUB="List of Aborted 1-Liners ("_SITE_")",XMDUZ=$S(DUZ:DUZ,1:"SCNR")

 S XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""

 S XMTEXT="^TMP(""SRA"",$J," N I D ^XMD

 K ^TMP("SRA") S ZTREQ="@"

 Q

POST ; postinit action for SR*3*83

 S NAME=$G(^XMB("NETNAME")) I NAME["FORUM"!(NAME["ISC-")!($E(NAME,1,3)="ISC")!(NAME["ISC.")!(NAME["TST")!(NAME["TRAIN")!(NAME["DEMO.")!(NAME["UTL.") Q

 D NOW^%DTC S SRNOW=$E(%,1,12) S ZTRTN="EN1^SR83UTL",ZTDESC="Surgery Risk Assessment Retransmission",ZTIO="",ZTDTH=SRNOW D ^%ZTLOAD

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SR83UTL   1464     printed  Apr 09, 2024@21:47:20                                                                                                                                                                                                     Page 2

SR83UTL   ;BIR/ADM-Utility Routine for SR*3*83 ; [ 08/04/98  9:06 AM ]

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

 +2       ; environmental check for SR*3*83 to confirm that SR*3*79 is installed

 +3        IF '$$PATCH^XPDUTL("SR*3.0*79")

               DO BMES^XPDUTL("Patch SR*3*79 must be installed before installing this patch!")

               SET XPDQUIT=2

 +4        QUIT 

EN1       ; transmit list of aborted 1-liner cases in the following format:

 +1       ;   site-id^divison^assessment number^date of operation

 +2        SET SITE=+$PIECE($$SITE^SROVAR,"^",3)

           SET SRI=0

           KILL ^TMP("SRA",$JOB)

 +3        SET SRSDATE=2971000

           FOR 

               SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))

               if 'SRSDATE!(SRSDATE>2981000)

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))

                   if 'SRTN

                       QUIT 

                   Begin DoDot:1

 +4                    IF $PIECE($GET(^SRF(SRTN,30)),"^")!($PIECE($GET(^SRF(SRTN,31)),"^",8))

                           IF $PIECE($GET(^SRF(SRTN,.4)),"^",2)="T"

                               Begin DoDot:2

 +5                                KILL SRLINE

                                   SET SRDIV=$PIECE($GET(^SRF(SRTN,8)),"^")

                                   IF SRDIV

                                       SET SRDIV=$$GET1^DIQ(4,SRDIV,99)

 +6                                SET SRLINE=SITE_"^"_SRDIV_"^"_SRTN_"^"_SRSDATE

 +7                                SET SRI=SRI+1

                                   SET ^TMP("SRA",$JOB,SRI)=SRLINE

                               End DoDot:2

                   End DoDot:1

TRANS     ; place list in mail message

 +1        SET XMSUB="List of Aborted 1-Liners ("_SITE_")"

           SET XMDUZ=$SELECT(DUZ:DUZ,1:"SCNR")

 +2        SET XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""

 +3        SET XMTEXT="^TMP(""SRA"",$J,"

           NEW I

           DO ^XMD

 +4        KILL ^TMP("SRA")

           SET ZTREQ="@"

 +5        QUIT 

POST      ; postinit action for SR*3*83

 +1        SET NAME=$GET(^XMB("NETNAME"))

           IF NAME["FORUM"!(NAME["ISC-")!($EXTRACT(NAME,1,3)="ISC")!(NAME["ISC.")!(NAME["TST")!(NAME["TRAIN")!(NAME["DEMO.")!(NAME["UTL.")

               QUIT 

 +2        DO NOW^%DTC

           SET SRNOW=$EXTRACT(%,1,12)

           SET ZTRTN="EN1^SR83UTL"

           SET ZTDESC="Surgery Risk Assessment Retransmission"

           SET ZTIO=""

           SET ZTDTH=SRNOW

           DO ^%ZTLOAD

 +3        QUIT