Routine: SRO3P90

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

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")

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRO3P90   1380     printed  Mar 13, 2025@21:45:02                                                                                                                                                                                                     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

SRO3P90.m