| [623] | 1 | PXRMRUL1 ; SLC/AGP,PKR - Patient list routines. ; 08/11/2006
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|---|
| 3 | ;
|
|---|
| 4 | DATECHK(DATE) ;
|
|---|
| 5 | I DATE=0 Q 1
|
|---|
| 6 | S DATE=$$STRREP^PXRMUTIL(DATE,"BDT","T")
|
|---|
| 7 | Q $$VDT^PXRMINTR(DATE)
|
|---|
| 8 | ;
|
|---|
| 9 | INSERT(FROUT,DFN,TNAME,TFIEV,RSTOP) ;Save patient data.
|
|---|
| 10 | I TFIEV(1)=0 Q
|
|---|
| 11 | N DATA,DONE,IND,LEN,REF,ROOT,START,SUB,TEMP
|
|---|
| 12 | S REF="TFIEV(1,""CSUB"")"
|
|---|
| 13 | S PROOT=$P(REF,")",1)
|
|---|
| 14 | ;Build the root so we can tell when we are done.
|
|---|
| 15 | S TEMP=$NA(@REF)
|
|---|
| 16 | S ROOT=$P(TEMP,")",1)
|
|---|
| 17 | S REF=$Q(@REF)
|
|---|
| 18 | I REF'[ROOT Q
|
|---|
| 19 | S DONE=0
|
|---|
| 20 | F Q:(REF="")!(DONE) D
|
|---|
| 21 | . S START=$F(REF,ROOT)
|
|---|
| 22 | . S LEN=$L(REF)-1
|
|---|
| 23 | . S IND=$E(REF,START,LEN)
|
|---|
| 24 | . S DATA(TNAME_IND)=@REF
|
|---|
| 25 | . S REF=$Q(@REF)
|
|---|
| 26 | . I REF'[ROOT S DONE=1
|
|---|
| 27 | I $D(DATA) M ^TMP($J,FROUT,DFN,"DATA")=DATA
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | INST(DFN) ;Get the PCMM Institution.
|
|---|
| 31 | N DATE,INST
|
|---|
| 32 | ;Check PCMM
|
|---|
| 33 | S DATE=$S($G(PXRMDATE)'="":$P(PXRMDATE,"."),1:DT)
|
|---|
| 34 | ;DBIA #1916
|
|---|
| 35 | S INST=$P($$INSTPCTM^SCAPMC(DFN,DATE),U,3,4)
|
|---|
| 36 | Q INST
|
|---|
| 37 | ;
|
|---|
| 38 | LOGOP(LIST1,LIST2,LOGOP) ;Given LIST1 and LIST2 apply the logical
|
|---|
| 39 | ;operator LOGOP to generate a new list and return it in LIST1
|
|---|
| 40 | N DFN1,DFN2
|
|---|
| 41 | I LOGOP="&" D Q
|
|---|
| 42 | . S DFN1=""
|
|---|
| 43 | . F S DFN1=$O(^TMP($J,LIST1,DFN1)) Q:DFN1="" D
|
|---|
| 44 | .. I $D(^TMP($J,LIST2,DFN1)) M ^TMP($J,LIST1,DFN1)=^TMP($J,LIST2,DFN1) Q
|
|---|
| 45 | .. K ^TMP($J,LIST1,DFN1)
|
|---|
| 46 | ;
|
|---|
| 47 | ;"~" represents "&'".
|
|---|
| 48 | I LOGOP="~" D Q
|
|---|
| 49 | . S DFN1=""
|
|---|
| 50 | . F S DFN1=$O(^TMP($J,LIST1,DFN1)) Q:DFN1="" D
|
|---|
| 51 | .. I $D(^TMP($J,LIST2,DFN1)) K ^TMP($J,LIST1,DFN1)
|
|---|
| 52 | ;
|
|---|
| 53 | I LOGOP="!" D
|
|---|
| 54 | . S DFN2=""
|
|---|
| 55 | . F S DFN2=$O(^TMP($J,LIST2,DFN2)) Q:DFN2="" D
|
|---|
| 56 | .. M ^TMP($J,LIST1,DFN2)=^TMP($J,LIST2,DFN2)
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | REM(FRACT,RIEN,RSTART,RSTOP,PNODE) ;Process reminder finding rule
|
|---|
| 60 | D BLDPLST^PXRMPLST(RIEN,PNODE,1,RSTOP)
|
|---|
| 61 | ;Remove, Select or Add Findings operations
|
|---|
| 62 | I FRACT="A" D LOGOP(FROUT,PNODE,"!") Q
|
|---|
| 63 | I FRACT="D" D LOGOP(FROUT,PNODE,"~") Q
|
|---|
| 64 | I FRACT="S" D LOGOP(FROUT,PNODE,"&") Q
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | TERM(FRACT,FRTIEN,RSTART,RSTOP,PNODE,INST) ;Process TERM finding rule
|
|---|
| 68 | N FINDPA,FINDING,FNAME,PLIST,PXRMDATE,PXRMDEBG,TERMARR,TFIEV,TNAME
|
|---|
| 69 | ;Get term definition array
|
|---|
| 70 | D TERM^PXRMLDR(FRTIEN,.TERMARR)
|
|---|
| 71 | S TNAME=$P(TERMARR(0),U,1)
|
|---|
| 72 | S INST=$S(FRACT'="F":0,TNAME="VA-PCMM INSTITUTION":1,TNAME="VA-IHD STATION CODE":1,1:0)
|
|---|
| 73 | ;Set start and end dates
|
|---|
| 74 | S $P(FINDPA(0),U,8)=RSTART,$P(FINDPA(0),U,11)=RSTOP,PXRMDATE=RSTOP
|
|---|
| 75 | ;
|
|---|
| 76 | ;Add operation
|
|---|
| 77 | I FRACT="A" D Q
|
|---|
| 78 | .;Process term for date range
|
|---|
| 79 | .D EVALPL^PXRMTERM(.FINDPA,.TERMARR,PNODE)
|
|---|
| 80 | .;Merge lists if operation is add
|
|---|
| 81 | .M ^TMP($J,FROUT)=^TMP($J,PNODE,1)
|
|---|
| 82 | ;Remove, Select or Insert Findings operations
|
|---|
| 83 | I FRACT="F" S PXRMDEBG=1
|
|---|
| 84 | S DFN=0
|
|---|
| 85 | F S DFN=$O(^TMP($J,FROUT,DFN)) Q:'DFN D
|
|---|
| 86 | .I INST S ^TMP($J,FROUT,DFN,"INST")=$$INST(DFN) Q
|
|---|
| 87 | .;Evaluate term
|
|---|
| 88 | .K TFIEV D IEVALTER^PXRMTERM(DFN,.FINDPA,.TERMARR,1,.TFIEV)
|
|---|
| 89 | .;Delete any ^TMP patient in PLIST if action is remove
|
|---|
| 90 | .I FRACT="R",TFIEV(1) K ^TMP($J,FROUT,DFN) Q
|
|---|
| 91 | .;Delete any ^TMP patient not in PLIST if action is select
|
|---|
| 92 | .I FRACT="S",'TFIEV(1) K ^TMP($J,FROUT,DFN) Q
|
|---|
| 93 | .I FRACT="F",TFIEV(1) D
|
|---|
| 94 | .. S FINDING=TFIEV(1,"FINDING")
|
|---|
| 95 | .. I '$D(FNAME(FINDING)) S FNAME(FINDING)=$$GETFNAME^PXRMDATA(FINDING)
|
|---|
| 96 | .. S TFIEV(1,"CSUB","FINDING NAME")=FNAME(FINDING)
|
|---|
| 97 | .. D INSERT(FROUT,DFN,TNAME,.TFIEV,RSTOP)
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
