PXRMINDX ;SLC/PKR - Routines for utilizing the index. ;03/31/2022
;;2.0;CLINICAL REMINDERS;**4,6,12,17,18,26,65**;Feb 04, 2005;Build 438
;Code for patient findings.
;====================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;General finding evaluator.
N BDT,EDT,FIEVT,FILENUM,FINDING,FINDPA,ITEM,NOINDEX
S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("D",PXRMITEM,FILENUM)
. S NOINDEX=1
E S NOINDEX=0
S ITEM=""
F S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:ITEM="" D
. S FINDING=""
. F S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0 D
.. I NOINDEX S FIEVAL(FINDING)=0 Q
.. K FINDPA
.. M FINDPA=DEFARR(20,FINDING)
.. K FIEVT
.. D FIEVAL(FILENUM,"PI",DFN,ITEM,.FINDPA,.FIEVT)
.. M FIEVAL(FINDING)=FIEVT
.. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
.. I FILENUM=9000010.11 D CRFINDING^PXRMIMM(DFN,ITEM,FINDING,.FIEVAL)
Q
;
;====================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;General term
;evaluator.
N FIEVT,FILENUM,ITEM,NOINDEX,PFINDPA
N TFINDING,TFINDPA
S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),FILENUM)
. S NOINDEX=1
E S NOINDEX=0
S ITEM=""
F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:ITEM="" D
. S TFINDING=""
. F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
.. I NOINDEX S TFIEVAL(TFINDING)=0 Q
.. K FIEVT,PFINDPA,TFINDPA
.. M TFINDPA=TERMARR(20,TFINDING)
..;Set the finding parameters.
.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
.. D FIEVAL(FILENUM,"PI",DFN,ITEM,.PFINDPA,.FIEVT)
.. M TFIEVAL(TFINDING)=FIEVT
.. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
.. I FILENUM=9000010.11 D CRFINDING^PXRMIMM(DFN,ITEM,TFINDING,.TFIEVAL)
Q
;
;====================
FIEVAL(FILENUM,SNODE,DFN,ITEM,PFINDPA,FIEVAL) ;
;Evaluate regular patient findings.
N BDT,CASESEN,COND,CONVAL,CRLIST,DAS,DATE,EDT,FIEVD,FLIST
N ICOND,IEN,IND,INVFD,ISC,NFOUND,NGET,NOCC,NP
N SAVE,SDIR,SSFIND,STATOK,STATUSA,UCIFS,USESTRT,VSLIST
;Set the finding search parameters.
D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
S FIEVAL("BDTE")=BDT,FIEVAL("EDTE")=EDT
D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
S SDIR=$S(NOCC<0:+1,1:-1)
S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
S NGET=$S(UCIFS:50,1:NOCC)
S ISC=$S(FILENUM=9000010.11:$P(PFINDPA(0),U,17),1:"")
;Determine if this is a finding with a start and stop date.
S SSFIND=$S(FILENUM=52:1,FILENUM["55":1,FILENUM=100:1,1:0)
S USESTRT=$S(SSFIND:$P(PFINDPA(0),U,15),1:0)
I FILENUM=100,USESTRT="" S USESTRT=1
;Get the status list.
D GETSTATI^PXRMSTAT(FILENUM,.PFINDPA,.STATUSA)
I SSFIND D FPDATSS(FILENUM,SNODE,DFN,ITEM,NGET,SDIR,BDT,EDT,USESTRT,.NFOUND,.FLIST)
I 'SSFIND D FPDAT(FILENUM,SNODE,ISC,DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
I NFOUND=0 S FIEVAL=0 Q
S INVFD=$P(PFINDPA(0),U,16)
S NP=0
F IND=1:1:NFOUND Q:NP=NOCC D
. S DAS=$P(FLIST(IND),U,1)
.;If this a Lab finding attach the item to the DAS.
. I PFINDPA(0)["LAB(60" S DAS=ITEM_"~"_DAS
.;If this is a Mental Health finding attach the scale to DAS.
. I PFINDPA(0)["YTT(601.71" S DAS=DAS_"S"_$P(PFINDPA(0),U,12)
. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
. I INVFD,$D(FIEVD("VISIT")) D GETDATA^PXRMVSIT(FIEVD("VISIT"),.FIEVD,0)
. S FIEVD("DATE")=$P(FLIST(IND),U,2)
. I ISC'="" S FIEVD("ISC")=ISC
.;If there is a status list make sure the finding has one on the list.
. S STATOK=$S($D(STATUSA):$$STATUSOK(.STATUSA,.FIEVD),1:1)
. I 'STATOK Q
. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1)
. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
. I SAVE D
.. S NP=NP+1
.. S FIEVAL(NP)=CONVAL
.. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
.. S FIEVAL(NP,"DAS")=$P(FLIST(IND),U,1)
.. S FIEVAL(NP,"DATE")=FIEVD("DATE")
.. M FIEVAL(NP)=FIEVD
.. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVD
;
;Save the finding result.
D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
S FIEVAL("FILE NUMBER")=FILENUM
Q
;
;====================
FPDAT(FILENUM,SNODE,ISC,DFN,ITEM,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;Find patient
;data for regular files. FLIST is returned in date order, i.e.,
;FLIST(1) is the most recent SDIR=-1, oldest SDIR=+1.
I (FILENUM=9000010.11),(ISC="CVX") D CVXP^PXRMIMM(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST) Q
I (FILENUM=9000010.11),(ISC="VGN") D VGNP^PXRMIMM(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST) Q
I FILENUM=601.84 D SEVALFI^PXRMMH(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST) Q
N DAS,DATE,DONE,EDTT
S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
S (DONE,NFOUND)=0
S DATE=$S(SDIR=+1:BDT-.000001,1:EDTT)
F S DATE=+$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,DATE),SDIR) Q:(DATE=0)!(DONE) D
. I DATE<BDT,SDIR=-1 S DONE=1 Q
. I DATE>EDTT,SDIR=1 S DONE=1 Q
. S DAS=""
. F S DAS=$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,DATE,DAS),-1) Q:DAS="" D
.. S NFOUND=NFOUND+1
.. S FLIST(NFOUND)=DAS_U_DATE
.. I NFOUND=NGET S DONE=1 Q
Q
;
;====================
FPDATSS(FILENUM,SNODE,DFN,ITEM,NGET,SDIR,BDT,EDT,USESTRT,NFOUND,FLIST) ;Find
;patient data for findings that have a start and stop date. FLIST
;is returned in date order, i.e., FLIST(1) is the most recent.
N DAS,DONE,EDTT,OVERLAP,SDATE,START,STOP,TDATE,TIND,TLIST
S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
S (DONE,NFOUND)=0
S START=$S(SDIR=+1:0,1:EDTT)
F S START=+$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START),SDIR) Q:(START=0)!(DONE)!(START>EDTT) D
. S STOP=""
. F S STOP=$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START,STOP),SDIR) Q:(STOP="")!(DONE) D
..;Items that do not have a stop date are flagged by "U".
.. S SDATE=$S(USESTRT:START,STOP["U":$$NOW^PXRMDATE_"U",1:STOP)
.. S OVERLAP=$$OVERLAP(START,SDATE,BDT,EDT)
.. I OVERLAP="O" D
... S DAS=$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START,STOP,""))
... S NFOUND=NFOUND+1,TLIST(SDATE,NFOUND)=DAS_U_SDATE
..;Some orders and non-VA meds may not have a Stop Date so we have
..;to check all entries.
.. I FILENUM="55NVA" Q
.. I FILENUM=100 Q
.. I OVERLAP="L",SDIR=-1 S DONE=1 Q
.. I OVERLAP="R",SDIR=1 S DONE=1 Q
;Return up to NGET of the most recent/oldest entries.
S NFOUND=0,TDATE=""
F S TDATE=$O(TLIST(TDATE),SDIR) Q:(TDATE="")!(NFOUND=NGET) D
. S TIND=0
. F S TIND=$O(TLIST(TDATE,TIND)) Q:(TIND="")!(NFOUND=NGET) D
.. S NFOUND=NFOUND+1,FLIST(NFOUND)=TLIST(TDATE,TIND)
Q
;
;====================
OVERLAP(START,STOP,BDT,EDT) ;Determine if the date range defined by START and
;STOP overlaps with the date range defined by BDT and EDT. The return
;value "O" means they overlap, "L" means START, STOP is to the
;left of BDT, EDT and "R" means it is to the right.
I EDT<START Q "R"
I STOP<BDT Q "L"
Q "O"
;
;====================
STATUSOK(STATUSA,FIEVD) ;Return true if the status in FIEVD matches one in
;the list in STATUSA.
I '$D(FIEVD("STATUS")) Q 1
N JND,OK
S OK=0
F JND=1:1:STATUSA(0) Q:OK D
. I STATUSA(JND)="*" S OK=1 Q
. I STATUSA(JND)=FIEVD("STATUS") S OK=1 Q
Q OK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMINDX 7065 printed Oct 16, 2024@17:47:03 Page 2
PXRMINDX ;SLC/PKR - Routines for utilizing the index. ;03/31/2022
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,17,18,26,65**;Feb 04, 2005;Build 438
+2 ;Code for patient findings.
+3 ;====================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;General finding evaluator.
+1 NEW BDT,EDT,FIEVT,FILENUM,FINDING,FINDPA,ITEM,NOINDEX
+2 SET FILENUM=$$GETFNUM^PXRMDATA(ENODE)
+3 IF $GET(^PXRMINDX(FILENUM,"DATE BUILT"))=""
Begin DoDot:1
+4 DO NOINDEX^PXRMERRH("D",PXRMITEM,FILENUM)
+5 SET NOINDEX=1
End DoDot:1
+6 IF '$TEST
SET NOINDEX=0
+7 SET ITEM=""
+8 FOR
SET ITEM=$ORDER(DEFARR("E",ENODE,ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+9 SET FINDING=""
+10 FOR
SET FINDING=$ORDER(DEFARR("E",ENODE,ITEM,FINDING))
if +FINDING=0
QUIT
Begin DoDot:2
+11 IF NOINDEX
SET FIEVAL(FINDING)=0
QUIT
+12 KILL FINDPA
+13 MERGE FINDPA=DEFARR(20,FINDING)
+14 KILL FIEVT
+15 DO FIEVAL(FILENUM,"PI",DFN,ITEM,.FINDPA,.FIEVT)
+16 MERGE FIEVAL(FINDING)=FIEVT
+17 SET FIEVAL(FINDING,"FINDING")=$PIECE(FINDPA(0),U,1)
+18 IF FILENUM=9000010.11
DO CRFINDING^PXRMIMM(DFN,ITEM,FINDING,.FIEVAL)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;====================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;General term
+1 ;evaluator.
+2 NEW FIEVT,FILENUM,ITEM,NOINDEX,PFINDPA
+3 NEW TFINDING,TFINDPA
+4 SET FILENUM=$$GETFNUM^PXRMDATA(ENODE)
+5 IF $GET(^PXRMINDX(FILENUM,"DATE BUILT"))=""
Begin DoDot:1
+6 DO NOINDEX^PXRMERRH("TR",TERMARR("IEN"),FILENUM)
+7 SET NOINDEX=1
End DoDot:1
+8 IF '$TEST
SET NOINDEX=0
+9 SET ITEM=""
+10 FOR
SET ITEM=$ORDER(TERMARR("E",ENODE,ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+11 SET TFINDING=""
+12 FOR
SET TFINDING=$ORDER(TERMARR("E",ENODE,ITEM,TFINDING))
if +TFINDING=0
QUIT
Begin DoDot:2
+13 IF NOINDEX
SET TFIEVAL(TFINDING)=0
QUIT
+14 KILL FIEVT,PFINDPA,TFINDPA
+15 MERGE TFINDPA=TERMARR(20,TFINDING)
+16 ;Set the finding parameters.
+17 DO SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+18 DO FIEVAL(FILENUM,"PI",DFN,ITEM,.PFINDPA,.FIEVT)
+19 MERGE TFIEVAL(TFINDING)=FIEVT
+20 SET TFIEVAL(TFINDING,"FINDING")=$PIECE(TFINDPA(0),U,1)
+21 IF FILENUM=9000010.11
DO CRFINDING^PXRMIMM(DFN,ITEM,TFINDING,.TFIEVAL)
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
+24 ;====================
FIEVAL(FILENUM,SNODE,DFN,ITEM,PFINDPA,FIEVAL) ;
+1 ;Evaluate regular patient findings.
+2 NEW BDT,CASESEN,COND,CONVAL,CRLIST,DAS,DATE,EDT,FIEVD,FLIST
+3 NEW ICOND,IEN,IND,INVFD,ISC,NFOUND,NGET,NOCC,NP
+4 NEW SAVE,SDIR,SSFIND,STATOK,STATUSA,UCIFS,USESTRT,VSLIST
+5 ;Set the finding search parameters.
+6 DO SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
+7 SET FIEVAL("BDTE")=BDT
SET FIEVAL("EDTE")=EDT
+8 DO SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
+9 SET SDIR=$SELECT(NOCC<0:+1,1:-1)
+10 SET NOCC=$SELECT(NOCC<0:-NOCC,1:NOCC)
+11 SET NGET=$SELECT(UCIFS:50,1:NOCC)
+12 SET ISC=$SELECT(FILENUM=9000010.11:$PIECE(PFINDPA(0),U,17),1:"")
+13 ;Determine if this is a finding with a start and stop date.
+14 SET SSFIND=$SELECT(FILENUM=52:1,FILENUM["55":1,FILENUM=100:1,1:0)
+15 SET USESTRT=$SELECT(SSFIND:$PIECE(PFINDPA(0),U,15),1:0)
+16 IF FILENUM=100
IF USESTRT=""
SET USESTRT=1
+17 ;Get the status list.
+18 DO GETSTATI^PXRMSTAT(FILENUM,.PFINDPA,.STATUSA)
+19 IF SSFIND
DO FPDATSS(FILENUM,SNODE,DFN,ITEM,NGET,SDIR,BDT,EDT,USESTRT,.NFOUND,.FLIST)
+20 IF 'SSFIND
DO FPDAT(FILENUM,SNODE,ISC,DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
+21 IF NFOUND=0
SET FIEVAL=0
QUIT
+22 SET INVFD=$PIECE(PFINDPA(0),U,16)
+23 SET NP=0
+24 FOR IND=1:1:NFOUND
if NP=NOCC
QUIT
Begin DoDot:1
+25 SET DAS=$PIECE(FLIST(IND),U,1)
+26 ;If this a Lab finding attach the item to the DAS.
+27 IF PFINDPA(0)["LAB(60"
SET DAS=ITEM_"~"_DAS
+28 ;If this is a Mental Health finding attach the scale to DAS.
+29 IF PFINDPA(0)["YTT(601.71"
SET DAS=DAS_"S"_$PIECE(PFINDPA(0),U,12)
+30 DO GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
+31 IF INVFD
IF $DATA(FIEVD("VISIT"))
DO GETDATA^PXRMVSIT(FIEVD("VISIT"),.FIEVD,0)
+32 SET FIEVD("DATE")=$PIECE(FLIST(IND),U,2)
+33 IF ISC'=""
SET FIEVD("ISC")=ISC
+34 ;If there is a status list make sure the finding has one on the list.
+35 SET STATOK=$SELECT($DATA(STATUSA):$$STATUSOK(.STATUSA,.FIEVD),1:1)
+36 IF 'STATOK
QUIT
+37 SET CONVAL=$SELECT(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1)
+38 SET SAVE=$SELECT('UCIFS:1,(UCIFS&CONVAL):1,1:0)
+39 IF SAVE
Begin DoDot:2
+40 SET NP=NP+1
+41 SET FIEVAL(NP)=CONVAL
+42 IF COND'=""
SET FIEVAL(NP,"CONDITION")=CONVAL
+43 SET FIEVAL(NP,"DAS")=$PIECE(FLIST(IND),U,1)
+44 SET FIEVAL(NP,"DATE")=FIEVD("DATE")
+45 MERGE FIEVAL(NP)=FIEVD
+46 IF $GET(PXRMDEBG)
MERGE FIEVAL(NP,"CSUB")=FIEVD
End DoDot:2
End DoDot:1
+47 ;
+48 ;Save the finding result.
+49 DO SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
+50 SET FIEVAL("FILE NUMBER")=FILENUM
+51 QUIT
+52 ;
+53 ;====================
FPDAT(FILENUM,SNODE,ISC,DFN,ITEM,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;Find patient
+1 ;data for regular files. FLIST is returned in date order, i.e.,
+2 ;FLIST(1) is the most recent SDIR=-1, oldest SDIR=+1.
+3 IF (FILENUM=9000010.11)
IF (ISC="CVX")
DO CVXP^PXRMIMM(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
QUIT
+4 IF (FILENUM=9000010.11)
IF (ISC="VGN")
DO VGNP^PXRMIMM(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
QUIT
+5 IF FILENUM=601.84
DO SEVALFI^PXRMMH(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
QUIT
+6 NEW DAS,DATE,DONE,EDTT
+7 SET EDTT=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+8 SET (DONE,NFOUND)=0
+9 SET DATE=$SELECT(SDIR=+1:BDT-.000001,1:EDTT)
+10 FOR
SET DATE=+$ORDER(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,DATE),SDIR)
if (DATE=0)!(DONE)
QUIT
Begin DoDot:1
+11 IF DATE<BDT
IF SDIR=-1
SET DONE=1
QUIT
+12 IF DATE>EDTT
IF SDIR=1
SET DONE=1
QUIT
+13 SET DAS=""
+14 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,DATE,DAS),-1)
if DAS=""
QUIT
Begin DoDot:2
+15 SET NFOUND=NFOUND+1
+16 SET FLIST(NFOUND)=DAS_U_DATE
+17 IF NFOUND=NGET
SET DONE=1
QUIT
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
+20 ;====================
FPDATSS(FILENUM,SNODE,DFN,ITEM,NGET,SDIR,BDT,EDT,USESTRT,NFOUND,FLIST) ;Find
+1 ;patient data for findings that have a start and stop date. FLIST
+2 ;is returned in date order, i.e., FLIST(1) is the most recent.
+3 NEW DAS,DONE,EDTT,OVERLAP,SDATE,START,STOP,TDATE,TIND,TLIST
+4 SET EDTT=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+5 SET (DONE,NFOUND)=0
+6 SET START=$SELECT(SDIR=+1:0,1:EDTT)
+7 FOR
SET START=+$ORDER(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START),SDIR)
if (START=0)!(DONE)!(START>EDTT)
QUIT
Begin DoDot:1
+8 SET STOP=""
+9 FOR
SET STOP=$ORDER(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START,STOP),SDIR)
if (STOP="")!(DONE)
QUIT
Begin DoDot:2
+10 ;Items that do not have a stop date are flagged by "U".
+11 SET SDATE=$SELECT(USESTRT:START,STOP["U":$$NOW^PXRMDATE_"U",1:STOP)
+12 SET OVERLAP=$$OVERLAP(START,SDATE,BDT,EDT)
+13 IF OVERLAP="O"
Begin DoDot:3
+14 SET DAS=$ORDER(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START,STOP,""))
+15 SET NFOUND=NFOUND+1
SET TLIST(SDATE,NFOUND)=DAS_U_SDATE
End DoDot:3
+16 ;Some orders and non-VA meds may not have a Stop Date so we have
+17 ;to check all entries.
+18 IF FILENUM="55NVA"
QUIT
+19 IF FILENUM=100
QUIT
+20 IF OVERLAP="L"
IF SDIR=-1
SET DONE=1
QUIT
+21 IF OVERLAP="R"
IF SDIR=1
SET DONE=1
QUIT
End DoDot:2
End DoDot:1
+22 ;Return up to NGET of the most recent/oldest entries.
+23 SET NFOUND=0
SET TDATE=""
+24 FOR
SET TDATE=$ORDER(TLIST(TDATE),SDIR)
if (TDATE="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+25 SET TIND=0
+26 FOR
SET TIND=$ORDER(TLIST(TDATE,TIND))
if (TIND="")!(NFOUND=NGET)
QUIT
Begin DoDot:2
+27 SET NFOUND=NFOUND+1
SET FLIST(NFOUND)=TLIST(TDATE,TIND)
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
+30 ;====================
OVERLAP(START,STOP,BDT,EDT) ;Determine if the date range defined by START and
+1 ;STOP overlaps with the date range defined by BDT and EDT. The return
+2 ;value "O" means they overlap, "L" means START, STOP is to the
+3 ;left of BDT, EDT and "R" means it is to the right.
+4 IF EDT<START
QUIT "R"
+5 IF STOP<BDT
QUIT "L"
+6 QUIT "O"
+7 ;
+8 ;====================
STATUSOK(STATUSA,FIEVD) ;Return true if the status in FIEVD matches one in
+1 ;the list in STATUSA.
+2 IF '$DATA(FIEVD("STATUS"))
QUIT 1
+3 NEW JND,OK
+4 SET OK=0
+5 FOR JND=1:1:STATUSA(0)
if OK
QUIT
Begin DoDot:1
+6 IF STATUSA(JND)="*"
SET OK=1
QUIT
+7 IF STATUSA(JND)=FIEVD("STATUS")
SET OK=1
QUIT
End DoDot:1
+8 QUIT OK
+9 ;
