SRTPTMIT ;BIR/SJA - TRANSMIT ASSESSMENT ;04/29/08
;;3.0; Surgery ;**167**;24 Jun 93;Build 27
;
START K TMP("SRA",$J),TMP("SRAMSG",$J) S SRATOT=0,SRASITE=+$P($$SITE^SROVAR,"^",3),(SRAMNUM,SRACNT)=1
Q
ONE ; tranmit single entry
D START
S SRADFN=0 S SR("RA")=$G(^SRT(SRTPP,"RA")) D STUFF
K TMP("SRA",$J),TMP("SRAMSG",$J),SRTPP D ^SRSKILL
Q
NIGHT ; called by nightly background task
D START
S SRATP="" F S SRATP=$O(^SRT("AF",SRATP)) Q:SRATP="" S SRAST="" F S SRAST=$O(^SRT("AF",SRATP,SRAST)) Q:SRAST="" D
.S SRADFN=0 F S SRADFN=$O(^SRT("AF",SRATP,SRAST,SRADFN)) Q:'SRADFN S SRTPP=0 F S SRTPP=$O(^SRT("AF",SRATP,SRAST,SRADFN,SRTPP)) Q:'SRTPP D
..S SR("RA")=$G(^SRT(SRTPP,"RA")) I $P(SR("RA"),"^")="C" S (SRAMNUM,SRACNT)=1 D STUFF
K TMP("SRA",$J),TMP("SRAMSG",$J),SRTPP D ^SRSKILL
Q
STUFF ; stuff entries into TMP("SRA"
I SRACNT+15>100 S SRACNT=1,SRAMNUM=SRAMNUM+1
S SRATOT=SRATOT+1
K SRA,VADM D ^SRTPTM1 K SRSHEMP,VADM,SRA
S SRATOTM=SRAMNUM D PTM2
I $D(ZTQUEUED) S ZTREQ="@"
Q
PTM2 S SRSHEMP=3,SRAMNUM=0 F I=0:0 S SRAMNUM=$O(TMP("SRA",$J,SRAMNUM)) Q:'SRAMNUM D ORG,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 SRCURL=$E(TMP("SRA",$J,SRAMNUM,SRACNT,0),12,14),SRCURL=$P(SRCURL," ",3) I +SRCURL=1 D UPDATE
I 'SRASS G END
S X=$$ACTIVE^XUSER(DUZ) I '+X S XMDUZ=.5
S XMSUB="TRANSPLANT ASSESSMENT TRANSMISSION COMPLETE"
S XMY("G.SR TRANSPLANT@"_^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 Transplant Assessment Transmission was completed at "_SRATIME_"."
S TMP("SRAMSG",$J,3,0)=" "
S XMTEXT="TMP(""SRAMSG"",$J," N I D ^XMD
END Q
MSG ; send message to Denver and Hines
S ISC=0,NAME=$G(^XMB("NETNAME")) I NAME["FORUM"!(NAME["ISC-")!($E(NAME,1,3)="ISC")!(NAME["ISC.")!(NAME["TST")!(NAME["FO-") S ISC=1
I ISC S XMY("G.SR TRANSPLANT@"_^XMB("NETNAME"))=""
I 'ISC,SRORG="H" D ;heart transplant
.S (XMY("G.CARDIAC RISK ASSESSMENTS@DENVER.DOMAIN.EXT"),XMY("G.SRTRANSPLANT@FO-HINES.DOMAIN.EXT"))=""
I 'ISC,SRORG'="H" D ;kidney/lung/liver transplant (non-cardiac)
.S XMY("G.SRTRANSPLANT@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)_": "_$$TR^SRTPUTL(SRORG)_" TRANSPLANT "_SRATDATE,XMTEXT="TMP(""SRA"",$J,"_SRAMNUM_"," N I D ^XMD
Q
UPDATE ; Updating is done by the server SRTPSITE 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 SREMIL=$P(MM," ",X) Q:SREMIL
S SRASS=SRASS+1
S DFN=$P(^SRT(SREMIL,0),"^") D DEM^VADPT S SRANAME=$P(VADM(1),"^") K VADM S X=$P(^SRT(SREMIL,0),"^",2),SRADT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
S SRSHEMP=SRSHEMP+1,TMP("SRAMSG",$J,SRSHEMP,0)="TRANSPLANT #: "_SREMIL_" "_$J(SRANAME,20)_" TRANSPLANT DATE: "_SRADT
Q
ORG S XX=$E(TMP("SRA",$J,SRAMNUM,1,0),69,70) S SRORG=$S(XX=" K":"K",XX=" H":"H",1:XX)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPTMIT 3176 printed Nov 22, 2024@17:58:56 Page 2
SRTPTMIT ;BIR/SJA - TRANSMIT ASSESSMENT ;04/29/08
+1 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
+2 ;
START KILL TMP("SRA",$JOB),TMP("SRAMSG",$JOB)
SET SRATOT=0
SET SRASITE=+$PIECE($$SITE^SROVAR,"^",3)
SET (SRAMNUM,SRACNT)=1
+1 QUIT
ONE ; tranmit single entry
+1 DO START
+2 SET SRADFN=0
SET SR("RA")=$GET(^SRT(SRTPP,"RA"))
DO STUFF
+3 KILL TMP("SRA",$JOB),TMP("SRAMSG",$JOB),SRTPP
DO ^SRSKILL
+4 QUIT
NIGHT ; called by nightly background task
+1 DO START
+2 SET SRATP=""
FOR
SET SRATP=$ORDER(^SRT("AF",SRATP))
if SRATP=""
QUIT
SET SRAST=""
FOR
SET SRAST=$ORDER(^SRT("AF",SRATP,SRAST))
if SRAST=""
QUIT
Begin DoDot:1
+3 SET SRADFN=0
FOR
SET SRADFN=$ORDER(^SRT("AF",SRATP,SRAST,SRADFN))
if 'SRADFN
QUIT
SET SRTPP=0
FOR
SET SRTPP=$ORDER(^SRT("AF",SRATP,SRAST,SRADFN,SRTPP))
if 'SRTPP
QUIT
Begin DoDot:2
+4 SET SR("RA")=$GET(^SRT(SRTPP,"RA"))
IF $PIECE(SR("RA"),"^")="C"
SET (SRAMNUM,SRACNT)=1
DO STUFF
End DoDot:2
End DoDot:1
+5 KILL TMP("SRA",$JOB),TMP("SRAMSG",$JOB),SRTPP
DO ^SRSKILL
+6 QUIT
STUFF ; stuff entries into TMP("SRA"
+1 IF SRACNT+15>100
SET SRACNT=1
SET SRAMNUM=SRAMNUM+1
+2 SET SRATOT=SRATOT+1
+3 KILL SRA,VADM
DO ^SRTPTM1
KILL SRSHEMP,VADM,SRA
+4 SET SRATOTM=SRAMNUM
DO PTM2
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
PTM2 SET SRSHEMP=3
SET SRAMNUM=0
FOR I=0:0
SET SRAMNUM=$ORDER(TMP("SRA",$JOB,SRAMNUM))
if 'SRAMNUM
QUIT
DO ORG
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 SRCURL=$EXTRACT(TMP("SRA",$JOB,SRAMNUM,SRACNT,0),12,14)
SET SRCURL=$PIECE(SRCURL," ",3)
IF +SRCURL=1
DO UPDATE
+3 IF 'SRASS
GOTO END
+4 SET X=$$ACTIVE^XUSER(DUZ)
IF '+X
SET XMDUZ=.5
+5 SET XMSUB="TRANSPLANT ASSESSMENT TRANSMISSION COMPLETE"
+6 SET XMY("G.SR TRANSPLANT@"_^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 Transplant Assessment Transmission was completed at "_SRATIME_"."
+9 SET TMP("SRAMSG",$JOB,3,0)=" "
+10 SET XMTEXT="TMP(""SRAMSG"",$J,"
NEW I
DO ^XMD
END QUIT
MSG ; send message to Denver and Hines
+1 SET ISC=0
SET NAME=$GET(^XMB("NETNAME"))
IF NAME["FORUM"!(NAME["ISC-")!($EXTRACT(NAME,1,3)="ISC")!(NAME["ISC.")!(NAME["TST")!(NAME["FO-")
SET ISC=1
+2 IF ISC
SET XMY("G.SR TRANSPLANT@"_^XMB("NETNAME"))=""
+3 ;heart transplant
IF 'ISC
IF SRORG="H"
Begin DoDot:1
+4 SET (XMY("G.CARDIAC RISK ASSESSMENTS@DENVER.DOMAIN.EXT"),XMY("G.SRTRANSPLANT@FO-HINES.DOMAIN.EXT"))=""
End DoDot:1
+5 ;kidney/lung/liver transplant (non-cardiac)
IF 'ISC
IF SRORG'="H"
Begin DoDot:1
+6 SET XMY("G.SRTRANSPLANT@FO-HINES.DOMAIN.EXT")=""
End DoDot:1
+7 SET SRATDATE=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+8 SET X=$$ACTIVE^XUSER(DUZ)
IF '+X
SET XMDUZ=.5
+9 SET XMSUB=$PIECE($$SITE^SROVAR,"^",2)_": "_$$TR^SRTPUTL(SRORG)_" TRANSPLANT "_SRATDATE
SET XMTEXT="TMP(""SRA"",$J,"_SRAMNUM_","
NEW I
DO ^XMD
+10 QUIT
UPDATE ; Updating is done by the server SRTPSITE 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 SREMIL=$PIECE(MM," ",X)
if SREMIL
QUIT
+3 SET SRASS=SRASS+1
+4 SET DFN=$PIECE(^SRT(SREMIL,0),"^")
DO DEM^VADPT
SET SRANAME=$PIECE(VADM(1),"^")
KILL VADM
SET X=$PIECE(^SRT(SREMIL,0),"^",2)
SET SRADT=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+5 SET SRSHEMP=SRSHEMP+1
SET TMP("SRAMSG",$JOB,SRSHEMP,0)="TRANSPLANT #: "_SREMIL_" "_$JUSTIFY(SRANAME,20)_" TRANSPLANT DATE: "_SRADT
+6 QUIT
ORG SET XX=$EXTRACT(TMP("SRA",$JOB,SRAMNUM,1,0),69,70)
SET SRORG=$SELECT(XX=" K":"K",XX=" H":"H",1:XX)
+1 QUIT
