SRO3P90 ;B'HAM ISC/MAM - TRANSMIT STROKE FOR CARDIACC ASSESSMENTS ; [ 07/02/97 9:09 AM ]
;;3.0; Surgery ;**90**;24 Jun 93
K ^TMP("SRA",$J) S SRATOT=0,SRASITE=+$P($$SITE^SROVAR,"^",3),(SRAMNUM,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 D STUFF
I 'SRACNT Q
S SRATOTM=SRAMNUM D SENDMSG
K ^TMP("SRA",$J),SRADFN,SRATOT,SRACNT,SRASITE,SRAMNUM,SRTN
Q
STUFF ; stuff entries into ^TMP("SRA"
I $P($G(^SRF(SRTN,205)),"^",21)'="Y" Q
;
S SRACNT=SRACNT+1
I SRACNT>500 S SRACNT=1,SRAMNUM=SRAMNUM+1
S SRATOT=SRATOT+1 K SRA,VADM
S SRA(0)=^SRF(SRTN,0)
S DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANAME=VADM(1),Z=$P(VADM(3),"^"),SRSDATE=$P(SRA(0),"^",9),Y=$E(SRSDATE,1,7)
S ^TMP("SRA",$J,SRAMNUM,SRACNT)=$J(SRASITE,3)_$J(SRTN,10)_$J(SRSDATE,12)_VA("PID")
Q
SENDMSG ; create mail message and transmit
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")=""
S SRATDATE=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
N DIFROM S XMSUB=$P($$SITE^SROVAR,"^",2)_": STROKE/CVA ("_SRAMNUM_" OF "_SRATOTM_") "_SRATDATE,XMDUZ="RISK ASSESSMENT SCNR",XMTEXT="^TMP(""SRA"","_$J_","_SRAMNUM_"," N I D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRO3P90 1380 printed Nov 22, 2024@17:49:48 Page 2
SRO3P90 ;B'HAM ISC/MAM - TRANSMIT STROKE FOR CARDIACC ASSESSMENTS ; [ 07/02/97 9:09 AM ]
+1 ;;3.0; Surgery ;**90**;24 Jun 93
+2 KILL ^TMP("SRA",$JOB)
SET SRATOT=0
SET SRASITE=+$PIECE($$SITE^SROVAR,"^",3)
SET (SRAMNUM,SRACNT)=1
+3 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
DO STUFF
+4 IF 'SRACNT
QUIT
+5 SET SRATOTM=SRAMNUM
DO SENDMSG
+6 KILL ^TMP("SRA",$JOB),SRADFN,SRATOT,SRACNT,SRASITE,SRAMNUM,SRTN
+7 QUIT
STUFF ; stuff entries into ^TMP("SRA"
+1 IF $PIECE($GET(^SRF(SRTN,205)),"^",21)'="Y"
QUIT
+2 ;
+3 SET SRACNT=SRACNT+1
+4 IF SRACNT>500
SET SRACNT=1
SET SRAMNUM=SRAMNUM+1
+5 SET SRATOT=SRATOT+1
KILL SRA,VADM
+6 SET SRA(0)=^SRF(SRTN,0)
+7 SET DFN=$PIECE(SRA(0),"^")
NEW I
DO DEM^VADPT
SET SRANAME=VADM(1)
SET Z=$PIECE(VADM(3),"^")
SET SRSDATE=$PIECE(SRA(0),"^",9)
SET Y=$EXTRACT(SRSDATE,1,7)
+8 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT)=$JUSTIFY(SRASITE,3)_$JUSTIFY(SRTN,10)_$JUSTIFY(SRSDATE,12)_VA("PID")
+9 QUIT
SENDMSG ; create mail message and transmit
+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")=""
+4 SET SRATDATE=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+5 NEW DIFROM
SET XMSUB=$PIECE($$SITE^SROVAR,"^",2)_": STROKE/CVA ("_SRAMNUM_" OF "_SRATOTM_") "_SRATDATE
SET XMDUZ="RISK ASSESSMENT SCNR"
SET XMTEXT="^TMP(""SRA"","_$JOB_","_SRAMNUM_","
NEW I
DO ^XMD
+6 ;
+7 QUIT
