SR93UTL ;BIR/ADM - Post-install process for SR*3*93 ; [ 02/17/00 8:04 AM ]
;;3.0; Surgery ;**93**;24 Jun 93
;
; Reference to ^DGPM("APTT1" supported by DBIA #565
; Reference to File #405 supported by DBIA #3029
;
Q
EN1 ; transmit transfer sites, address & phone number
K ^TMP("SRA",$J),^TMP("SR93",$J) S SRASITE=+$P($$SITE^SROVAR,"^",3),SRACNT=1
S SRADFN=0 F S SRADFN=$O(^SRF("ARS","C","T",SRADFN)) Q:'SRADFN S SRTN=0 F S SRTN=$O(^SRF("ARS","C","T",SRADFN,SRTN)) Q:'SRTN S ^TMP("SR93",$J,SRTN)=""
S SRTN=0 F S SRTN=$O(^TMP("SR93",$J,SRTN)) Q:'SRTN D STUFF
I SRACNT=1 G END
D MSG
END K ^TMP("SR93",$J),^TMP("SRA",$J),DA,DFN,DIC,DIQ,DR,I,ISC,NAME,SR,SR24,SRACNT,SRADFN,SRASITE,SRD,SRDT,SRFOL,SRFOLP,SRREF,SRREFP,SRSDATE,SRTN,SRX,SRY,VA,VAIP,VAPA,X,XMSUB,XMTEXT
EN2 ; transmit intubated ? (y/n) for fy2000 cases
S SITE=+$P($$SITE^SROVAR,"^",3),SRI=0,SROPD=2991000
F S SROPD=$O(^SRF("AC",SROPD)) Q:'SROPD S SRTN=0 F S SRTN=$O(^SRF("AC",SROPD,SRTN)) Q:'SRTN I $P($G(^SRF(SRTN,.4)),"^",2)="T" D
.K SRP F I=1:1:7 S SRP(I)=""
.S SRA=$G(^SRF(SRTN,0)) Q:SRA="" S SRP(1)=SITE,SRP(2)=SRTN,DFN=$P(SRA,"^"),SRP(5)=$P(SRA,"^",9) D DEM^VADPT S SRP(4)=VA("PID")
.S X=$$SITE^SROUTL0(SRTN),SRDIV=$S(X:$P(^SRO(133,X,0),"^"),1:""),SRP(3)=$S(SRDIV:$$GET1^DIQ(4,SRDIV,99),1:SITE)
.K SRTECH,SRZ S SRT=0 F S SRT=$O(^SRF(SRTN,6,SRT)) Q:'SRT D ^SROPRIN Q:$D(SRZ)
.I $D(SRTECH) S SRP(6)=SRTECH,SRP(7)=$P($G(^SRF(SRTN,6,SRT,8)),"^",2)
.S SRTMP=SRP(1) F I=2:1:7 S SRTMP=SRTMP_"^"_SRP(I)
.S SRI=SRI+1,^TMP("SRA",$J,SRI)=SRTMP
S ISC=0,NAME=$G(^XMB("NETNAME")) I NAME["FORUM"!(NAME["ISC-")!($E(NAME,1,3)="ISC")!(NAME["ISC.") S ISC=1
I ISC S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
I 'ISC S XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""
S SRD=^XMB("NETNAME") S XMSUB="** SR*3*93-N FROM VAMC-"_SITE_" **",XMDUZ=$S($D(DUZ):DUZ,1:.5)
S XMTEXT="^TMP(""SRA"",$J," N I D ^XMD
K ^TMP("SRA",$J) S ZTREQ="@"
Q
STUFF ; stuff entries into ^TMP("SRA"
S SR=^SRF(SRTN,0),DFN=$P(SR,"^"),SRSDATE=$P(SR,"^",9) D DEM^VADPT,ADD^VADPT S SRZIP=$S(VAPA(11)'="":$P(VAPA(11),"^",2),1:VAPA(6))
S (SRREF,SRREFP,SRFOL,SRFOLP)="",VAIP("D")=SRSDATE D IN5^VADPT
I 'VAIP(13) S X1=$P($G(^SRF(SRTN,.2)),"^",12),X2=1 D C^%DTC S SR24=X,SRDT=$O(^DGPM("APTT1",DFN,SRSDATE)) G:'SRDT!(SRDT>SR24) TS S VAIP("D")=SRDT D IN5^VADPT
TS I VAIP(13) K DA,DIC,DIQ,DR S DIC=405,DR=.05,DA=VAIP(13),DIQ="SRY",DIQ(0)="IE" D EN^DIQ1 S SRREF=SRY(405,VAIP(13),.05,"E"),SRREFP=SRY(405,VAIP(13),.05,"I") I SRREFP S SRREFP=$$GET1^DIQ(4,SRREFP,99)
I VAIP(17) K DA,DIC,DIQ,DR,SRY S DIC=405,DR=.05,DA=VAIP(17),DIQ="SRY",DIQ(0)="IE" D EN^DIQ1 S SRFOL=SRY(405,VAIP(17),.05,"E"),SRFOLP=SRY(405,VAIP(17),.05,"I") I SRFOLP S SRFOLP=$$GET1^DIQ(4,SRFOLP,99)
K DA,DIC,DIQ,DR,SRY S SRX=$P(VAPA(5),"^") I SRX S DIC=5,DA=SRX,DR=1,DIQ="SRY",DIQ(0)="E" D EN^DIQ1 S SRX=SRY(5,$P(VAPA(5),"^"),1,"E")
S ^TMP("SRA",$J,SRACNT)=SRASITE_"^"_SRTN_"^1^"_$E(SRSDATE,1,7)_"^"_VA("PID")_"^"_VAPA(1)_"^"_SRREFP_"^",SRACNT=SRACNT+1
S ^TMP("SRA",$J,SRACNT)=SRASITE_"^"_SRTN_"^2^"_VAPA(2)_"^"_VAPA(3)_"^",SRACNT=SRACNT+1
S ^TMP("SRA",$J,SRACNT)=SRASITE_"^"_SRTN_"^3^"_VAPA(4)_"^"_SRX_"^"_SRZIP_"^"_SRREF_"^",SRACNT=SRACNT+1
S ^TMP("SRA",$J,SRACNT)=SRASITE_"^"_SRTN_"^4^"_VAPA(8)_"^"_SRFOL_"^"_SRFOLP_"^",SRACNT=SRACNT+1
Q
MSG ; create mail message to Denver
S ISC=0,NAME=$G(^XMB("NETNAME")) I NAME["FORUM"!(NAME["ISC-")!($E(NAME,1,3)="ISC")!(NAME["ISC.") S ISC=1
I ISC S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
I 'ISC S (XMY("G.CARDIAC RISK ASSESSMENTS@DENVER.DOMAIN.EXT"),XMY("G.SRCARDIAC@ISC-CHICAGO.DOMAIN.EXT"))=""
S SRD=^XMB("NETNAME") S XMSUB="** SR*3*93 FROM VAMC-"_SRASITE_" **",XMDUZ=$S($D(DUZ):DUZ,1:.5)
S XMTEXT="^TMP(""SRA"",$J," N I D ^XMD
Q
POST ; post-install action for SR*3*93
N SRD S SRD=^XMB("NETNAME") I SRD["TST."!(SRD["TEST")!(SRD["UTL.")!(SRD["TRAIN")!(SRD[".IHS.GOV")!(SRD["CPRS") Q
D NOW^%DTC S ZTDTH=$E(%,1,12),ZTRTN="EN1^SR93UTL",ZTDESC="Surgery Risk Assessment Retransmission",ZTIO="" D ^%ZTLOAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR93UTL 4024 printed Sep 23, 2025@20:15:23 Page 2
SR93UTL ;BIR/ADM - Post-install process for SR*3*93 ; [ 02/17/00 8:04 AM ]
+1 ;;3.0; Surgery ;**93**;24 Jun 93
+2 ;
+3 ; Reference to ^DGPM("APTT1" supported by DBIA #565
+4 ; Reference to File #405 supported by DBIA #3029
+5 ;
+6 QUIT
EN1 ; transmit transfer sites, address & phone number
+1 KILL ^TMP("SRA",$JOB),^TMP("SR93",$JOB)
SET SRASITE=+$PIECE($$SITE^SROVAR,"^",3)
SET SRACNT=1
+2 SET SRADFN=0
FOR
SET SRADFN=$ORDER(^SRF("ARS","C","T",SRADFN))
if 'SRADFN
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("ARS","C","T",SRADFN,SRTN))
if 'SRTN
QUIT
SET ^TMP("SR93",$JOB,SRTN)=""
+3 SET SRTN=0
FOR
SET SRTN=$ORDER(^TMP("SR93",$JOB,SRTN))
if 'SRTN
QUIT
DO STUFF
+4 IF SRACNT=1
GOTO END
+5 DO MSG
END KILL ^TMP("SR93",$JOB),^TMP("SRA",$JOB),DA,DFN,DIC,DIQ,DR,I,ISC,NAME,SR,SR24,SRACNT,SRADFN,SRASITE,SRD,SRDT,SRFOL,SRFOLP,SRREF,SRREFP,SRSDATE,SRTN,SRX,SRY,VA,VAIP,VAPA,X,XMSUB,XMTEXT
EN2 ; transmit intubated ? (y/n) for fy2000 cases
+1 SET SITE=+$PIECE($$SITE^SROVAR,"^",3)
SET SRI=0
SET SROPD=2991000
+2 FOR
SET SROPD=$ORDER(^SRF("AC",SROPD))
if 'SROPD
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SROPD,SRTN))
if 'SRTN
QUIT
IF $PIECE($GET(^SRF(SRTN,.4)),"^",2)="T"
Begin DoDot:1
+3 KILL SRP
FOR I=1:1:7
SET SRP(I)=""
+4 SET SRA=$GET(^SRF(SRTN,0))
if SRA=""
QUIT
SET SRP(1)=SITE
SET SRP(2)=SRTN
SET DFN=$PIECE(SRA,"^")
SET SRP(5)=$PIECE(SRA,"^",9)
DO DEM^VADPT
SET SRP(4)=VA("PID")
+5 SET X=$$SITE^SROUTL0(SRTN)
SET SRDIV=$SELECT(X:$PIECE(^SRO(133,X,0),"^"),1:"")
SET SRP(3)=$SELECT(SRDIV:$$GET1^DIQ(4,SRDIV,99),1:SITE)
+6 KILL SRTECH,SRZ
SET SRT=0
FOR
SET SRT=$ORDER(^SRF(SRTN,6,SRT))
if 'SRT
QUIT
DO ^SROPRIN
if $DATA(SRZ)
QUIT
+7 IF $DATA(SRTECH)
SET SRP(6)=SRTECH
SET SRP(7)=$PIECE($GET(^SRF(SRTN,6,SRT,8)),"^",2)
+8 SET SRTMP=SRP(1)
FOR I=2:1:7
SET SRTMP=SRTMP_"^"_SRP(I)
+9 SET SRI=SRI+1
SET ^TMP("SRA",$JOB,SRI)=SRTMP
End DoDot:1
+10 SET ISC=0
SET NAME=$GET(^XMB("NETNAME"))
IF NAME["FORUM"!(NAME["ISC-")!($EXTRACT(NAME,1,3)="ISC")!(NAME["ISC.")
SET ISC=1
+11 IF ISC
SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
+12 IF 'ISC
SET XMY("G.SRCOSERV@ISC-CHICAGO.DOMAIN.EXT")=""
+13 SET SRD=^XMB("NETNAME")
SET XMSUB="** SR*3*93-N FROM VAMC-"_SITE_" **"
SET XMDUZ=$SELECT($DATA(DUZ):DUZ,1:.5)
+14 SET XMTEXT="^TMP(""SRA"",$J,"
NEW I
DO ^XMD
+15 KILL ^TMP("SRA",$JOB)
SET ZTREQ="@"
+16 QUIT
STUFF ; stuff entries into ^TMP("SRA"
+1 SET SR=^SRF(SRTN,0)
SET DFN=$PIECE(SR,"^")
SET SRSDATE=$PIECE(SR,"^",9)
DO DEM^VADPT
DO ADD^VADPT
SET SRZIP=$SELECT(VAPA(11)'="":$PIECE(VAPA(11),"^",2),1:VAPA(6))
+2 SET (SRREF,SRREFP,SRFOL,SRFOLP)=""
SET VAIP("D")=SRSDATE
DO IN5^VADPT
+3 IF 'VAIP(13)
SET X1=$PIECE($GET(^SRF(SRTN,.2)),"^",12)
SET X2=1
DO C^%DTC
SET SR24=X
SET SRDT=$ORDER(^DGPM("APTT1",DFN,SRSDATE))
if 'SRDT!(SRDT>SR24)
GOTO TS
SET VAIP("D")=SRDT
DO IN5^VADPT
TS IF VAIP(13)
KILL DA,DIC,DIQ,DR
SET DIC=405
SET DR=.05
SET DA=VAIP(13)
SET DIQ="SRY"
SET DIQ(0)="IE"
DO EN^DIQ1
SET SRREF=SRY(405,VAIP(13),.05,"E")
SET SRREFP=SRY(405,VAIP(13),.05,"I")
IF SRREFP
SET SRREFP=$$GET1^DIQ(4,SRREFP,99)
+1 IF VAIP(17)
KILL DA,DIC,DIQ,DR,SRY
SET DIC=405
SET DR=.05
SET DA=VAIP(17)
SET DIQ="SRY"
SET DIQ(0)="IE"
DO EN^DIQ1
SET SRFOL=SRY(405,VAIP(17),.05,"E")
SET SRFOLP=SRY(405,VAIP(17),.05,"I")
IF SRFOLP
SET SRFOLP=$$GET1^DIQ(4,SRFOLP,99)
+2 KILL DA,DIC,DIQ,DR,SRY
SET SRX=$PIECE(VAPA(5),"^")
IF SRX
SET DIC=5
SET DA=SRX
SET DR=1
SET DIQ="SRY"
SET DIQ(0)="E"
DO EN^DIQ1
SET SRX=SRY(5,$PIECE(VAPA(5),"^"),1,"E")
+3 SET ^TMP("SRA",$JOB,SRACNT)=SRASITE_"^"_SRTN_"^1^"_$EXTRACT(SRSDATE,1,7)_"^"_VA("PID")_"^"_VAPA(1)_"^"_SRREFP_"^"
SET SRACNT=SRACNT+1
+4 SET ^TMP("SRA",$JOB,SRACNT)=SRASITE_"^"_SRTN_"^2^"_VAPA(2)_"^"_VAPA(3)_"^"
SET SRACNT=SRACNT+1
+5 SET ^TMP("SRA",$JOB,SRACNT)=SRASITE_"^"_SRTN_"^3^"_VAPA(4)_"^"_SRX_"^"_SRZIP_"^"_SRREF_"^"
SET SRACNT=SRACNT+1
+6 SET ^TMP("SRA",$JOB,SRACNT)=SRASITE_"^"_SRTN_"^4^"_VAPA(8)_"^"_SRFOL_"^"_SRFOLP_"^"
SET SRACNT=SRACNT+1
+7 QUIT
MSG ; create mail message to Denver
+1 SET ISC=0
SET NAME=$GET(^XMB("NETNAME"))
IF NAME["FORUM"!(NAME["ISC-")!($EXTRACT(NAME,1,3)="ISC")!(NAME["ISC.")
SET ISC=1
+2 IF ISC
SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
+3 IF 'ISC
SET (XMY("G.CARDIAC RISK ASSESSMENTS@DENVER.DOMAIN.EXT"),XMY("G.SRCARDIAC@ISC-CHICAGO.DOMAIN.EXT"))=""
+4 SET SRD=^XMB("NETNAME")
SET XMSUB="** SR*3*93 FROM VAMC-"_SRASITE_" **"
SET XMDUZ=$SELECT($DATA(DUZ):DUZ,1:.5)
+5 SET XMTEXT="^TMP(""SRA"",$J,"
NEW I
DO ^XMD
+6 QUIT
POST ; post-install action for SR*3*93
+1 NEW SRD
SET SRD=^XMB("NETNAME")
IF SRD["TST."!(SRD["TEST")!(SRD["UTL.")!(SRD["TRAIN")!(SRD[".IHS.GOV")!(SRD["CPRS")
QUIT
+2 DO NOW^%DTC
SET ZTDTH=$EXTRACT(%,1,12)
SET ZTRTN="EN1^SR93UTL"
SET ZTDESC="Surgery Risk Assessment Retransmission"
SET ZTIO=""
DO ^%ZTLOAD
+3 QUIT
