RAHLO3 ;HIRMFO/GJC-Process data set from the bridge program ;11/18/97 12:13
;;5.0;Radiology/Nuclear Medicine;**4,81,84,47**;Mar 16, 1998;Build 21
;
;Integration Agreements
;-----------------------
;$$GET1^DIQ(2056); $$DT^XLFDT(10103)
;
RPTSTAT ; Determine the status to set this report to.
K RARPTSTS S:$D(RAESIG) RARPTSTS="V" Q:$D(RARPTSTS)
; $D(RAESIG)=0 now figure out report status
N RASTAT S RASTAT=$E($G(^TMP("RARPT-REC",$J,RASUB,"RASTAT")))
I RASTAT="A"!(RASTAT="C") S RARPTSTS="V" Q ;v2.4 "C" (correction)
I RASTAT]"",("FR"[RASTAT) D
. S:RASTAT="F" RARPTSTS="V" Q:$D(RARPTSTS)
. I $G(RATELE) S RARPTSTS="R" Q ;Always allow 'Released/Unverified' reports for teleradiology
. ; do we allow 'Released/Unverified' reports for this location?
. S RARPTSTS=$S($P($G(^RA(79.1,RAMLC,0)),"^",17)="Y":"R",1:"D")
. Q
; if no status, & there's physician data (verifier/primary),set status
I '$D(RARPTSTS),($G(RAVERF)!$G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF"))!$G(^("RARESIDENT"))) S RARPTSTS=$S($P($G(^RA(79.1,RAMLC,0)),"^",17)="Y":"R",1:"D")
; if still no status, default to draft
S:'$D(RARPTSTS) RARPTSTS="D"
Q
TEXT(X) ; Check if the Impression Text and the Report Text contain
; valid characters.
; Input : X = "I" if Impr Text is being checked, "R" if Rpt Text
; Output: 0=invalid, 1=valid
N CNT,DATA,FLAG,I,I1,J,Y S (FLAG,I)=0
F S I=$O(^TMP("RARPT-REC",$J,RASUB,$S(X="I":"RAIMP",1:"RATXT"),I)) Q:I'>0 D Q:FLAG
. S CNT=0,DATA=$G(^TMP("RARPT-REC",$J,RASUB,$S(X="I":"RAIMP",1:"RATXT"),I)) Q:DATA']""
. F J=1:1:$L(DATA) D Q:FLAG
.. S:$E(DATA,J)?1AN CNT=CNT+1
.. S:$E(DATA,J)'?1AN&(CNT>0) CNT=0
.. S:CNT=2 FLAG=1
.. Q
. Q
Q FLAG
;
VERCHK ; Check if our provider can verify reports.
; Examine the following four (4) conditions if $D(RAESIG)
; 1) Does this person have a resident or staff classification?
; 2) If a resident, does the division parameter allow resident
; verification?
; 3) Does this person hold the "RA VERIFY" key?
; 4) Is this person an activate Rad/Nuc Med user?
; 5) Can this person verify reports without staff review?
; If 'No' to any of the above questions, kill RAESIG & set the variable
; RAERR to the appropriate error message.
I '$D(^VA(200,"ARC","R",+$G(RAVERF))),('$D(^VA(200,"ARC","S",+$G(RAVERF)))),'$G(RATELE) D Q
. ; neither a resident or staff
. K RAESIG S RAERR="Provider not classified as resident or staff."
. Q
I $D(^VA(200,"ARC","R",+$G(RAVERF))),('$P(RAMDV,"^",18)),'$G(RATELE) D Q
. ; residents can't verify reports linked to this division
. K RAESIG S RAERR="Residents are not permitted to verify reports."
. Q
I '$D(^XUSEC("RA VERIFY",+$G(RAVERF))),'$G(RATELE) D Q
. ; verifier MUST have the RA VERIFY key.
. K RAESIG S RAERR="Provider does not meet security requirements to verify report."
. Q
I '$G(RATELE),$P($G(^VA(200,+$G(RAVERF),"RA")),"^",3),($P(^("RA"),"^",3)'>$$DT^XLFDT()) D
. ; Rad/Nuc Med user has been inactivated.
. K RAESIG S RAERR="Inactive Rad/Nuc Med Classification for Interpreting Physician."
. Q
I '$G(RATELE),'$S('$D(^VA(200,+$G(RAVERF),"RA")):1,$P(^("RA"),"^")'="Y":1,1:0) D
. K RAESIG S RAERR="Staff review required to verify report."
. Q
Q
VFIER ; Check if the RAVERF string is a partial match to an entry in file
; 200. If if is, check to see that is a partial match to only ONE
; active provider entry in file 200.
I '$L(RAVERF) S RAERR="Missing Provider information" Q
N RAVCNT,RAVIEN,RAVLGTH,RAVPS
S RAVLGTH=$L(RAVERF) ; length of the RAVERF string
S RAVCNT=0,RAVS1=RAVERF,RAVIEN=""
F S RAVS1=$O(^VA(200,"B",RAVS1)) Q:RAVS1=""!($E(RAVS1,1,RAVLGTH)'=RAVERF) D Q:RAVCNT>1
. ; return subscripts that have the RAVERF string as the first
. ; 1 - RAVLGTH chars of RAVS1
. S RAVIEN=0
. F S RAVIEN=$O(^VA(200,"B",RAVS1,RAVIEN)) Q:RAVIEN'>0 D Q:RAVCNT>1
.. S RAVPS=$G(^VA(200,RAVIEN,"PS"))
.. S:'$P(RAVPS,"^",4)!($P(RAVPS,"^",4)>DT) RAVCNT=RAVCNT+1
.. I RAVCNT=1,('$D(RAVIEN(RAVCNT))#2) S RAVIEN(RAVCNT)=RAVIEN ; when
.. ; we find the first active provider save the provider ien off
.. ; in a local array.
.. Q
. Q
; Added for PowerScribe
I RAVIEN']"" D
. ;S RAVIEN=$P(RAVERF,$E(HL("ECH"),4))
. S RAVIEN=+RAVERF
. S RAVPS=$G(^VA(200,RAVIEN,"PS"))
. S:'$P(RAVPS,"^",4)!($P(RAVPS,"^",4)>DT) RAVCNT=RAVCNT+1
. I RAVCNT=1,('$D(RAVIEN(RAVCNT))#2) S RAVIEN(RAVCNT)=RAVIEN
. Q
I RAVCNT=0 S RAERR="Invalid Provider Name: "_RAVERF Q ; partial match not found
I RAVCNT>1 S RAERR="Non-Unique Provider Name: "_RAVERF Q ; >1 partial match
;S RAVERF=$G(RAVIEN(1)) S:'RAVERF RAERR="Provider Name Entry Error"
S:'$G(RAVIEN(1)) RAERR="Provider Name Entry Error: "_RAVERF S RAVERF=$G(RAVIEN(1))
Q
ESIG ; Added for COTS E-Sig capability
;
Q:"FAC"'[^TMP(RARRR,$J,RASUB,"RASTAT")!('$D(^("RAVERF")))!($D(^("RAESIG")))
S RADFN=+$G(^TMP(RARRR,$J,RASUB,"RADFN"))
S RADTI=+$G(^TMP(RARRR,$J,RASUB,"RADTI"))
S RADIV=$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",3)
Q:RADIV="" ; exam has been deleted - will be rejected
; Check division parameters for ALLOW E-SIG ON COTS REPORT in file 79
; for the division that ordered this procedure.
I $P(^RA(79,RADIV,.1),"^",27)["Y" D
. S RAESIG=$$GET1^DIQ(200,RAVERF,20.2)
. S:RAESIG]"" ^TMP(RARRR,$J,RASUB,"RAESIG")=RAESIG
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAHLO3 5331 printed Apr 09, 2024@21:36:42 Page 2
RAHLO3 ;HIRMFO/GJC-Process data set from the bridge program ;11/18/97 12:13
+1 ;;5.0;Radiology/Nuclear Medicine;**4,81,84,47**;Mar 16, 1998;Build 21
+2 ;
+3 ;Integration Agreements
+4 ;-----------------------
+5 ;$$GET1^DIQ(2056); $$DT^XLFDT(10103)
+6 ;
RPTSTAT ; Determine the status to set this report to.
+1 KILL RARPTSTS
if $DATA(RAESIG)
SET RARPTSTS="V"
if $DATA(RARPTSTS)
QUIT
+2 ; $D(RAESIG)=0 now figure out report status
+3 NEW RASTAT
SET RASTAT=$EXTRACT($GET(^TMP("RARPT-REC",$JOB,RASUB,"RASTAT")))
+4 ;v2.4 "C" (correction)
IF RASTAT="A"!(RASTAT="C")
SET RARPTSTS="V"
QUIT
+5 IF RASTAT]""
IF ("FR"[RASTAT)
Begin DoDot:1
+6 if RASTAT="F"
SET RARPTSTS="V"
if $DATA(RARPTSTS)
QUIT
+7 ;Always allow 'Released/Unverified' reports for teleradiology
IF $GET(RATELE)
SET RARPTSTS="R"
QUIT
+8 ; do we allow 'Released/Unverified' reports for this location?
+9 SET RARPTSTS=$SELECT($PIECE($GET(^RA(79.1,RAMLC,0)),"^",17)="Y":"R",1:"D")
+10 QUIT
End DoDot:1
+11 ; if no status, & there's physician data (verifier/primary),set status
+12 IF '$DATA(RARPTSTS)
IF ($GET(RAVERF)!$GET(^TMP("RARPT-REC",$JOB,RASUB,"RASTAFF"))!$GET(^("RARESIDENT")))
SET RARPTSTS=$SELECT($PIECE($GET(^RA(79.1,RAMLC,0)),"^",17)="Y":"R",1:"D")
+13 ; if still no status, default to draft
+14 if '$DATA(RARPTSTS)
SET RARPTSTS="D"
+15 QUIT
TEXT(X) ; Check if the Impression Text and the Report Text contain
+1 ; valid characters.
+2 ; Input : X = "I" if Impr Text is being checked, "R" if Rpt Text
+3 ; Output: 0=invalid, 1=valid
+4 NEW CNT,DATA,FLAG,I,I1,J,Y
SET (FLAG,I)=0
+5 FOR
SET I=$ORDER(^TMP("RARPT-REC",$JOB,RASUB,$SELECT(X="I":"RAIMP",1:"RATXT"),I))
if I'>0
QUIT
Begin DoDot:1
+6 SET CNT=0
SET DATA=$GET(^TMP("RARPT-REC",$JOB,RASUB,$SELECT(X="I":"RAIMP",1:"RATXT"),I))
if DATA']""
QUIT
+7 FOR J=1:1:$LENGTH(DATA)
Begin DoDot:2
+8 if $EXTRACT(DATA,J)?1AN
SET CNT=CNT+1
+9 if $EXTRACT(DATA,J)'?1AN&(CNT>0)
SET CNT=0
+10 if CNT=2
SET FLAG=1
+11 QUIT
End DoDot:2
if FLAG
QUIT
+12 QUIT
End DoDot:1
if FLAG
QUIT
+13 QUIT FLAG
+14 ;
VERCHK ; Check if our provider can verify reports.
+1 ; Examine the following four (4) conditions if $D(RAESIG)
+2 ; 1) Does this person have a resident or staff classification?
+3 ; 2) If a resident, does the division parameter allow resident
+4 ; verification?
+5 ; 3) Does this person hold the "RA VERIFY" key?
+6 ; 4) Is this person an activate Rad/Nuc Med user?
+7 ; 5) Can this person verify reports without staff review?
+8 ; If 'No' to any of the above questions, kill RAESIG & set the variable
+9 ; RAERR to the appropriate error message.
+10 IF '$DATA(^VA(200,"ARC","R",+$GET(RAVERF)))
IF ('$DATA(^VA(200,"ARC","S",+$GET(RAVERF))))
IF '$GET(RATELE)
Begin DoDot:1
+11 ; neither a resident or staff
+12 KILL RAESIG
SET RAERR="Provider not classified as resident or staff."
+13 QUIT
End DoDot:1
QUIT
+14 IF $DATA(^VA(200,"ARC","R",+$GET(RAVERF)))
IF ('$PIECE(RAMDV,"^",18))
IF '$GET(RATELE)
Begin DoDot:1
+15 ; residents can't verify reports linked to this division
+16 KILL RAESIG
SET RAERR="Residents are not permitted to verify reports."
+17 QUIT
End DoDot:1
QUIT
+18 IF '$DATA(^XUSEC("RA VERIFY",+$GET(RAVERF)))
IF '$GET(RATELE)
Begin DoDot:1
+19 ; verifier MUST have the RA VERIFY key.
+20 KILL RAESIG
SET RAERR="Provider does not meet security requirements to verify report."
+21 QUIT
End DoDot:1
QUIT
+22 IF '$GET(RATELE)
IF $PIECE($GET(^VA(200,+$GET(RAVERF),"RA")),"^",3)
IF ($PIECE(^("RA"),"^",3)'>$$DT^XLFDT())
Begin DoDot:1
+23 ; Rad/Nuc Med user has been inactivated.
+24 KILL RAESIG
SET RAERR="Inactive Rad/Nuc Med Classification for Interpreting Physician."
+25 QUIT
End DoDot:1
+26 IF '$GET(RATELE)
IF '$SELECT('$DATA(^VA(200,+$GET(RAVERF),"RA")):1,$PIECE(^("RA"),"^")'="Y":1,1:0)
Begin DoDot:1
+27 KILL RAESIG
SET RAERR="Staff review required to verify report."
+28 QUIT
End DoDot:1
+29 QUIT
VFIER ; Check if the RAVERF string is a partial match to an entry in file
+1 ; 200. If if is, check to see that is a partial match to only ONE
+2 ; active provider entry in file 200.
+3 IF '$LENGTH(RAVERF)
SET RAERR="Missing Provider information"
QUIT
+4 NEW RAVCNT,RAVIEN,RAVLGTH,RAVPS
+5 ; length of the RAVERF string
SET RAVLGTH=$LENGTH(RAVERF)
+6 SET RAVCNT=0
SET RAVS1=RAVERF
SET RAVIEN=""
+7 FOR
SET RAVS1=$ORDER(^VA(200,"B",RAVS1))
if RAVS1=""!($EXTRACT(RAVS1,1,RAVLGTH)'=RAVERF)
QUIT
Begin DoDot:1
+8 ; return subscripts that have the RAVERF string as the first
+9 ; 1 - RAVLGTH chars of RAVS1
+10 SET RAVIEN=0
+11 FOR
SET RAVIEN=$ORDER(^VA(200,"B",RAVS1,RAVIEN))
if RAVIEN'>0
QUIT
Begin DoDot:2
+12 SET RAVPS=$GET(^VA(200,RAVIEN,"PS"))
+13 if '$PIECE(RAVPS,"^",4)!($PIECE(RAVPS,"^",4)>DT)
SET RAVCNT=RAVCNT+1
+14 ; when
IF RAVCNT=1
IF ('$DATA(RAVIEN(RAVCNT))#2)
SET RAVIEN(RAVCNT)=RAVIEN
+15 ; we find the first active provider save the provider ien off
+16 ; in a local array.
+17 QUIT
End DoDot:2
if RAVCNT>1
QUIT
+18 QUIT
End DoDot:1
if RAVCNT>1
QUIT
+19 ; Added for PowerScribe
+20 IF RAVIEN']""
Begin DoDot:1
+21 ;S RAVIEN=$P(RAVERF,$E(HL("ECH"),4))
+22 SET RAVIEN=+RAVERF
+23 SET RAVPS=$GET(^VA(200,RAVIEN,"PS"))
+24 if '$PIECE(RAVPS,"^",4)!($PIECE(RAVPS,"^",4)>DT)
SET RAVCNT=RAVCNT+1
+25 IF RAVCNT=1
IF ('$DATA(RAVIEN(RAVCNT))#2)
SET RAVIEN(RAVCNT)=RAVIEN
+26 QUIT
End DoDot:1
+27 ; partial match not found
IF RAVCNT=0
SET RAERR="Invalid Provider Name: "_RAVERF
QUIT
+28 ; >1 partial match
IF RAVCNT>1
SET RAERR="Non-Unique Provider Name: "_RAVERF
QUIT
+29 ;S RAVERF=$G(RAVIEN(1)) S:'RAVERF RAERR="Provider Name Entry Error"
+30 if '$GET(RAVIEN(1))
SET RAERR="Provider Name Entry Error: "_RAVERF
SET RAVERF=$GET(RAVIEN(1))
+31 QUIT
ESIG ; Added for COTS E-Sig capability
+1 ;
+2 if "FAC"'[^TMP(RARRR,$JOB,RASUB,"RASTAT")!('$DATA(^("RAVERF")))!($DATA(^("RAESIG")))
QUIT
+3 SET RADFN=+$GET(^TMP(RARRR,$JOB,RASUB,"RADFN"))
+4 SET RADTI=+$GET(^TMP(RARRR,$JOB,RASUB,"RADTI"))
+5 SET RADIV=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,0)),"^",3)
+6 ; exam has been deleted - will be rejected
if RADIV=""
QUIT
+7 ; Check division parameters for ALLOW E-SIG ON COTS REPORT in file 79
+8 ; for the division that ordered this procedure.
+9 IF $PIECE(^RA(79,RADIV,.1),"^",27)["Y"
Begin DoDot:1
+10 SET RAESIG=$$GET1^DIQ(200,RAVERF,20.2)
+11 if RAESIG]""
SET ^TMP(RARRR,$JOB,RASUB,"RAESIG")=RAESIG
+12 QUIT
End DoDot:1
+13 QUIT
