- 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 Mar 13, 2025@21:44:07 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
