- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO3.m
r613 r623 1 RAHLO3 ;HIRMFO/GJC-Process data set from the bridge program ;11/18/97 12:13 2 ;;5.0;Radiology/Nuclear Medicine;**4,81,84**;Mar 16, 1998;Build 13 3 ; 4 ;Integration Agreements 5 ;----------------------- 6 ;$$GET1^DIQ(2056); $$DT^XLFDT(10103) 7 ; 8 RPTSTAT ; Determine the status to set this report to. 9 K RARPTSTS S:$D(RAESIG) RARPTSTS="V" Q:$D(RARPTSTS) 10 ; $D(RAESIG)=0 now figure out report status 11 N RASTAT S RASTAT=$E($G(^TMP("RARPT-REC",$J,RASUB,"RASTAT"))) 12 I RASTAT="A" S RARPTSTS="V" Q 13 I RASTAT]"",("FR"[RASTAT) D 14 . S:RASTAT="F" RARPTSTS="V" Q:$D(RARPTSTS) 15 . I $G(RATELE) S RARPTSTS="R" Q ;Always allow 'Released/Unverified' reports for teleradiology 16 . ; do we allow 'Released/Unverified' reports for this location? 17 . S RARPTSTS=$S($P($G(^RA(79.1,RAMLC,0)),"^",17)="Y":"R",1:"D") 18 . Q 19 ; if no status, & there's physician data (verifier/primary),set status 20 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") 21 ; if still no status, default to draft 22 S:'$D(RARPTSTS) RARPTSTS="D" 23 Q 24 TEXT(X) ; Check if the Impression Text and the Report Text contain 25 ; valid characters. 26 ; Input : X = "I" if Impr Text is being checked, "R" if Rpt Text 27 ; Output: 0=invalid, 1=valid 28 N CNT,DATA,FLAG,I,I1,J,Y S (FLAG,I)=0 29 F S I=$O(^TMP("RARPT-REC",$J,RASUB,$S(X="I":"RAIMP",1:"RATXT"),I)) Q:I'>0 D Q:FLAG 30 . S CNT=0,DATA=$G(^TMP("RARPT-REC",$J,RASUB,$S(X="I":"RAIMP",1:"RATXT"),I)) Q:DATA']"" 31 . F J=1:1:$L(DATA) D Q:FLAG 32 .. S:$E(DATA,J)?1AN CNT=CNT+1 33 .. S:$E(DATA,J)'?1AN&(CNT>0) CNT=0 34 .. S:CNT=2 FLAG=1 35 .. Q 36 . Q 37 Q FLAG 38 ; 39 VERCHK ; Check if our provider can verify reports. 40 ; Examine the following four (4) conditions if $D(RAESIG) 41 ; 1) Does this person have a resident or staff classification? 42 ; 2) If a resident, does the division parameter allow resident 43 ; verification? 44 ; 3) Does this person hold the "RA VERIFY" key? 45 ; 4) Is this person an activate Rad/Nuc Med user? 46 ; 5) Can this person verify reports without staff review? 47 ; If 'No' to any of the above questions, kill RAESIG & set the variable 48 ; RAERR to the appropriate error message. 49 I '$D(^VA(200,"ARC","R",+$G(RAVERF))),('$D(^VA(200,"ARC","S",+$G(RAVERF)))),'$G(RATELE) D Q 50 . ; neither a resident or staff 51 . K RAESIG S RAERR="Provider not classified as resident or staff." 52 . Q 53 I $D(^VA(200,"ARC","R",+$G(RAVERF))),('$P(RAMDV,"^",18)),'$G(RATELE) D Q 54 . ; residents can't verify reports linked to this division 55 . K RAESIG S RAERR="Residents are not permitted to verify reports." 56 . Q 57 I '$D(^XUSEC("RA VERIFY",+$G(RAVERF))),'$G(RATELE) D Q 58 . ; verifier MUST have the RA VERIFY key. 59 . K RAESIG S RAERR="Provider does not meet security requirements to verify report." 60 . Q 61 I '$G(RATELE),$P($G(^VA(200,+$G(RAVERF),"RA")),"^",3),($P(^("RA"),"^",3)'>$$DT^XLFDT()) D 62 . ; Rad/Nuc Med user has been inactivated. 63 . K RAESIG S RAERR="Inactive Rad/Nuc Med Classification for Interpreting Physician." 64 . Q 65 I '$G(RATELE),'$S('$D(^VA(200,+$G(RAVERF),"RA")):1,$P(^("RA"),"^")'="Y":1,1:0) D 66 . K RAESIG S RAERR="Staff review required to verify report." 67 . Q 68 Q 69 VFIER ; Check if the RAVERF string is a partial match to an entry in file 70 ; 200. If if is, check to see that is a partial match to only ONE 71 ; active provider entry in file 200. 72 I '$L(RAVERF) S RAERR="Missing Provider information" Q 73 N RAVCNT,RAVIEN,RAVLGTH,RAVPS 74 S RAVLGTH=$L(RAVERF) ; length of the RAVERF string 75 S RAVCNT=0,RAVS1=RAVERF,RAVIEN="" 76 F S RAVS1=$O(^VA(200,"B",RAVS1)) Q:RAVS1=""!($E(RAVS1,1,RAVLGTH)'=RAVERF) D Q:RAVCNT>1 77 . ; return subscripts that have the RAVERF string as the first 78 . ; 1 - RAVLGTH chars of RAVS1 79 . S RAVIEN=0 80 . F S RAVIEN=$O(^VA(200,"B",RAVS1,RAVIEN)) Q:RAVIEN'>0 D Q:RAVCNT>1 81 .. S RAVPS=$G(^VA(200,RAVIEN,"PS")) 82 .. S:'$P(RAVPS,"^",4)!($P(RAVPS,"^",4)>DT) RAVCNT=RAVCNT+1 83 .. I RAVCNT=1,('$D(RAVIEN(RAVCNT))#2) S RAVIEN(RAVCNT)=RAVIEN ; when 84 .. ; we find the first active provider save the provider ien off 85 .. ; in a local array. 86 .. Q 87 . Q 88 ; Added for PowerScribe 89 I RAVIEN']"" D 90 . ;S RAVIEN=$P(RAVERF,$E(HL("ECH"),4)) 91 . S RAVIEN=+RAVERF 92 . S RAVPS=$G(^VA(200,RAVIEN,"PS")) 93 . S:'$P(RAVPS,"^",4)!($P(RAVPS,"^",4)>DT) RAVCNT=RAVCNT+1 94 . I RAVCNT=1,('$D(RAVIEN(RAVCNT))#2) S RAVIEN(RAVCNT)=RAVIEN 95 . Q 96 I RAVCNT=0 S RAERR="Invalid Provider Name: "_RAVERF Q ; partial match not found 97 I RAVCNT>1 S RAERR="Non-Unique Provider Name: "_RAVERF Q ; >1 partial match 98 ;S RAVERF=$G(RAVIEN(1)) S:'RAVERF RAERR="Provider Name Entry Error" 99 S:'$G(RAVIEN(1)) RAERR="Provider Name Entry Error: "_RAVERF S RAVERF=$G(RAVIEN(1)) 100 Q 101 ESIG ; Added for COTS E-Sig capability 102 ; 103 Q:"FA"'[^TMP(RARRR,$J,RASUB,"RASTAT")!('$D(^("RAVERF")))!($D(^("RAESIG"))) 104 S RADFN=+$G(^TMP(RARRR,$J,RASUB,"RADFN")) 105 S RADTI=+$G(^TMP(RARRR,$J,RASUB,"RADTI")) 106 S RADIV=$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",3) 107 Q:RADIV="" ; exam has been deleted - will be rejected 108 ; Check division parameters for ALLOW E-SIG ON COTS REPORT in file 79 109 ; for the division that ordered this procedure. 110 I $P(^RA(79,RADIV,.1),"^",27)["Y" D 111 . S RAESIG=$$GET1^DIQ(200,RAVERF,20.2) 112 . S:RAESIG]"" ^TMP(RARRR,$J,RASUB,"RAESIG")=RAESIG 113 . Q 114 Q 1 RAHLO3 ;HIRMFO/GJC-Process data set from the bridge program ;11/18/97 12:13 2 ;;5.0;Radiology/Nuclear Medicine;**4,81**;Mar 16, 1998;Build 12 3 RPTSTAT ; Determine the status to set this report to. 4 K RARPTSTS S:$D(RAESIG) RARPTSTS="V" Q:$D(RARPTSTS) 5 ; $D(RAESIG)=0 now figure out report status 6 S RASTAT=$E($G(^TMP("RARPT-REC",$J,RASUB,"RASTAT"))) 7 I RASTAT="A" S RARPTSTS="V" Q 8 I RASTAT]"",("FR"[RASTAT) D 9 . S:RASTAT="F" RARPTSTS="V" Q:$D(RARPTSTS) 10 . ; do we allow 'Released/Unverified' reports for this location? 11 . S RARPTSTS=$S($P($G(^RA(79.1,RAMLC,0)),"^",17)="Y":"R",1:"D") 12 . Q 13 ; if no status, & there's physician data (verifier/primary),set status 14 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") 15 ; if still no status, default to draft 16 S:'$D(RARPTSTS) RARPTSTS="D" 17 K RASTAT 18 Q 19 TEXT(X) ; Check if the Impression Text and the Report Text contain 20 ; valid characters. 21 ; Input : X = "I" if Impr Text is being checked, "R" if Rpt Text 22 ; Output: 0=invalid, 1=valid 23 N CNT,DATA,FLAG,I,I1,J,Y S (FLAG,I)=0 24 F S I=$O(^TMP("RARPT-REC",$J,RASUB,$S(X="I":"RAIMP",1:"RATXT"),I)) Q:I'>0 D Q:FLAG 25 . S CNT=0,DATA=$G(^TMP("RARPT-REC",$J,RASUB,$S(X="I":"RAIMP",1:"RATXT"),I)) Q:DATA']"" 26 . F J=1:1:$L(DATA) D Q:FLAG 27 .. S:$E(DATA,J)?1AN CNT=CNT+1 28 .. S:$E(DATA,J)'?1AN&(CNT>0) CNT=0 29 .. S:CNT=2 FLAG=1 30 .. Q 31 . Q 32 Q FLAG 33 ; 34 VERCHK ; Check if our provider can verify reports. 35 ; Examine the following four (4) conditions if $D(RAESIG) 36 ; 1) Does this person have a resident or staff classification? 37 ; 2) If a resident, does the division parameter allow resident 38 ; verification? 39 ; 3) Does this person hold the "RA VERIFY" key? 40 ; 4) Is this person an activate Rad/Nuc Med user? 41 ; 5) Can this person verify reports without staff review? 42 ; If 'No' to any of the above questions, kill RAESIG & set the variable 43 ; RAERR to the appropriate error message. 44 I '$D(^VA(200,"ARC","R",+$G(RAVERF))),('$D(^VA(200,"ARC","S",+$G(RAVERF)))) D Q 45 . ; neither a resident or staff 46 . K RAESIG S RAERR="Provider not classified as resident or staff." 47 . Q 48 I $D(^VA(200,"ARC","R",+$G(RAVERF))),('$P(RAMDV,"^",18)) D Q 49 . ; residents can't verify reports linked to this division 50 . K RAESIG S RAERR="Residents are not permitted to verify reports." 51 . Q 52 I '$D(^XUSEC("RA VERIFY",+$G(RAVERF))) D Q 53 . ; verifier MUST have the RA VERIFY key. 54 . K RAESIG S RAERR="Provider does not meet security requirements to verify report." 55 . Q 56 I $P($G(^VA(200,+$G(RAVERF),"RA")),"^",3),($P(^("RA"),"^",3)'>$$DT^XLFDT()) D 57 . ; Rad/Nuc Med user has been inactivated. 58 . K RAESIG S RAERR="Inactive Rad/Nuc Med Classification for Interpreting Physician." 59 . Q 60 I '$S('$D(^VA(200,+$G(RAVERF),"RA")):1,$P(^("RA"),"^")'="Y":1,1:0) D 61 . K RAESIG S RAERR="Staff review required to verify report." 62 . Q 63 Q 64 VFIER ; Check if the RAVERF string is a partial match to an entry in file 65 ; 200. If if is, check to see that is a partial match to only ONE 66 ; active provider entry in file 200. 67 I '$L(RAVERF) S RAERR="Missing Provider information" Q 68 N RAVCNT,RAVIEN,RAVLGTH,RAVPS 69 S RAVLGTH=$L(RAVERF) ; length of the RAVERF string 70 S RAVCNT=0,RAVS1=RAVERF,RAVIEN="" 71 F S RAVS1=$O(^VA(200,"B",RAVS1)) Q:RAVS1=""!($E(RAVS1,1,RAVLGTH)'=RAVERF) D Q:RAVCNT>1 72 . ; return subscripts that have the RAVERF string as the first 73 . ; 1 - RAVLGTH chars of RAVS1 74 . S RAVIEN=0 75 . F S RAVIEN=$O(^VA(200,"B",RAVS1,RAVIEN)) Q:RAVIEN'>0 D Q:RAVCNT>1 76 .. S RAVPS=$G(^VA(200,RAVIEN,"PS")) 77 .. S:'$P(RAVPS,"^",4)!($P(RAVPS,"^",4)>DT) RAVCNT=RAVCNT+1 78 .. I RAVCNT=1,('$D(RAVIEN(RAVCNT))#2) S RAVIEN(RAVCNT)=RAVIEN ; when 79 .. ; we find the first active provider save the provider ien off 80 .. ; in a local array. 81 .. Q 82 . Q 83 ; Added for PowerScribe 84 I RAVIEN']"" D 85 . ;S RAVIEN=$P(RAVERF,$E(HL("ECH"),4)) 86 . S RAVIEN=+RAVERF 87 . S RAVPS=$G(^VA(200,RAVIEN,"PS")) 88 . S:'$P(RAVPS,"^",4)!($P(RAVPS,"^",4)>DT) RAVCNT=RAVCNT+1 89 . I RAVCNT=1,('$D(RAVIEN(RAVCNT))#2) S RAVIEN(RAVCNT)=RAVIEN 90 . Q 91 I RAVCNT=0 S RAERR="Invalid Provider Name" Q ; partial match not found 92 I RAVCNT>1 S RAERR="Non-Unique Provider Name" Q ; >1 partial match 93 S RAVERF=$G(RAVIEN(1)) S:'RAVERF RAERR="Provider Name Entry Error" 94 Q 95 ESIG ; Added for COTS E-Sig capability 96 ; 97 Q:"FA"'[^TMP(RARRR,$J,RASUB,"RASTAT")!('$D(^("RAVERF")))!($D(^("RAESIG"))) 98 S RADFN=+$G(^TMP(RARRR,$J,RASUB,"RADFN")) 99 S RADTI=+$G(^TMP(RARRR,$J,RASUB,"RADTI")) 100 S RADIV=$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",3) 101 Q:RADIV="" ; exam has been deleted - will be rejected 102 ; Check division parameters for ALLOW E-SIG ON COTS REPORT in file 79 103 ; for the division that ordered this procedure. 104 I $P(^RA(79,RADIV,.1),"^",27)["Y" D 105 . S RAESIG=$$GET1^DIQ(200,RAVERF,20.2) 106 . S:RAESIG]"" ^TMP(RARRR,$J,RASUB,"RAESIG")=RAESIG 107 . Q 108 Q
Note:
See TracChangeset
for help on using the changeset viewer.
