PXRMRUL1 ; SLC/AGP,PKR - Patient list routines. ; 08/11/2006
 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 ; 
DATECHK(DATE) ;
 I DATE=0 Q 1
 S DATE=$$STRREP^PXRMUTIL(DATE,"BDT","T")
 Q $$VDT^PXRMINTR(DATE)
 ;
INSERT(FROUT,DFN,TNAME,TFIEV,RSTOP) ;Save patient data.
 I TFIEV(1)=0 Q
 N DATA,DONE,IND,LEN,REF,ROOT,START,SUB,TEMP
 S REF="TFIEV(1,""CSUB"")"
 S PROOT=$P(REF,")",1)
 ;Build the root so we can tell when we are done.
 S TEMP=$NA(@REF)
 S ROOT=$P(TEMP,")",1)
 S REF=$Q(@REF)
 I REF'[ROOT Q
 S DONE=0
 F  Q:(REF="")!(DONE)  D
 . S START=$F(REF,ROOT)
 . S LEN=$L(REF)-1
 . S IND=$E(REF,START,LEN)
 . S DATA(TNAME_IND)=@REF
 . S REF=$Q(@REF)
 . I REF'[ROOT S DONE=1
 I $D(DATA) M ^TMP($J,FROUT,DFN,"DATA")=DATA
 Q
 ;
INST(DFN) ;Get the PCMM Institution.
 N DATE,INST
 ;Check PCMM
 S DATE=$S($G(PXRMDATE)'="":$P(PXRMDATE,"."),1:DT)
 ;DBIA #1916
 S INST=$P($$INSTPCTM^SCAPMC(DFN,DATE),U,3,4)
 Q INST
 ;
LOGOP(LIST1,LIST2,LOGOP) ;Given LIST1 and LIST2 apply the logical
 ;operator LOGOP to generate a new list and return it in LIST1
 N DFN1,DFN2
 I LOGOP="&" D  Q
 . S DFN1=""
 . F  S DFN1=$O(^TMP($J,LIST1,DFN1)) Q:DFN1=""  D
 .. I $D(^TMP($J,LIST2,DFN1)) M ^TMP($J,LIST1,DFN1)=^TMP($J,LIST2,DFN1) Q
 .. K ^TMP($J,LIST1,DFN1)
 ;
 ;"~" represents "&'".
 I LOGOP="~" D  Q
 . S DFN1=""
 . F  S DFN1=$O(^TMP($J,LIST1,DFN1)) Q:DFN1=""  D
 .. I $D(^TMP($J,LIST2,DFN1)) K ^TMP($J,LIST1,DFN1)
 ;
 I LOGOP="!" D
 . S DFN2=""
 . F  S DFN2=$O(^TMP($J,LIST2,DFN2)) Q:DFN2=""  D
 .. M ^TMP($J,LIST1,DFN2)=^TMP($J,LIST2,DFN2)
 Q
 ;
REM(FRACT,RIEN,RSTART,RSTOP,PNODE) ;Process reminder finding rule
 D BLDPLST^PXRMPLST(RIEN,PNODE,1,RSTOP)
 ;Remove, Select or Add Findings operations
 I FRACT="A" D LOGOP(FROUT,PNODE,"!") Q
 I FRACT="D" D LOGOP(FROUT,PNODE,"~") Q
 I FRACT="S" D LOGOP(FROUT,PNODE,"&") Q
 Q
 ;
TERM(FRACT,FRTIEN,RSTART,RSTOP,PNODE,INST) ;Process TERM finding rule
 N FINDPA,FINDING,FNAME,PLIST,PXRMDATE,PXRMDEBG,TERMARR,TFIEV,TNAME
 ;Get term definition array
 D TERM^PXRMLDR(FRTIEN,.TERMARR)
 S TNAME=$P(TERMARR(0),U,1)
 S INST=$S(FRACT'="F":0,TNAME="VA-PCMM INSTITUTION":1,TNAME="VA-IHD STATION CODE":1,1:0)
 ;Set start and end dates
 S $P(FINDPA(0),U,8)=RSTART,$P(FINDPA(0),U,11)=RSTOP,PXRMDATE=RSTOP
 ;
 ;Add operation
 I FRACT="A" D  Q
 .;Process term for date range
 .D EVALPL^PXRMTERM(.FINDPA,.TERMARR,PNODE)
 .;Merge lists if operation is add
 .M ^TMP($J,FROUT)=^TMP($J,PNODE,1)
 ;Remove, Select or Insert Findings operations
 I FRACT="F" S PXRMDEBG=1
 S DFN=0
 F  S DFN=$O(^TMP($J,FROUT,DFN)) Q:'DFN  D
 .I INST S ^TMP($J,FROUT,DFN,"INST")=$$INST(DFN) Q
 .;Evaluate term
 .K TFIEV D IEVALTER^PXRMTERM(DFN,.FINDPA,.TERMARR,1,.TFIEV)
 .;Delete any ^TMP patient in PLIST if action is remove
 .I FRACT="R",TFIEV(1) K ^TMP($J,FROUT,DFN) Q
 .;Delete any ^TMP patient not in PLIST if action is select
 .I FRACT="S",'TFIEV(1) K ^TMP($J,FROUT,DFN) Q
 .I FRACT="F",TFIEV(1) D
 .. S FINDING=TFIEV(1,"FINDING")
 .. I '$D(FNAME(FINDING)) S FNAME(FINDING)=$$GETFNAME^PXRMDATA(FINDING)
 .. S TFIEV(1,"CSUB","FINDING NAME")=FNAME(FINDING)
 .. D INSERT(FROUT,DFN,TNAME,.TFIEV,RSTOP)
 Q
 ;