SROATM4.m

SROATM4 ;BIR/MAM - CREATE MESSAGES ;03/10/11

 ;;3.0;Surgery;**27,38,62,125,153,175,200**;24 Jun 93;Build 9

 ;** NOTICE: This routine is part of an implementation of a nationally

 ;**         controlled procedure. Local modifications to this routine

 ;**         are prohibited.

 ;

 S SHEMP=3,SRAMNUM=0 F I=0:0 S SRAMNUM=$O(^TMP("SRA",$J,SRAMNUM)) Q:'SRAMNUM  D MSG

STATUS ; update status

 S (SRAMNUM,SRASS)=0

 F  S SRAMNUM=$O(^TMP("SRA",$J,SRAMNUM)) Q:'SRAMNUM  S SRACNT=0 F  S SRACNT=$O(^TMP("SRA",$J,SRAMNUM,SRACNT)) Q:'SRACNT  S CURLEY=$E(^TMP("SRA",$J,SRAMNUM,SRACNT,0),12,14),CURLEY=$P(CURLEY," ",3) I +CURLEY=1 D UPDATE

 I 'SRASS G END

 S X=$$ACTIVE^XUSER(DUZ) I '+X S XMDUZ=.5

 S XMSUB="RISK ASSESSMENT TRANSMISSION COMPLETE"

 S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 D NOW^%DTC S Y=% D D^DIQ S SRATIME=$E($P(Y,"@",2),1,5)

 S ^TMP("SRAMSG",$J,1,0)="The Surgery Risk Assessment Transmission was completed at "_SRATIME_".  A total",^TMP("SRAMSG",$J,2,0)="of "_SRASS_$S(SRASS=1:" assessment was ",1:" assessments were ")_"sent."

 S ^TMP("SRAMSG",$J,3,0)="  "

 S XMTEXT="^TMP(""SRAMSG"",$J," N I D ^XMD

END K ^TMP("SRA",$J),^TMP("SRAMSG",$J),SRTN D ^SRSKILL

 Q

MSG ; send message to G.SURGERY RISK at Hines

 S ISC=1 I $$PROD^XUPROD() S ISC=0

 S NAME=$G(^XMB("NETNAME")) I NAME["FORUM" S ISC=1

 I ISC S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 I 'ISC S XMY("G.RISK ASSESSMENT@FO-HINES.DOMAIN.EXT")=""

 S SRATDATE=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)

 S X=$$ACTIVE^XUSER(DUZ) I '+X S XMDUZ=.5

 S XMSUB=$P($$SITE^SROVAR,"^",2)_": SURG-"_$S($G(SR1L):"1L",1:"NC")_" ("_SRAMNUM_" OF "_SRATOTM_") "_SRATDATE,XMTEXT="^TMP(""SRA"",$J,"_SRAMNUM_"," N I D ^XMD

 Q

UPDATE ; Updating is done by the server SROASITE after acknowledgement message is received at the site from the National Database

 ; Notification message of assessments transmitted is built below

 S MM=$E(^TMP("SRA",$J,SRAMNUM,SRACNT,0),5,11) F X=1:1 S EMILY=$P(MM," ",X) Q:EMILY

 S SRASS=SRASS+1

 S DFN=$P(^SRF(EMILY,0),"^") D DEM^VADPT S SRANAME=$P(VADM(1),"^") K VADM S X=$P(^SRF(EMILY,0),"^",9),SRADT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)

 S SHEMP=SHEMP+1,^TMP("SRAMSG",$J,SHEMP,0)="ASSESSMENT: "_EMILY_"   "_$J(SRANAME,20)_"        OPERATION DATE: "_SRADT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROATM4   2272     printed  Apr 09, 2024@21:44:32                                                                                                                                                                                                     Page 2

SROATM4   ;BIR/MAM - CREATE MESSAGES ;03/10/11

 +1       ;;3.0;Surgery;**27,38,62,125,153,175,200**;24 Jun 93;Build 9

 +2       ;** NOTICE: This routine is part of an implementation of a nationally

 +3       ;**         controlled procedure. Local modifications to this routine

 +4       ;**         are prohibited.

 +5       ;

 +6        SET SHEMP=3

           SET SRAMNUM=0

           FOR I=0:0

               SET SRAMNUM=$ORDER(^TMP("SRA",$JOB,SRAMNUM))

               if 'SRAMNUM

                   QUIT 

               DO MSG

