- 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.VA.GOV"),XMY("G.SRTRANSPLANT@FO-HINES.MED.VA.GOV"))=""
- I 'ISC,SRORG'="H" D ;kidney/lung/liver transplant (non-cardiac)
- .S XMY("G.SRTRANSPLANT@FO-HINES.MED.VA.GOV")=""
- 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
- 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.VA.GOV"),XMY("G.SRTRANSPLANT@FO-HINES.MED.VA.GOV"))=""
- 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.MED.VA.GOV")=""
- 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
