Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF.m
r613 r623 1 PXRMFF ;SLC/PKR - Clinical Reminders function finding evaluation. ;3/29/20072 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 4 EVAL(DFN,DEFARR,FIEVAL) 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 EVALPL(DEFARR,FFIND,PLIST) 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 . D EVALPL^PXRMTERL(.FINDPA,.TERMARR,LNAME(IND))73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) 120 121 122 123 124 OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) 125 126 127 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