STATUS    ; update status

 +1        SET (SRAMNUM,SRASS)=0

 +2        FOR 

               SET SRAMNUM=$ORDER(^TMP("SRA",$JOB,SRAMNUM))

               if 'SRAMNUM

                   QUIT 

               SET SRACNT=0

               FOR 

                   SET SRACNT=$ORDER(^TMP("SRA",$JOB,SRAMNUM,SRACNT))

                   if 'SRACNT

                       QUIT 

                   SET CURLEY=$EXTRACT(^TMP("SRA",$JOB,SRAMNUM,SRACNT,0),12,14)

                   SET CURLEY=$PIECE(CURLEY," ",3)

                   IF +CURLEY=1

                       DO UPDATE

 +3        IF 'SRASS

               GOTO END

 +4        SET X=$$ACTIVE^XUSER(DUZ)

           IF '+X

               SET XMDUZ=.5

 +5        SET XMSUB="RISK ASSESSMENT TRANSMISSION COMPLETE"

 +6        SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 +7        DO NOW^%DTC

           SET Y=%

           DO D^DIQ

           SET SRATIME=$EXTRACT($PIECE(Y,"@",2),1,5)

 +8        SET ^TMP("SRAMSG",$JOB,1,0)="The Surgery Risk Assessment Transmission was completed at "_SRATIME_".  A total"

           SET ^TMP("SRAMSG",$JOB,2,0)="of "_SRASS_$SELECT(SRASS=1:" assessment was ",1:" assessments were ")_"sent."

 +9        SET ^TMP("SRAMSG",$JOB,3,0)="  "

 +10       SET XMTEXT="^TMP(""SRAMSG"",$J,"

           NEW I

           DO ^XMD

END        KILL ^TMP("SRA",$JOB),^TMP("SRAMSG",$JOB),SRTN

           DO ^SRSKILL

 +1        QUIT 

MSG       ; send message to G.SURGERY RISK at Hines

 +1        SET ISC=1

           IF $$PROD^XUPROD()

               SET ISC=0

 +2        SET NAME=$GET(^XMB("NETNAME"))

           IF NAME["FORUM"

               SET ISC=1

 +3        IF ISC

               SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 +4        IF 'ISC

               SET XMY("G.RISK ASSESSMENT@FO-HINES.DOMAIN.EXT")=""

 +5        SET SRATDATE=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)

 +6        SET X=$$ACTIVE^XUSER(DUZ)

           IF '+X

               SET XMDUZ=.5

 +7        SET XMSUB=$PIECE($$SITE^SROVAR,"^",2)_": SURG-"_$SELECT($GET(SR1L):"1L",1:"NC")_" ("_SRAMNUM_" OF "_SRATOTM_") "_SRATDATE

           SET XMTEXT="^TMP(""SRA"",$J,"_SRAMNUM_","

           NEW I

           DO ^XMD

 +8        QUIT 

UPDATE    ; Updating is done by the server SROASITE after acknowledgement message is received at the site from the National Database

 +1       ; Notification message of assessments transmitted is built below

 +2        SET MM=$EXTRACT(^TMP("SRA",$JOB,SRAMNUM,SRACNT,0),5,11)

           FOR X=1:1

               SET EMILY=$PIECE(MM," ",X)

               if EMILY

                   QUIT 

 +3        SET SRASS=SRASS+1

 +4        SET DFN=$PIECE(^SRF(EMILY,0),"^")

           DO DEM^VADPT

           SET SRANAME=$PIECE(VADM(1),"^")

           KILL VADM

           SET X=$PIECE(^SRF(EMILY,0),"^",9)

           SET SRADT=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)

 +5        SET SHEMP=SHEMP+1

           SET ^TMP("SRAMSG",$JOB,SHEMP,0)="ASSESSMENT: "_EMILY_"   "_$JUSTIFY(SRANAME,20)_"        OPERATION DATE: "_SRADT

 +6        QUIT