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 ---[H[J[2J[HSR83UTL 1464 printed Nov 22, 2024@17:48:54 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
