RAHLRPTT ;HISC/CAH AISC/SAW-Compiles HL7 'ORU' Message Type ; 06 Oct 2013 11:10 AM
;;5.0;Radiology/Nuclear Medicine;**84,94,1005**;Mar 16, 1998;Build 13
EN ; Continuation from RAHLRPT which has been split because the 10 k size problem
; & other inbound patch 84 utility
;
;Integration Agreements
;----------------------
;^%DT(10003); $$FIND1^DIC(2051); $$GET1^DIQ(2056); $$HLDATE^HLFNC(10106); $$HLNAME^HLFNC(10106)
;$$M11^HLFNC(10106); $$EN^VAFHLPID(263)
;read w/FileMan HL7 APPLICATION PARAMETER(10136)
;
INIT ;
D:$D(RANOSEND) ;Patch 84
.N RATIEN,DIERR,RAERR
.S RATIEN=$S(+RANOSEND:+RANOSEND,1:$$FIND1^DIC(771,"","X",RANOSEND,"","","RAERR"))
.Q:'RATIEN!($D(RAERR)#2)
.;RATELE is set to the value of the 'TELERADIOLOGY APPLICATION' (#1) field 0:No; 1:Yes
.S RATELE=$P($G(^RA(79.7,RATIEN,0)),U,2) I 'RATELE K RATELE Q
.;RATELX is set to the value of the 'RELEASE STUDY KEYWORD' (#1.2) field
.S RATELX=$P($G(^RA(79.7,RATIEN,0)),U,4)
.S:'$L(RATELX) RATELX="Released for local dictation by National Teleradiology"
S RASET=0,RACN0=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
S:'$D(RARPT) RARPT=+$P(RACN0,"^",17)
Q
SETUP ; Setup basic examination information
S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
Q
TELE ;Setting TELERAD info for RAHLTCPB
;RATELEKN = Keyword to get the name and NPI of teleradiologist
;RATELENM = Teleradiologist Name
;RATELEPI = Teleradiologist NPI
;RATELEDR = Default DX for terad 'R' report
;RATELEDF = Default DX for terad 'F' report
N RATIEN,DIERR,RAERR
S RATIEN=$$FIND1^DIC(771,"","X",$G(HL("SAN")),"","","RAERR")
Q:'RATIEN!($D(RAERR)#2)
S RATELE=$P($G(^RA(79.7,RATIEN,0)),U,2) ;Patch 84
I 'RATELE K RATELE Q ;Q:'RATELE original; changed w/P94 Remedy 259432
S RATELEKN=$P($G(^RA(79.7,RATIEN,0)),U,3) S:'$L(RATELEKN) RATELEKN="Report dictated by Teleradiologist: "
S RATELEDR=$P($G(^RA(79.7,RATIEN,2)),U) K:'$L(RATELEDR) RATELEDR
S RATELEDF=$P($G(^RA(79.7,RATIEN,2)),U,2) K:'$L(RATELEDF) RATELEDF
Q
PID ;Compile 'PID' Segment
I HL("VER")']"2.2" D
.S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS
.;
.;IHS/BJI/DAY - Patch 1005 - Gender Fix
.;S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"),1:"U") S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
.S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MFU"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"),1:"U") S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
.;
I HL("VER")]"2.2" S RAN=RAN+1,HLA("HLS",RAN)=$$EN^VAFHLPID(DFN,"2,3,5,7,8,19,20")
Q
RESEND(RADFN,RADTI,RACNI) ; re-send exam message(s) to HL7 subscribers
;
Q:'$G(RADFN)!'$G(RADTI)!'$G(RACNI)
Q:'$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:'$P(^(0),U,2)
N RABD,RAEDTT,QUIT
;
I '$D(DT) D ^%DT S DT=Y
;
S RAEDTT=$$RAED(RADFN,RADTI,RACNI)
Q:'$L(RAEDTT)
D:RAEDTT[",REG," REG^RAHLRPC
D:RAEDTT[",CANCEL," CANCEL^RAHLRPC
D:RAEDTT[",EXAM,"
.S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",30)="" ;Reset sent flag
.N RAEXMDUN D 1^RAHLRPC
D:RAEDTT[",RPT,"
.N RANOSEND,RARPT D RPT^RAHLRPC
Q
;
RAED(RADFN,RADTI,RACNI) ; identify correct ^RAHLRPC entry point(s)
;
N RASTAT,RAIMTYP,RAORD,RETURN,RARPT
S RASTAT=""
;
S RETURN=",REG,"
;
S RASTAT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3,"I")
S RARPT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,17,"I")
;
S RAIMTYP=$$GET1^DIQ(72,+RASTAT,7) Q:'$L(RAIMTYP) ""
S RAORD=$$GET1^DIQ(72,+RASTAT,3)
;
S:RAORD=0 RETURN=RETURN_"CANCEL,"
;
S:$$GET1^DIQ(72,+RASTAT,8)="YES" RETURN=RETURN_"EXAM," ; Generate Examined HL7 Message
;
D:RETURN'[",EXAM,"
.; also check previous statuses for 'Generate Examined HL7 Message'
.F S RAORD=$O(^RA(72,"AA",RAIMTYP,RAORD),-1) Q:+RAORD<1 D Q:RETURN[",EXAM,"
..S RASTAT=$O(^RA(72,"AA",RAIMTYP,RAORD,0))
..S:$$GET1^DIQ(72,+RASTAT,8)="YES" RETURN=RETURN_"EXAM,"
;
; Check if Verified Report exists
I RARPT]"",$$GET1^DIQ(74,RARPT_",",5,"I")="V" S RETURN=RETURN_"RPT,"
;
Q RETURN
RAHLRPTT ;HISC/CAH AISC/SAW-Compiles HL7 'ORU' Message Type ; 06 Oct 2013 11:10 AM
+1 ;;5.0;Radiology/Nuclear Medicine;**84,94,1005**;Mar 16, 1998;Build 13
EN ; Continuation from RAHLRPT which has been split because the 10 k size problem
+1 ; & other inbound patch 84 utility
+2 ;
+3 ;Integration Agreements
+4 ;----------------------
+5 ;^%DT(10003); $$FIND1^DIC(2051); $$GET1^DIQ(2056); $$HLDATE^HLFNC(10106); $$HLNAME^HLFNC(10106)
+6 ;$$M11^HLFNC(10106); $$EN^VAFHLPID(263)
+7 ;read w/FileMan HL7 APPLICATION PARAMETER(10136)
+8 ;
INIT ;
+1 ;Patch 84
IF $DATA(RANOSEND)
Begin DoDot:1
+2 NEW RATIEN,DIERR,RAERR
+3 SET RATIEN=$SELECT(+RANOSEND:+RANOSEND,1:$$FIND1^DIC(771,"","X",RANOSEND,"","","RAERR"))
+4 IF 'RATIEN!($DATA(RAERR)#2)
QUIT
+5 ;RATELE is set to the value of the 'TELERADIOLOGY APPLICATION' (#1) field 0:No; 1:Yes
+6 SET RATELE=$PIECE($GET(^RA(79.7,RATIEN,0)),U,2)
IF 'RATELE
KILL RATELE
QUIT
+7 ;RATELX is set to the value of the 'RELEASE STUDY KEYWORD' (#1.2) field
+8 SET RATELX=$PIECE($GET(^RA(79.7,RATIEN,0)),U,4)
+9 IF '$LENGTH(RATELX)
SET RATELX="Released for local dictation by National Teleradiology"
End DoDot:1
+10 SET RASET=0
SET RACN0=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+11 IF '$DATA(RARPT)
SET RARPT=+$PIECE(RACN0,"^",17)
+12 QUIT
SETUP ; Setup basic examination information
+1 IF RASET
SET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+2 SET RADTE0=9999999.9999-RADTI
SET RADTECN=$EXTRACT(RADTE0,4,7)_$EXTRACT(RADTE0,2,3)_"-"_+RACN0
SET RARPT0=^RARPT(RARPT,0)
+3 SET RAPROC=+$PIECE(RACN0,U,2)
SET RAPROCIT=+$PIECE($GET(^RAMIS(71,RAPROC,0)),U,12)
SET RAPROCIT=$PIECE(^RA(79.2,RAPROCIT,0),U,1)
+4 SET RAPRCNDE=$GET(^RAMIS(71,+RAPROC,0))
SET RACPT=+$PIECE(RAPRCNDE,U,9)
+5 SET RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
+6 SET Y=$$HLDATE^HLFNC(RADTE0)
SET RADTE0=$SELECT(Y:Y,1:HLQ)
SET Y=$$M11^HLFNC(RADFN)
+7 QUIT
TELE ;Setting TELERAD info for RAHLTCPB
+1 ;RATELEKN = Keyword to get the name and NPI of teleradiologist
+2 ;RATELENM = Teleradiologist Name
+3 ;RATELEPI = Teleradiologist NPI
+4 ;RATELEDR = Default DX for terad 'R' report
+5 ;RATELEDF = Default DX for terad 'F' report
+6 NEW RATIEN,DIERR,RAERR
+7 SET RATIEN=$$FIND1^DIC(771,"","X",$GET(HL("SAN")),"","","RAERR")
+8 IF 'RATIEN!($DATA(RAERR)#2)
QUIT
+9 ;Patch 84
SET RATELE=$PIECE($GET(^RA(79.7,RATIEN,0)),U,2)
+10 ;Q:'RATELE original; changed w/P94 Remedy 259432
IF 'RATELE
KILL RATELE
QUIT
+11 SET RATELEKN=$PIECE($GET(^RA(79.7,RATIEN,0)),U,3)
IF '$LENGTH(RATELEKN)
SET RATELEKN="Report dictated by Teleradiologist: "
+12 SET RATELEDR=$PIECE($GET(^RA(79.7,RATIEN,2)),U)
IF '$LENGTH(RATELEDR)
KILL RATELEDR
+13 SET RATELEDF=$PIECE($GET(^RA(79.7,RATIEN,2)),U,2)
IF '$LENGTH(RATELEDF)
KILL RATELEDF
+14 QUIT
PID ;Compile 'PID' Segment
+1 IF HL("VER")']"2.2"
Begin DoDot:1
+2 SET X1=""
SET X1="PID"_HLFS_HLFS_$GET(VA("PID"))_HLFS_Y_HLFS_HLFS
SET X=VADM(1)
SET Y=$$HLNAME^HLFNC(X)
SET X1=X1_Y_HLFS_HLFS
+3 ;
+4 ;IHS/BJI/DAY - Patch 1005 - Gender Fix
+5 ;S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"),1:"U") S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
+6 SET X=RAVADM(3)
SET Y=$$HLDATE^HLFNC(X)
SET X1=X1_Y_HLFS_$SELECT(VADM(5)]"":$SELECT("MFU"[$PIECE(VADM(5),"^"):$PIECE(VADM(5),"^"),1:"O"),1:"U")
IF $PIECE(VADM(2),"^")]""
SET $PIECE(X1,HLFS,20)=$PIECE(VADM(2),"^")
SET RAN=RAN+1
SET HLA("HLS",RAN)=X1
+7 ;
End DoDot:1
+8 IF HL("VER")]"2.2"
SET RAN=RAN+1
SET HLA("HLS",RAN)=$$EN^VAFHLPID(DFN,"2,3,5,7,8,19,20")
+9 QUIT
RESEND(RADFN,RADTI,RACNI) ; re-send exam message(s) to HL7 subscribers
+1 ;
+2 IF '$GET(RADFN)!'$GET(RADTI)!'$GET(RACNI)
QUIT
+3 IF '$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
QUIT
IF '$PIECE(^(0),U,2)
QUIT
+4 NEW RABD,RAEDTT,QUIT
+5 ;
+6 IF '$DATA(DT)
DO ^%DT
SET DT=Y
+7 ;
+8 SET RAEDTT=$$RAED(RADFN,RADTI,RACNI)
+9 IF '$LENGTH(RAEDTT)
QUIT
+10 IF RAEDTT[",REG,"
DO REG^RAHLRPC
+11 IF RAEDTT[",CANCEL,"
DO CANCEL^RAHLRPC
+12 IF RAEDTT[",EXAM,"
Begin DoDot:1
+13 ;Reset sent flag
SET $PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",30)=""
+14 NEW RAEXMDUN
DO 1^RAHLRPC
End DoDot:1
+15 IF RAEDTT[",RPT,"
Begin DoDot:1
+16 NEW RANOSEND,RARPT
DO RPT^RAHLRPC
End DoDot:1
+17 QUIT
+18 ;
RAED(RADFN,RADTI,RACNI) ; identify correct ^RAHLRPC entry point(s)
+1 ;
+2 NEW RASTAT,RAIMTYP,RAORD,RETURN,RARPT
+3 SET RASTAT=""
+4 ;
+5 SET RETURN=",REG,"
+6 ;
+7 SET RASTAT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3,"I")
+8 SET RARPT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,17,"I")
+9 ;
+10 SET RAIMTYP=$$GET1^DIQ(72,+RASTAT,7)
IF '$LENGTH(RAIMTYP)
QUIT ""
+11 SET RAORD=$$GET1^DIQ(72,+RASTAT,3)
+12 ;
+13 IF RAORD=0
SET RETURN=RETURN_"CANCEL,"
+14 ;
+15 ; Generate Examined HL7 Message
IF $$GET1^DIQ(72,+RASTAT,8)="YES"
SET RETURN=RETURN_"EXAM,"
+16 ;
+17 IF RETURN'[",EXAM,"
Begin DoDot:1
+18 ; also check previous statuses for 'Generate Examined HL7 Message'
+19 FOR
SET RAORD=$ORDER(^RA(72,"AA",RAIMTYP,RAORD),-1)
IF +RAORD<1
QUIT
Begin DoDot:2
+20 SET RASTAT=$ORDER(^RA(72,"AA",RAIMTYP,RAORD,0))
+21 IF $$GET1^DIQ(72,+RASTAT,8)="YES"
SET RETURN=RETURN_"EXAM,"
End DoDot:2
IF RETURN[",EXAM,"
QUIT
End DoDot:1
+22 ;
+23 ; Check if Verified Report exists
+24 IF RARPT]""
IF $$GET1^DIQ(74,RARPT_",",5,"I")="V"
SET RETURN=RETURN_"RPT,"
+25 ;
+26 QUIT RETURN
