- 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 ;
