PXRMTERM ;SLC/PKR - Handle reminder terms. ;10-Jun-2015 11:41;du
;;2.0;CLINICAL REMINDERS;**4,6,1001,11,18,26,1005**;Feb 04, 2005;Build 23
;
;IHS/MSC/MGH Patch 1001 added call for V measurements
;=============================================
COPY(NOCC,SDIR,TFIEVAL,DATEORDR,FINDING,FIEVAL,STF) ;Copy the NOCC date ordered
;findings from TFIEVAL to FIEVAL(FINDING).
N DATE,IND,JND,MRS,NFOUND,TFI
;Start with most recent and go to oldest finding.
S MRS=1
S NFOUND=0
S DATE=""
F S DATE=$O(DATEORDR(DATE),SDIR) Q:(NFOUND=NOCC)!(DATE="") D
. S TFI=0
. F S TFI=$O(DATEORDR(DATE,TFI)) Q:(NFOUND=NOCC)!(TFI="") D
.. I MRS D
...;Save the main result node.
... S FIEVAL(FINDING)=TFIEVAL(TFI)
... S MRS=0
... I 'FIEVAL(FINDING) Q
... S JND="@"
... F S JND=$O(TFIEVAL(TFI,JND)) Q:JND="" M FIEVAL(FINDING,JND)=TFIEVAL(TFI,JND)
.. I 'FIEVAL(FINDING) Q
.. S IND=0
.. F S IND=$O(DATEORDR(DATE,TFI,IND)) Q:(NFOUND=NOCC)!(IND="") D
...;Only save true sub-results.
... I 'TFIEVAL(TFI,IND) Q
... S NFOUND=NFOUND+1
... M FIEVAL(FINDING,NFOUND)=TFIEVAL(TFI,IND)
... S FIEVAL(FINDING,NFOUND,"FILE NUMBER")=TFIEVAL(TFI,"FILE NUMBER")
... S FIEVAL(FINDING,NFOUND,"FINDING")=TFIEVAL(TFI,"FINDING")
... I STF S FIEVAL(FINDING,NFOUND,"TERM FINDING")=TFI
... S JND=0
... F S JND=$O(TFIEVAL(TFI,IND,JND)) Q:JND="" M FIEVAL(FINDING,NFOUND,JND)=TFIEVAL(TFI,IND,JND)
Q
;
;=============================================
DORDER(TFIEVAL,DATEORDR) ;Order term findings by date, term finding,
;and term finding occurrence.
N DATE,FI,IND
K DATEORDR
S FI=0
F S FI=+$O(TFIEVAL(FI)) Q:FI=0 D
. S IND=0
. F S IND=+$O(TFIEVAL(FI,IND)) Q:IND=0 D
.. S DATE=$G(TFIEVAL(FI,IND,"DATE"))
.. I DATE'="" S DATEORDR(DATE,FI,IND)=""
Q
;
;=============================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate all reminder terms in a
;definition.
N CASESEN,CONVAL,DATE,DATEORDR
N FIEVT,FINDING,FINDPA,IND,NOCC
N SDIR,TFIND3,TFIND4,TERMARR,TERMIEN,TFI,TFIEVAL,UCIFS
S TERMIEN=""
F S TERMIEN=$O(DEFARR("E",ENODE,TERMIEN)) Q:+TERMIEN=0 D
. I '$D(^PXRMD(811.5,TERMIEN,20,"E")) D Q
.. S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFI",TERMIEN)="Warning no findings items in reminder term "_$P(^PXRMD(811.5,TERMIEN,0),U,1)
.. S FINDING=""
.. F S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:FINDING="" S FIEVAL(FINDING)=0
. D TERM^PXRMLDR(TERMIEN,.TERMARR)
. S FINDING=""
. F S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:+FINDING=0 D
.. S FIEVAL(FINDING)=0
.. S FIEVAL(FINDING,"TERM")=TERMARR(0)
.. S FIEVAL(FINDING,"TERM IEN")=TERMIEN
.. K FINDPA,TFIEVAL
.. M FINDPA=DEFARR(20,FINDING)
.. D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
.. I $G(PXRMTDEB) M ^TMP("PXRMTDEB",$J,FINDING)=TFIEVAL
..;Set NOCC and SDIR.
.. S NOCC=$P(FINDPA(0),U,14)
.. I NOCC="" S NOCC=1
.. S SDIR=$S(NOCC<0:+1,1:-1)
.. S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
..;Order the term findings by date.
.. D DORDER(.TFIEVAL,.DATEORDR)
.. D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL,1)
.. S IND=0
.. F S IND=+$O(FIEVAL(FINDING,IND)) Q:IND=0 S FIEVAL(FINDING,IND,"TERM FINDING")=$P(TERMARR(20,FIEVAL(FINDING,IND,"TERM FINDING"),0),U,1)
Q
;
;=============================================
EVALTERM(DFN,FINDPA,TERMARR,TFIEVAL) ;Evaluate all the findings in
;a term. Use the "E" cross-reference just like the finding evaluation.
N ENODE,PXRMDEFS
S ENODE=""
F S ENODE=$O(TERMARR("E",ENODE)) Q:ENODE="" D
. I ENODE="AUTTEDT(" D EVALTERM^PXRMEDU(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="AUTTEXAM(" D EVALTERM^PXRMEXAM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="AUTTHF(" D EVALTERM^PXRMHF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="AUTTIMM(" D EVALTERM^PXRMIMM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="AUTTSK(" D EVALTERM^PXRMSKIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="GMRD(120.51," D EVALTERM^PXRMVITL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="LAB(60," D EVALTERM^PXRMLAB(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="ORD(101.43," D EVALTERM^PXRMORDR(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PXD(811.2," D EVALTERM^PXRMTAX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PXRMD(810.9," D EVALTERM^PXRMLOCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PXRMD(811.4," D EVALTERM^PXRMCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PS(50.605," D EVALTERM^PXRMDRCL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PS(55," D EVALTERM^PXRMDIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PS(55NVA," D EVALTERM^PXRMDNVA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PSDRUG(" D EVALTERM^PXRMDRUG(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PSRX(" D EVALTERM^PXRMDOUT(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="PSNDF(50.6," D EVALTERM^PXRMDGEN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="RAMIS(71," D EVALTERM^PXRMRAD(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
. I ENODE="YTT(601.71," D EVALTERM^PXRMMH(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
.;IHS/MSC/MGH added calls for V files
.I ENODE="AUTTMSR(" D EVALTERM^BPXRMEA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
Q
;
;=============================================
IEVALTER(DFN,FINDPA,TERMARR,FINDING,FIEVAL) ;Evaluate an individual term
;put the result in FIEVAL(FINDING).
N DATEORDR,NOCC,SDIR,TFIEVAL
I '$D(PXRMDATE) N PXRMDATE S PXRMDATE=DT
I $D(PXRMPDEM) G DEMOK
N PXRMPDEM D DEM^PXRMPINF(DFN,DT,.PXRMPDEM)
;Create the local demographic variables for use in Condition.
N PXRMAGE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMSEX
S PXRMAGE=PXRMPDEM("AGE"),PXRMDOB=PXRMPDEM("DOB"),PXRMDOD=PXRMPDEM("DOD")
S PXRMLAD=PXRMPDEM("LAD"),PXRMSEX=PXRMPDEM("SEX")
DEMOK S FIEVAL(FINDING)=0
D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
;Set NOCC and SDIR.
S NOCC=$P(FINDPA(0),U,14)
I NOCC="" S NOCC=1
S SDIR=$S(NOCC<0:+1,1:-1)
S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
;Order the term findings by date.
D DORDER(.TFIEVAL,.DATEORDR)
D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL,0)
K ^TMP($J,"SVC",DFN)
Q
;
;=============================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"MHV")
Q
;
;=============================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
;maintenance output.
D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"CM")
Q
;
;=============================================
OPT(INDENT,IFIEVAL,NLINES,TEXT,TYPE) ;General output.
N DG,DGL,DGN,IEN,IND,JND,KND,INDENTT,FILENUM,TEMP,TIFIEVAL
;Build the display grouping.
S FILENUM=IFIEVAL(1,"FILE NUMBER")
S IEN=$P(IFIEVAL(1,"FINDING"),";",1)
S DG(FILENUM,IEN)=1,DGL(1)=FILENUM_U_IEN,DGL(1,1)=""
S (DGN,IND)=1
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S FILENUM=IFIEVAL(IND,"FILE NUMBER")
. S IEN=$P(IFIEVAL(IND,"FINDING"),";",1)
. I '$D(DG(FILENUM,IEN)) D
.. S DGN=DGN+1,DG(FILENUM,IEN)=DGN
.. S DGL(DGN)=FILENUM_U_IEN,DGL(DGN,IND)=""
. I $D(DG(FILENUM,IEN)) D
.. S TEMP=DG(FILENUM,IEN),DGL(TEMP,IND)=""
S INDENTT=INDENT+1
S TEMP=$$INSCHR^PXRMEXLC(INDENT," ")_"Reminder Term: "_$P(FIEVAL(FINDING,"TERM"),U,1)
S NLINES=NLINES+1,TEXT(NLINES)=TEMP
F IND=1:1:DGN D
. K TIFIEVAL
. S (JND,KND)=0
. F S JND=$O(DGL(IND,JND)) Q:JND="" D
.. S KND=KND+1
.. I KND=1 M TIFIEVAL=IFIEVAL(JND)
.. M TIFIEVAL(KND)=IFIEVAL(JND)
. I TYPE="CM" D FOUT^PXRMOUTC(INDENTT,.TIFIEVAL,.NLINES,.TEXT)
. I TYPE="MHV" D FOUT^PXRMOUTM(INDENTT,.TIFIEVAL,.NLINES,.TEXT)
Q
;
;=============================================
SPFINDPA(FINDPA,TFINDPA,PFINDPA) ;Set the finding parameter array
;for terms.
N FIND0,PIECE,PFIND0,TFIND0,VAL
S FIND0=$G(FINDPA(0))
S (PFIND0,TFIND0)=TFINDPA(0)
;Set the 0 node.
F PIECE=9,10,12,13,14,15,16 D
. S VAL=$P(TFIND0,U,PIECE)
. I VAL="" S VAL=$P(FIND0,U,PIECE)
. S $P(PFIND0,U,PIECE)=VAL
;BDT and EDT are treated as a pair.
I $P(TFIND0,U,8)="",$P(TFIND0,U,11)="" F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(FIND0,U,PIECE)
E F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(TFIND0,U,PIECE)
S PFINDPA(0)=PFIND0
I $P($G(TFINDPA(3)),U,1)'="" S PFINDPA(3)=TFINDPA(3),PFINDPA(10)=TFINDPA(10),PFINDPA(11)=TFINDPA(11)
E S PFINDPA(3)=$G(FINDPA(3)),PFINDPA(10)=$G(FINDPA(10)),PFINDPA(11)=$G(FINDPA(11))
;Get the status list.
I $D(TFINDPA(5)) M PFINDPA(5)=TFINDPA(5)
E M PFINDPA(5)=FINDPA(5)
I $D(TFINDPA(15)) S PFINDPA(15)=TFINDPA(15)
E S PFINDPA(15)=$G(FINDPA(15))
Q
;
PXRMTERM ;SLC/PKR - Handle reminder terms. ;10-Jun-2015 11:41;du
+1 ;;2.0;CLINICAL REMINDERS;**4,6,1001,11,18,26,1005**;Feb 04, 2005;Build 23
+2 ;
+3 ;IHS/MSC/MGH Patch 1001 added call for V measurements
+4 ;=============================================
COPY(NOCC,SDIR,TFIEVAL,DATEORDR,FINDING,FIEVAL,STF) ;Copy the NOCC date ordered
+1 ;findings from TFIEVAL to FIEVAL(FINDING).
+2 NEW DATE,IND,JND,MRS,NFOUND,TFI
+3 ;Start with most recent and go to oldest finding.
+4 SET MRS=1
+5 SET NFOUND=0
+6 SET DATE=""
+7 FOR
SET DATE=$ORDER(DATEORDR(DATE),SDIR)
IF (NFOUND=NOCC)!(DATE="")
QUIT
Begin DoDot:1
+8 SET TFI=0
+9 FOR
SET TFI=$ORDER(DATEORDR(DATE,TFI))
IF (NFOUND=NOCC)!(TFI="")
QUIT
Begin DoDot:2
+10 IF MRS
Begin DoDot:3
+11 ;Save the main result node.
+12 SET FIEVAL(FINDING)=TFIEVAL(TFI)
+13 SET MRS=0
+14 IF 'FIEVAL(FINDING)
QUIT
+15 SET JND="@"
+16 FOR
SET JND=$ORDER(TFIEVAL(TFI,JND))
IF JND=""
QUIT
MERGE FIEVAL(FINDING,JND)=TFIEVAL(TFI,JND)
End DoDot:3
+17 IF 'FIEVAL(FINDING)
QUIT
+18 SET IND=0
+19 FOR
SET IND=$ORDER(DATEORDR(DATE,TFI,IND))
IF (NFOUND=NOCC)!(IND="")
QUIT
Begin DoDot:3
+20 ;Only save true sub-results.
+21 IF 'TFIEVAL(TFI,IND)
QUIT
+22 SET NFOUND=NFOUND+1
+23 MERGE FIEVAL(FINDING,NFOUND)=TFIEVAL(TFI,IND)
+24 SET FIEVAL(FINDING,NFOUND,"FILE NUMBER")=TFIEVAL(TFI,"FILE NUMBER")
+25 SET FIEVAL(FINDING,NFOUND,"FINDING")=TFIEVAL(TFI,"FINDING")
+26 IF STF
SET FIEVAL(FINDING,NFOUND,"TERM FINDING")=TFI
+27 SET JND=0
+28 FOR
SET JND=$ORDER(TFIEVAL(TFI,IND,JND))
IF JND=""
QUIT
MERGE FIEVAL(FINDING,NFOUND,JND)=TFIEVAL(TFI,IND,JND)
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
+31 ;=============================================
DORDER(TFIEVAL,DATEORDR) ;Order term findings by date, term finding,
+1 ;and term finding occurrence.
+2 NEW DATE,FI,IND
+3 KILL DATEORDR
+4 SET FI=0
+5 FOR
SET FI=+$ORDER(TFIEVAL(FI))
IF FI=0
QUIT
Begin DoDot:1
+6 SET IND=0
+7 FOR
SET IND=+$ORDER(TFIEVAL(FI,IND))
IF IND=0
QUIT
Begin DoDot:2
+8 SET DATE=$GET(TFIEVAL(FI,IND,"DATE"))
+9 IF DATE'=""
SET DATEORDR(DATE,FI,IND)=""
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
+12 ;=============================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate all reminder terms in a
+1 ;definition.
+2 NEW CASESEN,CONVAL,DATE,DATEORDR
+3 NEW FIEVT,FINDING,FINDPA,IND,NOCC
+4 NEW SDIR,TFIND3,TFIND4,TERMARR,TERMIEN,TFI,TFIEVAL,UCIFS
+5 SET TERMIEN=""
+6 FOR
SET TERMIEN=$ORDER(DEFARR("E",ENODE,TERMIEN))
IF +TERMIEN=0
QUIT
Begin DoDot:1
+7 IF '$DATA(^PXRMD(811.5,TERMIEN,20,"E"))
Begin DoDot:2
+8 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"WARNING","NOFI",TERMIEN)="Warning no findings items in reminder term "_$PIECE(^PXRMD(811.5,TERMIEN,0),U,1)
+9 SET FINDING=""
+10 FOR
SET FINDING=$ORDER(DEFARR("E",ENODE,TERMIEN,FINDING))
IF FINDING=""
QUIT
SET FIEVAL(FINDING)=0
End DoDot:2
QUIT
+11 DO TERM^PXRMLDR(TERMIEN,.TERMARR)
+12 SET FINDING=""
+13 FOR
SET FINDING=$ORDER(DEFARR("E",ENODE,TERMIEN,FINDING))
IF +FINDING=0
QUIT
Begin DoDot:2
+14 SET FIEVAL(FINDING)=0
+15 SET FIEVAL(FINDING,"TERM")=TERMARR(0)
+16 SET FIEVAL(FINDING,"TERM IEN")=TERMIEN
+17 KILL FINDPA,TFIEVAL
+18 MERGE FINDPA=DEFARR(20,FINDING)
+19 DO EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
+20 IF $GET(PXRMTDEB)
MERGE ^TMP("PXRMTDEB",$JOB,FINDING)=TFIEVAL
+21 ;Set NOCC and SDIR.
+22 SET NOCC=$PIECE(FINDPA(0),U,14)
+23 IF NOCC=""
SET NOCC=1
+24 SET SDIR=$SELECT(NOCC<0:+1,1:-1)
+25 SET NOCC=$SELECT(NOCC<0:-NOCC,1:NOCC)
+26 ;Order the term findings by date.
+27 DO DORDER(.TFIEVAL,.DATEORDR)
+28 DO COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL,1)
+29 SET IND=0
+30 FOR
SET IND=+$ORDER(FIEVAL(FINDING,IND))
IF IND=0
QUIT
SET FIEVAL(FINDING,IND,"TERM FINDING")=$PIECE(TERMARR(20,FIEVAL(FINDING,IND,"TERM FINDING"),0),U,1)
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
+33 ;=============================================
EVALTERM(DFN,FINDPA,TERMARR,TFIEVAL) ;Evaluate all the findings in
+1 ;a term. Use the "E" cross-reference just like the finding evaluation.
+2 NEW ENODE,PXRMDEFS
+3 SET ENODE=""
+4 FOR
SET ENODE=$ORDER(TERMARR("E",ENODE))
IF ENODE=""
QUIT
Begin DoDot:1
+5 IF ENODE="AUTTEDT("
DO EVALTERM^PXRMEDU(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+6 IF ENODE="AUTTEXAM("
DO EVALTERM^PXRMEXAM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+7 IF ENODE="AUTTHF("
DO EVALTERM^PXRMHF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+8 IF ENODE="AUTTIMM("
DO EVALTERM^PXRMIMM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+9 IF ENODE="AUTTSK("
DO EVALTERM^PXRMSKIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+10 IF ENODE="GMRD(120.51,"
DO EVALTERM^PXRMVITL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+11 IF ENODE="LAB(60,"
DO EVALTERM^PXRMLAB(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+12 IF ENODE="ORD(101.43,"
DO EVALTERM^PXRMORDR(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+13 IF ENODE="PXD(811.2,"
DO EVALTERM^PXRMTAX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+14 IF ENODE="PXRMD(810.9,"
DO EVALTERM^PXRMLOCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+15 IF ENODE="PXRMD(811.4,"
DO EVALTERM^PXRMCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+16 IF ENODE="PS(50.605,"
DO EVALTERM^PXRMDRCL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+17 IF ENODE="PS(55,"
DO EVALTERM^PXRMDIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+18 IF ENODE="PS(55NVA,"
DO EVALTERM^PXRMDNVA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+19 IF ENODE="PSDRUG("
DO EVALTERM^PXRMDRUG(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+20 IF ENODE="PSRX("
DO EVALTERM^PXRMDOUT(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+21 IF ENODE="PSNDF(50.6,"
DO EVALTERM^PXRMDGEN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+22 IF ENODE="RAMIS(71,"
DO EVALTERM^PXRMRAD(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+23 IF ENODE="YTT(601.71,"
DO EVALTERM^PXRMMH(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
+24 ;IHS/MSC/MGH added calls for V files
+25 IF ENODE="AUTTMSR("
DO EVALTERM^BPXRMEA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
QUIT
End DoDot:1
+26 QUIT
+27 ;
+28 ;=============================================
IEVALTER(DFN,FINDPA,TERMARR,FINDING,FIEVAL) ;Evaluate an individual term
+1 ;put the result in FIEVAL(FINDING).
+2 NEW DATEORDR,NOCC,SDIR,TFIEVAL
+3 IF '$DATA(PXRMDATE)
NEW PXRMDATE
SET PXRMDATE=DT
+4 IF $DATA(PXRMPDEM)
GOTO DEMOK
+5 NEW PXRMPDEM
DO DEM^PXRMPINF(DFN,DT,.PXRMPDEM)
+6 ;Create the local demographic variables for use in Condition.
+7 NEW PXRMAGE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMSEX
+8 SET PXRMAGE=PXRMPDEM("AGE")
SET PXRMDOB=PXRMPDEM("DOB")
SET PXRMDOD=PXRMPDEM("DOD")
+9 SET PXRMLAD=PXRMPDEM("LAD")
SET PXRMSEX=PXRMPDEM("SEX")
DEMOK SET FIEVAL(FINDING)=0
+1 DO EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
+2 ;Set NOCC and SDIR.
+3 SET NOCC=$PIECE(FINDPA(0),U,14)
+4 IF NOCC=""
SET NOCC=1
+5 SET SDIR=$SELECT(NOCC<0:+1,1:-1)
+6 SET NOCC=$SELECT(NOCC<0:-NOCC,1:NOCC)
+7 ;Order the term findings by date.
+8 DO DORDER(.TFIEVAL,.DATEORDR)
+9 DO COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL,0)
+10 KILL ^TMP($JOB,"SVC",DFN)
+11 QUIT
+12 ;
+13 ;=============================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 DO OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"MHV")
+2 QUIT
+3 ;
+4 ;=============================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+1 ;maintenance output.
+2 DO OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"CM")
+3 QUIT
+4 ;
+5 ;=============================================
OPT(INDENT,IFIEVAL,NLINES,TEXT,TYPE) ;General output.
+1 NEW DG,DGL,DGN,IEN,IND,JND,KND,INDENTT,FILENUM,TEMP,TIFIEVAL
+2 ;Build the display grouping.
+3 SET FILENUM=IFIEVAL(1,"FILE NUMBER")
+4 SET IEN=$PIECE(IFIEVAL(1,"FINDING"),";",1)
+5 SET DG(FILENUM,IEN)=1
SET DGL(1)=FILENUM_U_IEN
SET DGL(1,1)=""
+6 SET (DGN,IND)=1
+7 FOR
SET IND=+$ORDER(IFIEVAL(IND))
IF IND=0
QUIT
Begin DoDot:1
+8 SET FILENUM=IFIEVAL(IND,"FILE NUMBER")
+9 SET IEN=$PIECE(IFIEVAL(IND,"FINDING"),";",1)
+10 IF '$DATA(DG(FILENUM,IEN))
Begin DoDot:2
+11 SET DGN=DGN+1
SET DG(FILENUM,IEN)=DGN
+12 SET DGL(DGN)=FILENUM_U_IEN
SET DGL(DGN,IND)=""
End DoDot:2
+13 IF $DATA(DG(FILENUM,IEN))
Begin DoDot:2
+14 SET TEMP=DG(FILENUM,IEN)
SET DGL(TEMP,IND)=""
End DoDot:2
End DoDot:1
+15 SET INDENTT=INDENT+1
+16 SET TEMP=$$INSCHR^PXRMEXLC(INDENT," ")_"Reminder Term: "_$PIECE(FIEVAL(FINDING,"TERM"),U,1)
+17 SET NLINES=NLINES+1
SET TEXT(NLINES)=TEMP
+18 FOR IND=1:1:DGN
Begin DoDot:1
+19 KILL TIFIEVAL
+20 SET (JND,KND)=0
+21 FOR
SET JND=$ORDER(DGL(IND,JND))
IF JND=""
QUIT
Begin DoDot:2
+22 SET KND=KND+1
+23 IF KND=1
MERGE TIFIEVAL=IFIEVAL(JND)
+24 MERGE TIFIEVAL(KND)=IFIEVAL(JND)
End DoDot:2
+25 IF TYPE="CM"
DO FOUT^PXRMOUTC(INDENTT,.TIFIEVAL,.NLINES,.TEXT)
+26 IF TYPE="MHV"
DO FOUT^PXRMOUTM(INDENTT,.TIFIEVAL,.NLINES,.TEXT)
End DoDot:1
+27 QUIT
+28 ;
+29 ;=============================================
SPFINDPA(FINDPA,TFINDPA,PFINDPA) ;Set the finding parameter array
+1 ;for terms.
+2 NEW FIND0,PIECE,PFIND0,TFIND0,VAL
+3 SET FIND0=$GET(FINDPA(0))
+4 SET (PFIND0,TFIND0)=TFINDPA(0)
+5 ;Set the 0 node.
+6 FOR PIECE=9,10,12,13,14,15,16
Begin DoDot:1
+7 SET VAL=$PIECE(TFIND0,U,PIECE)
+8 IF VAL=""
SET VAL=$PIECE(FIND0,U,PIECE)
+9 SET $PIECE(PFIND0,U,PIECE)=VAL
End DoDot:1
+10 ;BDT and EDT are treated as a pair.
+11 IF $PIECE(TFIND0,U,8)=""
IF $PIECE(TFIND0,U,11)=""
FOR PIECE=8,11
SET $PIECE(PFIND0,U,PIECE)=$PIECE(FIND0,U,PIECE)
+12 IF '$TEST
FOR PIECE=8,11
SET $PIECE(PFIND0,U,PIECE)=$PIECE(TFIND0,U,PIECE)
+13 SET PFINDPA(0)=PFIND0
+14 IF $PIECE($GET(TFINDPA(3)),U,1)'=""
SET PFINDPA(3)=TFINDPA(3)
SET PFINDPA(10)=TFINDPA(10)
SET PFINDPA(11)=TFINDPA(11)
+15 IF '$TEST
SET PFINDPA(3)=$GET(FINDPA(3))
SET PFINDPA(10)=$GET(FINDPA(10))
SET PFINDPA(11)=$GET(FINDPA(11))
+16 ;Get the status list.
+17 IF $DATA(TFINDPA(5))
MERGE PFINDPA(5)=TFINDPA(5)
+18 IF '$TEST
MERGE PFINDPA(5)=FINDPA(5)
+19 IF $DATA(TFINDPA(15))
SET PFINDPA(15)=TFINDPA(15)
+20 IF '$TEST
SET PFINDPA(15)=$GET(FINDPA(15))
+21 QUIT
+22 ;
