| 1 | PXRMFF ;SLC/PKR - Clinical Reminders function finding evaluation. ;07/17/2006
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|---|
| 3 | ;===========================================
|
|---|
| 4 | EVAL(DFN,DEFARR,FIEVAL) ;Evaluate function findings.
|
|---|
| 5 | N FFIND,FFN,FILIST,FN,FUN,FUNIND,FUNN,FVALUE,JND
|
|---|
| 6 | N LOGIC,NL,ROUTINE,TEMP
|
|---|
| 7 | I '$D(DEFARR(25)) Q
|
|---|
| 8 | S FFN="FF"
|
|---|
| 9 | F S FFN=$O(DEFARR(25,FFN)) Q:FFN'["FF" D
|
|---|
| 10 | . K FN
|
|---|
| 11 | . S FUNIND=0
|
|---|
| 12 | . F S FUNIND=+$O(DEFARR(25,FFN,5,FUNIND)) Q:FUNIND=0 D
|
|---|
| 13 | .. S FUNN=$P(DEFARR(25,FFN,5,FUNIND,0),U,1)
|
|---|
| 14 | .. S FUN=$P(DEFARR(25,FFN,5,FUNIND,0),U,2)
|
|---|
| 15 | .. S TEMP=^PXRMD(802.4,FUN,0)
|
|---|
| 16 | .. S ROUTINE=$P(TEMP,U,2,3)_"(.FILIST,.FIEVAL,.FVALUE)"
|
|---|
| 17 | .. K FILIST
|
|---|
| 18 | .. S (JND,NL)=0
|
|---|
| 19 | .. F S JND=+$O(DEFARR(25,FFN,5,FUNIND,20,JND)) Q:JND=0 D
|
|---|
| 20 | ... S NL=NL+1
|
|---|
| 21 | ... S FILIST(NL)=DEFARR(25,FFN,5,FUNIND,20,JND,0)
|
|---|
| 22 | .. S FILIST(0)=NL
|
|---|
| 23 | .. D @ROUTINE
|
|---|
| 24 | .. S FN(FUNIND)=FVALUE
|
|---|
| 25 | . S LOGIC=$G(DEFARR(25,FFN,10))
|
|---|
| 26 | . S LOGIC=$S(LOGIC'="":LOGIC,1:0)
|
|---|
| 27 | . I @LOGIC
|
|---|
| 28 | . S FIEVAL(FFN)=$T
|
|---|
| 29 | . S FIEVAL(FFN,"NUMBER")=$P(FFN,"FF",2)
|
|---|
| 30 | . S FIEVAL(FFN,"FINDING")=$G(FUN)_";PXRMD(802.4,"
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | ;===========================================
|
|---|
| 34 | EVALPL(DEFARR,FFIND,PLIST) ;Build a list of patients based on a function
|
|---|
| 35 | ;finding.
|
|---|
| 36 | N COUNT,DAS,DATE,DFN
|
|---|
| 37 | N FI,FIEVAL,FIEVT,FIL,FILIST,FILENUM,FINDPA,FN
|
|---|
| 38 | N FUN,FUNNM,FUNN,FUNNUM,FVALUE
|
|---|
| 39 | N IND,ITEM,JND,LOGIC,LNAME,NFI,NFUN,ROUTINE,TEMP,TERMARR,UNIQFIL
|
|---|
| 40 | S LOGIC=DEFARR(25,FFIND,10)
|
|---|
| 41 | I LOGIC="" Q
|
|---|
| 42 | ;Build the list of functions and findings used by the function finding.
|
|---|
| 43 | S (FUNNUM,NFUN)=0
|
|---|
| 44 | F S FUNNUM=+$O(DEFARR(25,FFIND,5,FUNNUM)) Q:FUNNUM=0 D
|
|---|
| 45 | . S NFUN=NFUN+1
|
|---|
| 46 | . S FUNN=$P(DEFARR(25,FFIND,5,FUNNUM,0),U,1)
|
|---|
| 47 | . S FUN=$P(DEFARR(25,FFIND,5,FUNNUM,0),U,2)
|
|---|
| 48 | . S TEMP=^PXRMD(802.4,FUN,0)
|
|---|
| 49 | . S ROUTINE(NFUN)=$P(TEMP,U,2,3)_"(.FIL,.FIEVAL,.FVALUE)"
|
|---|
| 50 | . S (FI,NFI)=0
|
|---|
| 51 | . F S FI=+$O(DEFARR(25,FFIND,5,FUNNUM,20,FI)) Q:FI=0 D
|
|---|
| 52 | .. S NFI=NFI+1,FILIST(NFUN,NFI)=DEFARR(25,FFIND,5,FUNNUM,20,FI,0)
|
|---|
| 53 | . S FILIST(NFUN,0)=NFI
|
|---|
| 54 | ;A finding may be used in more than one function in the function
|
|---|
| 55 | ;finding so build a list of the unique findings.
|
|---|
| 56 | F IND=1:1:NFUN D
|
|---|
| 57 | . F JND=1:1:FILIST(IND,0) D
|
|---|
| 58 | .. S TEMP=$P(DEFARR(20,FILIST(IND,JND),0),U,1)
|
|---|
| 59 | .. S ITEM=$P(TEMP,";",1)
|
|---|
| 60 | .. S FILENUM=$$GETFNUM^PXRMDATA($P(TEMP,";",2))
|
|---|
| 61 | .. S UNIQFIL(FILIST(IND,JND))=""
|
|---|
| 62 | K ^TMP($J,"PXRMFFDFN")
|
|---|
| 63 | S IND=0
|
|---|
| 64 | F S IND=$O(UNIQFIL(IND)) Q:IND="" D
|
|---|
| 65 | . S FINDPA(0)=DEFARR(20,IND,0)
|
|---|
| 66 | . S FINDPA(3)=DEFARR(20,IND,3)
|
|---|
| 67 | . S FINDPA(10)=DEFARR(20,IND,10)
|
|---|
| 68 | . S FINDPA(11)=DEFARR(20,IND,11)
|
|---|
| 69 | . D GENTERM^PXRMPLST(FINDPA(0),IND,.TERMARR)
|
|---|
| 70 | . S LNAME(IND)="PXRMFF"_IND
|
|---|
| 71 | . K ^TMP($J,LNAME(IND))
|
|---|
| 72 | . D EVALPL^PXRMTERM(.FINDPA,.TERMARR,LNAME(IND))
|
|---|
| 73 | .;Get rid of the false part of the list.
|
|---|
| 74 | . K ^TMP($J,LNAME(IND),0)
|
|---|
| 75 | .;Build a complete list of patients.
|
|---|
| 76 | . S DFN=0
|
|---|
| 77 | . F S DFN=$O(^TMP($J,LNAME(IND),1,DFN)) Q:DFN="" S ^TMP($J,"PXRMFFDFN",DFN)=""
|
|---|
| 78 | ;Evaluate the function finding for each patient. If the function
|
|---|
| 79 | ;finding is true then add the patient to PLIST.
|
|---|
| 80 | S DFN=0
|
|---|
| 81 | F S DFN=$O(^TMP($J,"PXRMFFDFN",DFN)) Q:DFN="" D
|
|---|
| 82 | . K FIEVAL
|
|---|
| 83 | . S IND=""
|
|---|
| 84 | . F S IND=$O(UNIQFIL(IND)) Q:IND="" D
|
|---|
| 85 | .. S FIEVAL(IND)=0
|
|---|
| 86 | .. S ITEM=""
|
|---|
| 87 | .. F S ITEM=$O(^TMP($J,LNAME(IND),1,DFN,ITEM)) Q:ITEM="" D
|
|---|
| 88 | ... S COUNT=0
|
|---|
| 89 | ... F S COUNT=$O(^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT)) Q:COUNT="" D
|
|---|
| 90 | .... S FILENUM=$O(^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT,""))
|
|---|
| 91 | .... S TEMP=^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT,FILENUM)
|
|---|
| 92 | .... S DAS=$P(TEMP,U,1)
|
|---|
| 93 | .... S DATE=$P(TEMP,U,2)
|
|---|
| 94 | .... K FIEVT
|
|---|
| 95 | .... D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT)
|
|---|
| 96 | .... M FIEVAL(IND,COUNT)=FIEVT
|
|---|
| 97 | .... S FIEVAL(IND,COUNT,"DATE")=DATE,FIEVAL(IND,COUNT)=1
|
|---|
| 98 | .;Save the top level results for each finding.
|
|---|
| 99 | . S IND=0
|
|---|
| 100 | . F S IND=$O(FIEVAL(IND)) Q:IND="" D
|
|---|
| 101 | .. K FIEVT M FIEVT=FIEVAL(IND)
|
|---|
| 102 | .. S NFI=+$O(FIEVT(""),-1)
|
|---|
| 103 | .. D SFRES^PXRMUTIL(-1,NFI,.FIEVT)
|
|---|
| 104 | .. K FIEVAL(IND) M FIEVAL(IND)=FIEVT
|
|---|
| 105 | .;Evaluate the function finding for this patient.
|
|---|
| 106 | . K FN
|
|---|
| 107 | . F IND=1:1:NFUN D
|
|---|
| 108 | .. K FIL M FIL=FILIST(IND)
|
|---|
| 109 | .. D @ROUTINE(IND)
|
|---|
| 110 | .. S FN(IND)=FVALUE
|
|---|
| 111 | . I @LOGIC S ^TMP($J,PLIST,1,DFN,1,FFIND)=""
|
|---|
| 112 | ;Clean up.
|
|---|
| 113 | K ^TMP($J,"PXRMFFDFN")
|
|---|
| 114 | S IND=""
|
|---|
| 115 | F S IND=$O(UNIQFIL(IND)) Q:IND="" K ^TMP($J,LNAME(IND))
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | ;===========================================
|
|---|
| 119 | MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
|
|---|
| 120 | ;None currently defined.
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | ;===========================================
|
|---|
| 124 | OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
|
|---|
| 125 | ;maintenance output. None currently defined.
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
