RAXMLSND ;BPFO/DTG - NTRT MESSAGE PROCESS AND EDITS UPDATE;02/10/2016 ; 23 Sep 2016 3:43 PM
;;5.0;Radiology/Nuclear Medicine;**127,138**;Mar 16, 1998;Build 22
;
; This section is for sending the XML message to ISAAC via HTTP/HTTPS
;
; first we save to ^XTMP
Q
EN ; XTMP save
N RAXTMPNM,RAXTMPNUM,CNT,E,LACT,STATUS,ZTQUEUED,ZTREQ
S CNT=0
ENA S RAXTMPNM="RANTRTSAV"
L +^XTMP(RAXTMPNM):30 I '$T H 10 S CNT=CNT+1 G ENA:CNT<11,ENO
S ^XTMP(RAXTMPNM,0)=$$FMADD^XLFDT(DT,365)_U_$$NOW^XLFDT()_U_"Radiology New Term to NTRT STS XML"
S RAXTMPNUM=$G(^XTMP(RAXTMPNM,"CTRL")),RAXTMPNUM=RAXTMPNUM+1,^XTMP(RAXTMPNM,"CTRL")=RAXTMPNUM
L -^XTMP(RAXTMPNM)
S CNT=0
; RATEXT is the built XML send array
; RA71IEN is the file 71 Procedure IEN
; RAS is the Specimen IEN from the 60 specimen multiple (60.01)
; RADUZ is the DUZ of the person saving the test/specimen item
ENL L +^XTMP(RAXTMPNM,"SEND",RAXTMPNUM):20 I '$T H 2 S CNT=CNT+1 G ENL:CNT<11,ENO
M ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"I")=RATXT
S ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"DUZ")=RADUZ
S ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"RA71IEN")=RA71IEN
;S ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"RAS")=RAS
S ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"ERROR")=0
L -^XTMP(RAXTMPNM,"SEND",RAXTMPNUM)
ENSL L +^XTMP(RAXTMPNM,"O"):5 I '$T G ENO
N ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC
S ZTDTH=$$NOW^XLFDT,ZTDESC="RAD Send NTRT message to ISAAC"
; start RA*5.0*138 edit
S ZTSAVE("RAXTMPNM")=""
S ZTRTN="XMLSND^RAXMLSND(RAXTMPNM)",ZTIO=""
; end RA*5.0*138 edit
D ^%ZTLOAD
L -^XTMP(RAXTMPNM,"O")
K ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC
ENO K RAXTMPNM,RAXTMPNUM,CNT
Q
;
; entry to send messages to ISAAC
;
XMLSND(RAXTMPNM) ;
N CNT,A,B,C,RAT,RADUZ,RAG,RAS,RA71IEN,RAA,RATEXT,RARDAT,RASDAT,RARHD,RASHD,RAFLG,RAMETH,URL,RAXTVER
N RASITE,RANT,RANTI,AR,RANMAIL,RAGMAIL,RAIS,RAPRT,RAIPATH,LXA,LXB,RANOS1,RANOS2,RAERR,RADUZ
S CNT=0
X1 L +^XTMP(RAXTMPNM,"O"):20 I '$T S CNT=CNT+1 G X1:CNT<11,XMLOUT
I $G(DT)="" S DT=$$DT^XLFDT
; get file 71.98 current info
S RASITE=$$SITE^VASITE,RASITE=$P(RASITE,U,1)
S RANT=$O(^RAMRPF(71.98,"B",RASITE,0))
D GETS^DIQ(71.98,RANT_",","**","IE","AR")
M RANTI=AR("71.98",RANT_",") K AR
;site number and name
S RASITE=$G(RANTI(.01,"I")),RASITEN=$G(RANTI(.01,"E"))
;ntrt mail group
S RANMAIL="NTRT RADIOLOGY"
;RAD send mail group
S RAGMAIL=$G(RANTI(6,"I"))
; Isaac web address
S RAIS=$G(RANTI(11,"I"))
S AA=$$XUP(RAIS) S:$E(AA,1,4)="HTTP" RAIS=$P(RAIS,"//",2,999) S:$E(RAIS,($L(RAIS)))="/" RAIS=$E(RAIS,1,($L(RAIS)-1))
; Isaac port number
S RAPRT=$G(RANTI(10,"I"))
; Isaac path
S RAIPATH=$G(RANTI(11.5,"I")) I RAIPATH'="" D ;<
. S RAIPATH=$TR(RAIPATH,"~","/")
. S:$E(RAIPATH,1)'="/" RAIPATH="/"_RAIPATH
S URL=RAIS_":"_RAPRT_RAIPATH
; if web address or port number are nill do not send
S RANOS3=0 I $G(RANTI(11,"I"))=""!($G(RANTI(10,"I"))="") S RANOS3=1
;if no send method
S RANOS1=0 I $G(RANTI(8,"I"))="N" S RANOS1=1
S AA=$$XUP(RAGMAIL)
; if not production or not VA
S RANOS2=0 I '$$PROD^XUPROD()!(AA'["DOMAIN.EXT") S RANOS2=1
;
S RAA=0,RAXTVER=1+($$PATCH^XPDUTL("XT*7.3*138"))
S RAFLG=10
X2 S RAA=$O(^XTMP(RAXTMPNM,"SEND",RAA)) I 'RAA L -^XTMP(RAXTMPNM,"O") G XMLOUT
S CNT=0
X2A L +^XTMP(RAXTMPNM,"SEND",RAA):5 I '$T S CNT=CNT+1 G X2A:CNT<11,XMLOUT
K RAT,RARHD,RARHD,RASDAT,RASHD,REDIR
S (RARHD,RASHD,RARDAT)=""
S REDIR=0,RASHD("CONTENT-TYPE")="application/xml",STATUS=""
M RAT=^XTMP(RAXTMPNM,"SEND",RAA,"I")
S RADUZ=^XTMP(RAXTMPNM,"SEND",RAA,"DUZ"),RA71IEN=^XTMP(RAXTMPNM,"SEND",RAA,"RA71IEN")
;S RAS=^XTMP(RAXTMPNM,"SEND",RAA,"RAS"),RAERR=^XTMP(RAXTMPNM,"SEND",RAA,"ERROR")
S RAERR=^XTMP(RAXTMPNM,"SEND",RAA,"ERROR")
;
; check if ok to send a message
I RANOS1=1!(RANOS2=1)!(RANOS3=1) D NOTVALID G X2
;
S STATUS=$$GETURL^XTHC10(URL,RAFLG,"RARDAT",.RARHD,"RAT",.RASHD,$G(REDIR)+1)
S A=$TR(STATUS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
I A["OK"!(A["ACCEPTED") D G X2
.; send message to order and group that message was sent to ISAAC NTRT
. K XMY,RATEXT
. S XMSUB="NEW NTRT REQUEST FOR LABORATORY HAS BEEN SENT"
. S XMY(RADUZ)=""
. S XMDUZ("AUTO ISAAC NTRT PROCESS")="" I RAGMAIL'="" S XMY($P(RAGMAIL,"@",1))=""
. S RATEXT(1)="A new Radiology Procedure has been entered at: "_RASITEN_" / "_RASITE
. S RATEXT(2)=""
. S RATEXT(3)="Radiology Procedure Name : "_$G(LXA(.01,"I"))
. S RATEXT(4)=""
. S RATEXT(5)="Send Status: "_STATUS
. S RATEXT(6)=""
. S A=0,B="",I=6 F S A=$O(RARDAT(A)) Q:'A S B=$G(RARDAT(A)) S:B'="" I=I+1,RATEXT(I)="ISAAC Reference Information: "_B
. S RATEXT(I+1)=""
. S XMTEXT="RATEXT(" D ^XMD
. ; remove item from send
. S ^XTMP(RAXTMPNM,"DONE",RAA)=RA71IEN_U_RAS_$$NOW^XLFDT_U_RADUZ
. K ^XTMP(RAXTMPNM,"SEND",RAA)
. L -^XTMP(RAXTMPNM,"SEND",RAA)
. ;
S RAERR=RAERR+1,^XTMP(RAXTMPNM,"SEND",RAA,"ERROR")=RAERR,^XTMP(RAXTMPNM,"SEND",RAA,"ERROR",RAERR)=STATUS
L -^XTMP(RAXTMPNM,"SEND",RAA)
G X2
;
XMLOUT K CNT,A,B,C,RAT,RADUZ,RAG,RAS,RA71IEN,RAA,RATEXT,RARDAT,RASDAT,RARHD,RASHD,RAFLG,RAMETH,URL,RAXTVER,RANOS3,RASITEN,RAXTMPNM
K RASITE,RANT,RANTI,AR,RANMAIL,RAGMAIL,RAIS,RAPRT,RAIPATH,LXA,LXB,RANOS1,RANOS2,RAERR,RADUZ,AA
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
XUP(UP) ;change to upper case
I UP="" Q ""
N A
S A=$TR(UP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q A
;
XMERR ; If error count is above 9 send message to RA ADPAC that request did not go out and include request in message
;
K XMY,RATEXT
S XMSUB="NOT ABLE TO SEND NEW NTRT REQUEST FOR RADIOLOGY"
S XMY(RADUZ)=""
S XMDUZ("AUTO ISAAC NTRT PROCESS")="" I RAGMAIL'="" S XMY($P(RAGMAIL,"@",1))=""
S RATEXT(1)="A new Radiology Procedure has been entered at: "_RASITEN_" / "_RASITE
S RATEXT(2)=""
S RATEXT(3)="Radiology Procedure Name : "_$G(LXA(.01,"I"))
S RATEXT(4)=""
; the error statuses
S A=0,C=5 F S A=$O(^XTMP(RAXTMPNM,"SEND",RAA,"ERROR",A)) Q:'A S B=^XTMP(RAXTMPNM,"SEND",RAA,"ERROR",A) D ;<
. S RATEXT(C)="Error number: "_A_" Error Reason: "_B,RATEXT(C+1)=""
. S C=C+2
S RATEXT(C)="Original Message Contents:",RATEXT(C+1)="",C=C+2
S A=0 F S A=$O(RAT(A)) Q:'A S B=RAT(A),RATEXT(C)=B,C=C+1
S RATEXT(C)=""
S XMTEXT="RATEXT(" D ^XMD
M ^XTMP(RAXTMPNM,"NOTSENT",RAA)=^XTMP(RAXTMPNM,"SEND",RAA)
K ^XTMP(RAXTMPNM,"SEND",RAA)
L -^XTMP(RAXTMPNM,"SEND",RAA)
Q
;
NOTVALID ; if not valid to send to ISAAC then only send MAILMAN message to RANTRT group
K XMY,RATEXT
S XMSUB="NOT ABLE TO SEND NEW NTRT REQUEST FOR RADIOLOGY."
S XMY(RADUZ)=""
S XMDUZ("AUTO ISAAC NTRT PROCESS")="" I RAGMAIL'="" S XMY($P(RAGMAIL,"@",1))=""
S RATEXT(1)="A new Radiology Procedure has been entered at: "_RASITEN_" / "_RASITE
S RATEXT(2)=""
S RATEXT(3)="Radiology Procedure Name : "_$G(LXA(.01,"I"))
S RATEXT(4)=""
S RATEXT(5)=" **** This message was not sent to ISAAC due to one of the following reasons: ****"
S A="",B="",C="",D="",E="" S:RANOS1=1 A="No Send Location" S:'$$PROD^XUPROD() B="Not a Production System" S:AA'["DOMAIN.EXT" C="Not a VA System"
I RANOS3=1 S:$G(RANTI(11,"I"))="" D="Missing ISAAC Web Address" S:$G(RANTI(10,"I"))="" E="Missing ISAAC Port Number"
I B'=""!(C'="") D ;<
. I B'="" S:A'="" A=A_" , " S A=A_B
. I C'="" S:A'="" A=A_" , " S A=A_C
. I D'="" S:A'="" A=A_" , " S A=A_D
. I E'="" S:A'="" A=A_" , " S A=A_E
S RATEXT(6)=A,RATEXT(7)="",C=8
S RATEXT(C)="Original Message Contents:",RATEXT(C+1)="",C=C+2
S A=0 F S A=$O(RAT(A)) Q:'A S B=RAT(A),RATEXT(C)=B,C=C+1
S RATEXT(C)=""
S XMTEXT="RATEXT(" D ^XMD
K ^XTMP(RAXTMPNM,"SEND",RAA)
L -^XTMP(RAXTMPNM,"SEND",RAA)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAXMLSND 7632 printed Apr 09, 2024@21:37:37 Page 2
RAXMLSND ;BPFO/DTG - NTRT MESSAGE PROCESS AND EDITS UPDATE;02/10/2016 ; 23 Sep 2016 3:43 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**127,138**;Mar 16, 1998;Build 22
+2 ;
+3 ; This section is for sending the XML message to ISAAC via HTTP/HTTPS
+4 ;
+5 ; first we save to ^XTMP
+6 QUIT
EN ; XTMP save
+1 NEW RAXTMPNM,RAXTMPNUM,CNT,E,LACT,STATUS,ZTQUEUED,ZTREQ
+2 SET CNT=0
ENA SET RAXTMPNM="RANTRTSAV"
+1 LOCK +^XTMP(RAXTMPNM):30
IF '$TEST
HANG 10
SET CNT=CNT+1
if CNT<11
GOTO ENA
GOTO ENO
+2 SET ^XTMP(RAXTMPNM,0)=$$FMADD^XLFDT(DT,365)_U_$$NOW^XLFDT()_U_"Radiology New Term to NTRT STS XML"
+3 SET RAXTMPNUM=$GET(^XTMP(RAXTMPNM,"CTRL"))
SET RAXTMPNUM=RAXTMPNUM+1
SET ^XTMP(RAXTMPNM,"CTRL")=RAXTMPNUM
+4 LOCK -^XTMP(RAXTMPNM)
+5 SET CNT=0
+6 ; RATEXT is the built XML send array
+7 ; RA71IEN is the file 71 Procedure IEN
+8 ; RAS is the Specimen IEN from the 60 specimen multiple (60.01)
+9 ; RADUZ is the DUZ of the person saving the test/specimen item
ENL LOCK +^XTMP(RAXTMPNM,"SEND",RAXTMPNUM):20
IF '$TEST
HANG 2
SET CNT=CNT+1
if CNT<11
GOTO ENL
GOTO ENO
+1 MERGE ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"I")=RATXT
+2 SET ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"DUZ")=RADUZ
+3 SET ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"RA71IEN")=RA71IEN
+4 ;S ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"RAS")=RAS
+5 SET ^XTMP(RAXTMPNM,"SEND",RAXTMPNUM,"ERROR")=0
+6 LOCK -^XTMP(RAXTMPNM,"SEND",RAXTMPNUM)
ENSL LOCK +^XTMP(RAXTMPNM,"O"):5
IF '$TEST
GOTO ENO
+1 NEW ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC
+2 SET ZTDTH=$$NOW^XLFDT
SET ZTDESC="RAD Send NTRT message to ISAAC"
+3 ; start RA*5.0*138 edit
+4 SET ZTSAVE("RAXTMPNM")=""
+5 SET ZTRTN="XMLSND^RAXMLSND(RAXTMPNM)"
SET ZTIO=""
+6 ; end RA*5.0*138 edit
+7 DO ^%ZTLOAD
+8 LOCK -^XTMP(RAXTMPNM,"O")
+9 KILL ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC
ENO KILL RAXTMPNM,RAXTMPNUM,CNT
+1 QUIT
+2 ;
+3 ; entry to send messages to ISAAC
+4 ;
XMLSND(RAXTMPNM) ;
+1 NEW CNT,A,B,C,RAT,RADUZ,RAG,RAS,RA71IEN,RAA,RATEXT,RARDAT,RASDAT,RARHD,RASHD,RAFLG,RAMETH,URL,RAXTVER
+2 NEW RASITE,RANT,RANTI,AR,RANMAIL,RAGMAIL,RAIS,RAPRT,RAIPATH,LXA,LXB,RANOS1,RANOS2,RAERR,RADUZ
+3 SET CNT=0
X1 LOCK +^XTMP(RAXTMPNM,"O"):20
IF '$TEST
SET CNT=CNT+1
if CNT<11
GOTO X1
GOTO XMLOUT
+1 IF $GET(DT)=""
SET DT=$$DT^XLFDT
+2 ; get file 71.98 current info
+3 SET RASITE=$$SITE^VASITE
SET RASITE=$PIECE(RASITE,U,1)
+4 SET RANT=$ORDER(^RAMRPF(71.98,"B",RASITE,0))
+5 DO GETS^DIQ(71.98,RANT_",","**","IE","AR")
+6 MERGE RANTI=AR("71.98",RANT_",")
KILL AR
+7 ;site number and name
+8 SET RASITE=$GET(RANTI(.01,"I"))
SET RASITEN=$GET(RANTI(.01,"E"))
+9 ;ntrt mail group
+10 SET RANMAIL="NTRT RADIOLOGY"
+11 ;RAD send mail group
+12 SET RAGMAIL=$GET(RANTI(6,"I"))
+13 ; Isaac web address
+14 SET RAIS=$GET(RANTI(11,"I"))
+15 SET AA=$$XUP(RAIS)
if $EXTRACT(AA,1,4)="HTTP"
SET RAIS=$PIECE(RAIS,"//",2,999)
if $EXTRACT(RAIS,($LENGTH(RAIS)))="/"
SET RAIS=$EXTRACT(RAIS,1,($LENGTH(RAIS)-1))
+16 ; Isaac port number
+17 SET RAPRT=$GET(RANTI(10,"I"))
+18 ; Isaac path
+19 ;<
SET RAIPATH=$GET(RANTI(11.5,"I"))
IF RAIPATH'=""
Begin DoDot:1
+20 SET RAIPATH=$TRANSLATE(RAIPATH,"~","/")
+21 if $EXTRACT(RAIPATH,1)'="/"
SET RAIPATH="/"_RAIPATH
End DoDot:1
+22 SET URL=RAIS_":"_RAPRT_RAIPATH
+23 ; if web address or port number are nill do not send
+24 SET RANOS3=0
IF $GET(RANTI(11,"I"))=""!($GET(RANTI(10,"I"))="")
SET RANOS3=1
+25 ;if no send method
+26 SET RANOS1=0
IF $GET(RANTI(8,"I"))="N"
SET RANOS1=1
+27 SET AA=$$XUP(RAGMAIL)
+28 ; if not production or not VA
+29 SET RANOS2=0
IF '$$PROD^XUPROD()!(AA'["DOMAIN.EXT")
SET RANOS2=1
+30 ;
+31 SET RAA=0
SET RAXTVER=1+($$PATCH^XPDUTL("XT*7.3*138"))
+32 SET RAFLG=10
X2 SET RAA=$ORDER(^XTMP(RAXTMPNM,"SEND",RAA))
IF 'RAA
LOCK -^XTMP(RAXTMPNM,"O")
GOTO XMLOUT
+1 SET CNT=0
X2A LOCK +^XTMP(RAXTMPNM,"SEND",RAA):5
IF '$TEST
SET CNT=CNT+1
if CNT<11
GOTO X2A
GOTO XMLOUT
+1 KILL RAT,RARHD,RARHD,RASDAT,RASHD,REDIR
+2 SET (RARHD,RASHD,RARDAT)=""
+3 SET REDIR=0
SET RASHD("CONTENT-TYPE")="application/xml"
SET STATUS=""
+4 MERGE RAT=^XTMP(RAXTMPNM,"SEND",RAA,"I")
+5 SET RADUZ=^XTMP(RAXTMPNM,"SEND",RAA,"DUZ")
SET RA71IEN=^XTMP(RAXTMPNM,"SEND",RAA,"RA71IEN")
+6 ;S RAS=^XTMP(RAXTMPNM,"SEND",RAA,"RAS"),RAERR=^XTMP(RAXTMPNM,"SEND",RAA,"ERROR")
+7 SET RAERR=^XTMP(RAXTMPNM,"SEND",RAA,"ERROR")
+8 ;
+9 ; check if ok to send a message
+10 IF RANOS1=1!(RANOS2=1)!(RANOS3=1)
DO NOTVALID
GOTO X2
+11 ;
+12 SET STATUS=$$GETURL^XTHC10(URL,RAFLG,"RARDAT",.RARHD,"RAT",.RASHD,$GET(REDIR)+1)
+13 SET A=$TRANSLATE(STATUS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+14 IF A["OK"!(A["ACCEPTED")
Begin DoDot:1
+15 ; send message to order and group that message was sent to ISAAC NTRT
+16 KILL XMY,RATEXT
+17 SET XMSUB="NEW NTRT REQUEST FOR LABORATORY HAS BEEN SENT"
+18 SET XMY(RADUZ)=""
+19 SET XMDUZ("AUTO ISAAC NTRT PROCESS")=""
IF RAGMAIL'=""
SET XMY($PIECE(RAGMAIL,"@",1))=""
+20 SET RATEXT(1)="A new Radiology Procedure has been entered at: "_RASITEN_" / "_RASITE
+21 SET RATEXT(2)=""
+22 SET RATEXT(3)="Radiology Procedure Name : "_$GET(LXA(.01,"I"))
+23 SET RATEXT(4)=""
+24 SET RATEXT(5)="Send Status: "_STATUS
+25 SET RATEXT(6)=""
+26 SET A=0
SET B=""
SET I=6
FOR
SET A=$ORDER(RARDAT(A))
if 'A
QUIT
SET B=$GET(RARDAT(A))
if B'=""
SET I=I+1
SET RATEXT(I)="ISAAC Reference Information: "_B
+27 SET RATEXT(I+1)=""
+28 SET XMTEXT="RATEXT("
DO ^XMD
+29 ; remove item from send
+30 SET ^XTMP(RAXTMPNM,"DONE",RAA)=RA71IEN_U_RAS_$$NOW^XLFDT_U_RADUZ
+31 KILL ^XTMP(RAXTMPNM,"SEND",RAA)
+32 LOCK -^XTMP(RAXTMPNM,"SEND",RAA)
+33 ;
End DoDot:1
GOTO X2
+34 SET RAERR=RAERR+1
SET ^XTMP(RAXTMPNM,"SEND",RAA,"ERROR")=RAERR
SET ^XTMP(RAXTMPNM,"SEND",RAA,"ERROR",RAERR)=STATUS
+35 LOCK -^XTMP(RAXTMPNM,"SEND",RAA)
+36 GOTO X2
+37 ;
XMLOUT KILL CNT,A,B,C,RAT,RADUZ,RAG,RAS,RA71IEN,RAA,RATEXT,RARDAT,RASDAT,RARHD,RASHD,RAFLG,RAMETH,URL,RAXTVER,RANOS3,RASITEN,RAXTMPNM
+1 KILL RASITE,RANT,RANTI,AR,RANMAIL,RAGMAIL,RAIS,RAPRT,RAIPATH,LXA,LXB,RANOS1,RANOS2,RAERR,RADUZ,AA
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
+4 ;
XUP(UP) ;change to upper case
+1 IF UP=""
QUIT ""
+2 NEW A
+3 SET A=$TRANSLATE(UP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+4 QUIT A
+5 ;
XMERR ; If error count is above 9 send message to RA ADPAC that request did not go out and include request in message
+1 ;
+2 KILL XMY,RATEXT
+3 SET XMSUB="NOT ABLE TO SEND NEW NTRT REQUEST FOR RADIOLOGY"
+4 SET XMY(RADUZ)=""
+5 SET XMDUZ("AUTO ISAAC NTRT PROCESS")=""
IF RAGMAIL'=""
SET XMY($PIECE(RAGMAIL,"@",1))=""
+6 SET RATEXT(1)="A new Radiology Procedure has been entered at: "_RASITEN_" / "_RASITE
+7 SET RATEXT(2)=""
+8 SET RATEXT(3)="Radiology Procedure Name : "_$GET(LXA(.01,"I"))
+9 SET RATEXT(4)=""
+10 ; the error statuses
+11 ;<
SET A=0
SET C=5
FOR
SET A=$ORDER(^XTMP(RAXTMPNM,"SEND",RAA,"ERROR",A))
if 'A
QUIT
SET B=^XTMP(RAXTMPNM,"SEND",RAA,"ERROR",A)
Begin DoDot:1
+12 SET RATEXT(C)="Error number: "_A_" Error Reason: "_B
SET RATEXT(C+1)=""
+13 SET C=C+2
End DoDot:1
+14 SET RATEXT(C)="Original Message Contents:"
SET RATEXT(C+1)=""
SET C=C+2
+15 SET A=0
FOR
SET A=$ORDER(RAT(A))
if 'A
QUIT
SET B=RAT(A)
SET RATEXT(C)=B
SET C=C+1
+16 SET RATEXT(C)=""
+17 SET XMTEXT="RATEXT("
DO ^XMD
+18 MERGE ^XTMP(RAXTMPNM,"NOTSENT",RAA)=^XTMP(RAXTMPNM,"SEND",RAA)
+19 KILL ^XTMP(RAXTMPNM,"SEND",RAA)
+20 LOCK -^XTMP(RAXTMPNM,"SEND",RAA)
+21 QUIT
+22 ;
NOTVALID ; if not valid to send to ISAAC then only send MAILMAN message to RANTRT group
+1 KILL XMY,RATEXT
+2 SET XMSUB="NOT ABLE TO SEND NEW NTRT REQUEST FOR RADIOLOGY."
+3 SET XMY(RADUZ)=""
+4 SET XMDUZ("AUTO ISAAC NTRT PROCESS")=""
IF RAGMAIL'=""
SET XMY($PIECE(RAGMAIL,"@",1))=""
+5 SET RATEXT(1)="A new Radiology Procedure has been entered at: "_RASITEN_" / "_RASITE
+6 SET RATEXT(2)=""
+7 SET RATEXT(3)="Radiology Procedure Name : "_$GET(LXA(.01,"I"))
+8 SET RATEXT(4)=""
+9 SET RATEXT(5)=" **** This message was not sent to ISAAC due to one of the following reasons: ****"
+10 SET A=""
SET B=""
SET C=""
SET D=""
SET E=""
if RANOS1=1
SET A="No Send Location"
if '$$PROD^XUPROD()
SET B="Not a Production System"
if AA'["DOMAIN.EXT"
SET C="Not a VA System"
+11 IF RANOS3=1
if $GET(RANTI(11,"I"))=""
SET D="Missing ISAAC Web Address"
if $GET(RANTI(10,"I"))=""
SET E="Missing ISAAC Port Number"
+12 ;<
IF B'=""!(C'="")
Begin DoDot:1
+13 IF B'=""
if A'=""
SET A=A_" , "
SET A=A_B
+14 IF C'=""
if A'=""
SET A=A_" , "
SET A=A_C
+15 IF D'=""
if A'=""
SET A=A_" , "
SET A=A_D
+16 IF E'=""
if A'=""
SET A=A_" , "
SET A=A_E
End DoDot:1
+17 SET RATEXT(6)=A
SET RATEXT(7)=""
SET C=8
+18 SET RATEXT(C)="Original Message Contents:"
SET RATEXT(C+1)=""
SET C=C+2
+19 SET A=0
FOR
SET A=$ORDER(RAT(A))
if 'A
QUIT
SET B=RAT(A)
SET RATEXT(C)=B
SET C=C+1
+20 SET RATEXT(C)=""
+21 SET XMTEXT="RATEXT("
DO ^XMD
+22 KILL ^XTMP(RAXTMPNM,"SEND",RAA)
+23 LOCK -^XTMP(RAXTMPNM,"SEND",RAA)
+24 QUIT
+25 ;
