Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAHLO3

RAHLO3.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;Integration Agreements
  1.  ;-----------------------
  1.  ;$$GET1^DIQ(2056); $$DT^XLFDT(10103)
  1.  ;
  1. RPTSTAT ; Determine the status to set this report to.
  1.  K RARPTSTS S:$D(RAESIG) RARPTSTS="V" Q:$D(RARPTSTS)
  1.  ; $D(RAESIG)=0 now figure out report status
  1.  N RASTAT S RASTAT=$E($G(^TMP("RARPT-REC",$J,RASUB,"RASTAT")))
  1.  I RASTAT="A"!(RASTAT="C") S RARPTSTS="V" Q  ;v2.4 "C" (correction)
  1.  I RASTAT]"",("FR"[RASTAT) D
  1.  . S:RASTAT="F" RARPTSTS="V" Q:$D(RARPTSTS)
  1.  . I $G(RATELE) S RARPTSTS="R" Q  ;Always allow 'Released/Unverified' reports for teleradiology
  1.  . ; do we allow 'Released/Unverified' reports for this location?
  1.  . S RARPTSTS=$S($P($G(^RA(79.1,RAMLC,0)),"^",17)="Y":"R",1:"D")
  1.  . Q
  1.  ; if no status, & there's physician data (verifier/primary),set status
  1.  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")
  1.  ; if still no status, default to draft
  1.  S:'$D(RARPTSTS) RARPTSTS="D"
  1.  Q
  1. TEXT(X) ; Check if the Impression Text and the Report Text contain
  1.  ; valid characters.
  1.  ; Input : X = "I" if Impr Text is being checked, "R" if Rpt Text
  1.  ; Output: 0=invalid, 1=valid
  1.  N CNT,DATA,FLAG,I,I1,J,Y S (FLAG,I)=0
  1.  F  S I=$O(^TMP("RARPT-REC",$J,RASUB,$S(X="I":"RAIMP",1:"RATXT"),I)) Q:I'>0  D  Q:FLAG
  1.  . S CNT=0,DATA=$G(^TMP("RARPT-REC",$J,RASUB,$S(X="I":"RAIMP",1:"RATXT"),I)) Q:DATA']""
  1.  . F J=1:1:$L(DATA) D  Q:FLAG
  1.  .. S:$E(DATA,J)?1AN CNT=CNT+1
  1.  .. S:$E(DATA,J)'?1AN&(CNT>0) CNT=0
  1.  .. S:CNT=2 FLAG=1
  1.  .. Q
  1.  . Q
  1.  Q FLAG
  1.  ;
  1. VERCHK ; Check if our provider can verify reports.
  1.  ; Examine the following four (4) conditions if $D(RAESIG)
  1.  ; 1) Does this person have a resident or staff classification?
  1.  ; 2) If a resident, does the division parameter allow resident
  1.  ;    verification?
  1.  ; 3) Does this person hold the "RA VERIFY" key?
  1.  ; 4) Is this person an activate Rad/Nuc Med user?
  1.  ; 5) Can this person verify reports without staff review?
  1.  ; If 'No' to any of the above questions, kill RAESIG & set the variable
  1.  ; RAERR to the appropriate error message.
  1.  I '$D(^VA(200,"ARC","R",+$G(RAVERF))),('$D(^VA(200,"ARC","S",+$G(RAVERF)))),'$G(RATELE) D  Q
  1.  . ; neither a resident or staff
  1.  . K RAESIG S RAERR="Provider not classified as resident or staff."
  1.  . Q
  1.  I $D(^VA(200,"ARC","R",+$G(RAVERF))),('$P(RAMDV,"^",18)),'$G(RATELE) D  Q
  1.  . ; residents can't verify reports linked to this division
  1.  . K RAESIG S RAERR="Residents are not permitted to verify reports."
  1.  . Q
  1.  I '$D(^XUSEC("RA VERIFY",+$G(RAVERF))),'$G(RATELE) D  Q
  1.  . ; verifier MUST have the RA VERIFY key.
  1.  . K RAESIG S RAERR="Provider does not meet security requirements to verify report."
  1.  . Q
  1.  I '$G(RATELE),$P($G(^VA(200,+$G(RAVERF),"RA")),"^",3),($P(^("RA"),"^",3)'>$$DT^XLFDT()) D
  1.  . ; Rad/Nuc Med user has been inactivated.
  1.  . K RAESIG S RAERR="Inactive Rad/Nuc Med Classification for Interpreting Physician."
  1.  . Q
  1.  I '$G(RATELE),'$S('$D(^VA(200,+$G(RAVERF),"RA")):1,$P(^("RA"),"^")'="Y":1,1:0) D
  1.  . K RAESIG S RAERR="Staff review required to verify report."
  1.  . Q
  1.  Q
  1. 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
  1.  ; active provider entry in file 200.
  1.  I '$L(RAVERF) S RAERR="Missing Provider information" Q
  1.  N RAVCNT,RAVIEN,RAVLGTH,RAVPS
  1.  S RAVLGTH=$L(RAVERF) ; length of the RAVERF string
  1.  S RAVCNT=0,RAVS1=RAVERF,RAVIEN=""
  1.  F  S RAVS1=$O(^VA(200,"B",RAVS1)) Q:RAVS1=""!($E(RAVS1,1,RAVLGTH)'=RAVERF)  D  Q:RAVCNT>1
  1.  . ; return subscripts that have the RAVERF string as the first
  1.  . ; 1 - RAVLGTH chars of RAVS1
  1.  . S RAVIEN=0
  1.  . F  S RAVIEN=$O(^VA(200,"B",RAVS1,RAVIEN)) Q:RAVIEN'>0  D  Q:RAVCNT>1
  1.  .. S RAVPS=$G(^VA(200,RAVIEN,"PS"))
  1.  .. S:'$P(RAVPS,"^",4)!($P(RAVPS,"^",4)>DT) RAVCNT=RAVCNT+1
  1.  .. I RAVCNT=1,('$D(RAVIEN(RAVCNT))#2) S RAVIEN(RAVCNT)=RAVIEN ; when
  1.  .. ; we find the first active provider save the provider ien off
  1.  .. ; in a local array.
  1.  .. Q
  1.  . Q
  1.  ; Added for PowerScribe
  1.  I RAVIEN']"" D
  1.  . ;S RAVIEN=$P(RAVERF,$E(HL("ECH"),4))
  1.  . S RAVIEN=+RAVERF
  1.  . S RAVPS=$G(^VA(200,RAVIEN,"PS"))
  1.  . S:'$P(RAVPS,"^",4)!($P(RAVPS,"^",4)>DT) RAVCNT=RAVCNT+1
  1.  . I RAVCNT=1,('$D(RAVIEN(RAVCNT))#2) S RAVIEN(RAVCNT)=RAVIEN
  1.  . Q
  1.  I RAVCNT=0 S RAERR="Invalid Provider Name: "_RAVERF Q  ; partial match not found
  1.  I RAVCNT>1 S RAERR="Non-Unique Provider Name: "_RAVERF Q  ; >1 partial match
  1.  ;S RAVERF=$G(RAVIEN(1)) S:'RAVERF RAERR="Provider Name Entry Error"
  1.  S:'$G(RAVIEN(1)) RAERR="Provider Name Entry Error: "_RAVERF S RAVERF=$G(RAVIEN(1))
  1.  Q
  1. ESIG ; Added for COTS E-Sig capability
  1.  ;
  1.  Q:"FAC"'[^TMP(RARRR,$J,RASUB,"RASTAT")!('$D(^("RAVERF")))!($D(^("RAESIG")))
  1.  S RADFN=+$G(^TMP(RARRR,$J,RASUB,"RADFN"))
  1.  S RADTI=+$G(^TMP(RARRR,$J,RASUB,"RADTI"))
  1.  S RADIV=$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",3)
  1.  Q:RADIV=""  ; exam has been deleted - will be rejected
  1.  ; Check division parameters for ALLOW E-SIG ON COTS REPORT in file 79
  1.  ; for the division that ordered this procedure.
  1.  I $P(^RA(79,RADIV,.1),"^",27)["Y" D
  1.  . S RAESIG=$$GET1^DIQ(200,RAVERF,20.2)
  1.  . S:RAESIG]"" ^TMP(RARRR,$J,RASUB,"RAESIG")=RAESIG
  1.  . Q
  1.  Q