PXRMEVFI ;SLC/PKR - Driver for finding evaluation. ;23-Mar-2015 10:11;DU
;;2.0;CLINICAL REMINDERS;**6,1001,18,1005**;Feb 04, 2005;Build 23
;IHS/MSC/MGH Patch 1001 and 1005 add IHS findings
;=====================================================
BRANCH(DFN,DEFARR,ENODE,FIEVAL) ;Branch to appropriate evalution routine.
I ENODE="AUTTHF(" D EVALFI^PXRMHF(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="PXD(811.2," D EVALFI^PXRMTAX(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="PXRMD(810.9," D EVALFI^PXRMLOCF(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="PXRMD(811.4," D EVALFI^PXRMCF(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="PXRMD(811.5," D EVALFI^PXRMTERM(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="PS(50.605," D EVALFI^PXRMDRCL(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="PSDRUG(" D EVALFI^PXRMDRUG(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="PSNDF(50.6," D EVALFI^PXRMDGEN(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="RAMIS(71," D EVALFI^PXRMRAD(DFN,.DEFARR,ENODE,.FIEVAL) Q
I ENODE="YTT(601.71," D EVALFI^PXRMMH(DFN,.DEFARR,ENODE,.FIEVAL) Q
; IHS/MSC/MGH - 2/28/2012 PATCH 1001 Calls below are to resolve findings using
; files from IHS that are not used by VA.
I ENODE="AUTTMSR(" D EVALFI^BPXRMEA(DFN,.DEFARR,ENODE,.FIEVAL) Q ;V Measurement file
I ENODE="AUTTREFT(" D EVALFI^BPXRMREF(DFN,.DEFARR,ENODE,.FIEVAL) Q ;Refusal File
I ENODE="APCDACV(" D EVALFI^BPXRMAS1(DFN,.DEFARR,ENODE,.FIEVAL) Q ;PCC asthma control
;All others use EVALFI^PXRMINDX directly.
;"AUTTEDT(", "AUTTEXAM(", "AUTTIMM(","AUTTSK(","GMRD(120.51,"
;"LAB(60,", "ORD(101.43,"
D EVALFI^PXRMINDX(DFN,.DEFARR,ENODE,.FIEVAL)
Q
;
;=====================================================
EVAL(DFN,DEFARR,FIEVAL) ;Evaluate findings, first those that don't have any
;date dependencies using the "E"index then those that do have date
;dependencies using the "EDEP" index.
;index.
N BDT,EDT,IND,ITEM,ENODE,FINDING,NOCC,TDEFARR
I $G(PXRMDEBG) D
. S FINDING=0
. F S FINDING=$O(DEFARR(20,FINDING)) Q:FINDING="" S FIEVAL(FINDING,"BDT")=$P(DEFARR(20,FINDING,0),U,8),FIEVAL(FINDING,"EDT")=$P(DEFARR(20,FINDING,0),U,11)
S ENODE=""
F S ENODE=$O(DEFARR("E",ENODE)) Q:ENODE="" D BRANCH(DFN,.DEFARR,ENODE,.FIEVAL)
I '$D(DEFARR("EDEP")) G FF
M TDEFARR=DEFARR
S IND=0
F S IND=$O(TDEFARR("EDEP",IND)) Q:IND="" D
. S ENODE=$O(TDEFARR("EDEP",IND,""))
. S ITEM=$O(TDEFARR("EDEP",IND,ENODE,""))
. S FINDING=$O(TDEFARR("EDEP",IND,ENODE,ITEM,""))
.;If either dependent finding is false then set this finding false and
.;skip the evaluation.
. S BDT=+$P(TDEFARR("EDEP",IND,ENODE,ITEM,FINDING),U,1)
. I BDT>0,FIEVAL(BDT)=0 S FIEVAL(FINDING)=0 Q
. S EDT=+$P(TDEFARR("EDEP",IND,ENODE,ITEM,FINDING),U,2)
. I EDT>0,FIEVAL(EDT)=0 S FIEVAL(FINDING)=0 Q
.;Convert beginning and ending date/time to internal FM dates.
. D SSPAR^PXRMUTIL(TDEFARR(20,FINDING,0),.NOCC,.BDT,.EDT)
. I (BDT=-1)!(EDT=-1) D Q
.. S FIEVAL(FINDING)=0
.. I $G(PXRMDEBG) S FIEVAL(FINDING,"BDTE")=BDT,FIEVAL(FINDING,"EDTE")=EDT
. S $P(TDEFARR(20,FINDING,0),U,8)=BDT
. S $P(TDEFARR(20,FINDING,0),U,11)=EDT
.;Build an "E" node to evaluate this finding.
. K TDEFARR("E",ENODE)
. S TDEFARR("E",ENODE,ITEM,FINDING)=""
.;At this point branch to appropriate EVALFI
. D BRANCH(DFN,.TDEFARR,ENODE,.FIEVAL)
;Evaluate function findings.
FF D EVAL^PXRMFF(DFN,.DEFARR,.FIEVAL)
Q
;
;=====================================================
EVALPL(DEFARR,FINUM,PLIST) ;Create a patient list for a regular
;finding.
N FINDPA,TERMARR
S FINDPA(0)=DEFARR(20,FINUM,0)
S FINDPA(3)=DEFARR(20,FINUM,3)
S FINDPA(10)=DEFARR(20,FINUM,10)
S FINDPA(11)=DEFARR(20,FINUM,11)
D GENTERM^PXRMPLST(FINDPA(0),FINUM,.TERMARR)
D EVALPL^PXRMTERL(.FINDPA,.TERMARR,PLIST)
Q
;
PXRMEVFI ;SLC/PKR - Driver for finding evaluation. ;23-Mar-2015 10:11;DU
+1 ;;2.0;CLINICAL REMINDERS;**6,1001,18,1005**;Feb 04, 2005;Build 23
+2 ;IHS/MSC/MGH Patch 1001 and 1005 add IHS findings
+3 ;=====================================================
BRANCH(DFN,DEFARR,ENODE,FIEVAL) ;Branch to appropriate evalution routine.
+1 IF ENODE="AUTTHF("
DO EVALFI^PXRMHF(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+2 IF ENODE="PXD(811.2,"
DO EVALFI^PXRMTAX(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+3 IF ENODE="PXRMD(810.9,"
DO EVALFI^PXRMLOCF(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+4 IF ENODE="PXRMD(811.4,"
DO EVALFI^PXRMCF(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+5 IF ENODE="PXRMD(811.5,"
DO EVALFI^PXRMTERM(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+6 IF ENODE="PS(50.605,"
DO EVALFI^PXRMDRCL(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+7 IF ENODE="PSDRUG("
DO EVALFI^PXRMDRUG(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+8 IF ENODE="PSNDF(50.6,"
DO EVALFI^PXRMDGEN(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+9 IF ENODE="RAMIS(71,"
DO EVALFI^PXRMRAD(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+10 IF ENODE="YTT(601.71,"
DO EVALFI^PXRMMH(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+11 ; IHS/MSC/MGH - 2/28/2012 PATCH 1001 Calls below are to resolve findings using
+12 ; files from IHS that are not used by VA.
+13 ;V Measurement file
IF ENODE="AUTTMSR("
DO EVALFI^BPXRMEA(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+14 ;Refusal File
IF ENODE="AUTTREFT("
DO EVALFI^BPXRMREF(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+15 ;PCC asthma control
IF ENODE="APCDACV("
DO EVALFI^BPXRMAS1(DFN,.DEFARR,ENODE,.FIEVAL)
QUIT
+16 ;All others use EVALFI^PXRMINDX directly.
+17 ;"AUTTEDT(", "AUTTEXAM(", "AUTTIMM(","AUTTSK(","GMRD(120.51,"
+18 ;"LAB(60,", "ORD(101.43,"
+19 DO EVALFI^PXRMINDX(DFN,.DEFARR,ENODE,.FIEVAL)
+20 QUIT
+21 ;
+22 ;=====================================================
EVAL(DFN,DEFARR,FIEVAL) ;Evaluate findings, first those that don't have any
+1 ;date dependencies using the "E"index then those that do have date
+2 ;dependencies using the "EDEP" index.
+3 ;index.
+4 NEW BDT,EDT,IND,ITEM,ENODE,FINDING,NOCC,TDEFARR
+5 IF $GET(PXRMDEBG)
Begin DoDot:1
+6 SET FINDING=0
+7 FOR
SET FINDING=$ORDER(DEFARR(20,FINDING))
IF FINDING=""
QUIT
SET FIEVAL(FINDING,"BDT")=$PIECE(DEFARR(20,FINDING,0),U,8)
SET FIEVAL(FINDING,"EDT")=$PIECE(DEFARR(20,FINDING,0),U,11)
End DoDot:1
+8 SET ENODE=""
+9 FOR
SET ENODE=$ORDER(DEFARR("E",ENODE))
IF ENODE=""
QUIT
DO BRANCH(DFN,.DEFARR,ENODE,.FIEVAL)
+10 IF '$DATA(DEFARR("EDEP"))
GOTO FF
+11 MERGE TDEFARR=DEFARR
+12 SET IND=0
+13 FOR
SET IND=$ORDER(TDEFARR("EDEP",IND))
IF IND=""
QUIT
Begin DoDot:1
+14 SET ENODE=$ORDER(TDEFARR("EDEP",IND,""))
+15 SET ITEM=$ORDER(TDEFARR("EDEP",IND,ENODE,""))
+16 SET FINDING=$ORDER(TDEFARR("EDEP",IND,ENODE,ITEM,""))
+17 ;If either dependent finding is false then set this finding false and
+18 ;skip the evaluation.
+19 SET BDT=+$PIECE(TDEFARR("EDEP",IND,ENODE,ITEM,FINDING),U,1)
+20 IF BDT>0
IF FIEVAL(BDT)=0
SET FIEVAL(FINDING)=0
QUIT
+21 SET EDT=+$PIECE(TDEFARR("EDEP",IND,ENODE,ITEM,FINDING),U,2)
+22 IF EDT>0
IF FIEVAL(EDT)=0
SET FIEVAL(FINDING)=0
QUIT
+23 ;Convert beginning and ending date/time to internal FM dates.
+24 DO SSPAR^PXRMUTIL(TDEFARR(20,FINDING,0),.NOCC,.BDT,.EDT)
+25 IF (BDT=-1)!(EDT=-1)
Begin DoDot:2
+26 SET FIEVAL(FINDING)=0
+27 IF $GET(PXRMDEBG)
SET FIEVAL(FINDING,"BDTE")=BDT
SET FIEVAL(FINDING,"EDTE")=EDT
End DoDot:2
QUIT
+28 SET $PIECE(TDEFARR(20,FINDING,0),U,8)=BDT
+29 SET $PIECE(TDEFARR(20,FINDING,0),U,11)=EDT
+30 ;Build an "E" node to evaluate this finding.
+31 KILL TDEFARR("E",ENODE)
+32 SET TDEFARR("E",ENODE,ITEM,FINDING)=""
+33 ;At this point branch to appropriate EVALFI
+34 DO BRANCH(DFN,.TDEFARR,ENODE,.FIEVAL)
End DoDot:1
+35 ;Evaluate function findings.
FF DO EVAL^PXRMFF(DFN,.DEFARR,.FIEVAL)
+1 QUIT
+2 ;
+3 ;=====================================================
EVALPL(DEFARR,FINUM,PLIST) ;Create a patient list for a regular
+1 ;finding.
+2 NEW FINDPA,TERMARR
+3 SET FINDPA(0)=DEFARR(20,FINUM,0)
+4 SET FINDPA(3)=DEFARR(20,FINUM,3)
+5 SET FINDPA(10)=DEFARR(20,FINUM,10)
+6 SET FINDPA(11)=DEFARR(20,FINUM,11)
+7 DO GENTERM^PXRMPLST(FINDPA(0),FINUM,.TERMARR)
+8 DO EVALPL^PXRMTERL(.FINDPA,.TERMARR,PLIST)
+9 QUIT
+10 ;
