Index: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF.m
===================================================================
--- WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF.m	(revision 613)
+++ WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF.m	(revision 623)
@@ -1,127 +1,127 @@
-PXRMFF	;SLC/PKR - Clinical Reminders function finding evaluation. ;3/29/2007
-	;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
-	;===========================================
-EVAL(DFN,DEFARR,FIEVAL)	;Evaluate function findings.
-	N FFIND,FFN,FILIST,FN,FUN,FUNIND,FUNN,FVALUE,JND
-	N LOGIC,NL,ROUTINE,TEMP
-	I '$D(DEFARR(25)) Q
-	S FFN="FF"
-	F  S FFN=$O(DEFARR(25,FFN)) Q:FFN'["FF"  D
-	. K FN
-	. S FUNIND=0
-	. F  S FUNIND=+$O(DEFARR(25,FFN,5,FUNIND)) Q:FUNIND=0  D
-	.. S FUNN=$P(DEFARR(25,FFN,5,FUNIND,0),U,1)
-	.. S FUN=$P(DEFARR(25,FFN,5,FUNIND,0),U,2)
-	.. S TEMP=^PXRMD(802.4,FUN,0)
-	.. S ROUTINE=$P(TEMP,U,2,3)_"(.FILIST,.FIEVAL,.FVALUE)"
-	.. K FILIST
-	.. S (JND,NL)=0
-	.. F  S JND=+$O(DEFARR(25,FFN,5,FUNIND,20,JND)) Q:JND=0  D
-	... S NL=NL+1
-	... S FILIST(NL)=DEFARR(25,FFN,5,FUNIND,20,JND,0)
-	.. S FILIST(0)=NL
-	.. D @ROUTINE
-	.. S FN(FUNIND)=FVALUE
-	. S LOGIC=$G(DEFARR(25,FFN,10))
-	. S LOGIC=$S(LOGIC'="":LOGIC,1:0)
-	. I @LOGIC
-	. S FIEVAL(FFN)=$T
-	. S FIEVAL(FFN,"NUMBER")=$P(FFN,"FF",2)
-	. S FIEVAL(FFN,"FINDING")=$G(FUN)_";PXRMD(802.4,"
-	Q
-	;
-	;===========================================
-EVALPL(DEFARR,FFIND,PLIST)	;Build a list of patients based on a function
-	;finding.
-	N COUNT,DAS,DATE,DFN
-	N FI,FIEVAL,FIEVT,FIL,FILIST,FILENUM,FINDPA,FN
-	N FUN,FUNNM,FUNN,FUNNUM,FVALUE
-	N IND,ITEM,JND,LOGIC,LNAME,NFI,NFUN,ROUTINE,TEMP,TERMARR,UNIQFIL
-	S LOGIC=DEFARR(25,FFIND,10)
-	I LOGIC="" Q
-	;Build the list of functions and findings used by the function finding.
-	S (FUNNUM,NFUN)=0
-	F  S FUNNUM=+$O(DEFARR(25,FFIND,5,FUNNUM)) Q:FUNNUM=0  D
-	. S NFUN=NFUN+1
-	. S FUNN=$P(DEFARR(25,FFIND,5,FUNNUM,0),U,1)
-	. S FUN=$P(DEFARR(25,FFIND,5,FUNNUM,0),U,2)
-	. S TEMP=^PXRMD(802.4,FUN,0)
-	. S ROUTINE(NFUN)=$P(TEMP,U,2,3)_"(.FIL,.FIEVAL,.FVALUE)"
-	. S (FI,NFI)=0
-	. F  S FI=+$O(DEFARR(25,FFIND,5,FUNNUM,20,FI)) Q:FI=0  D
-	.. S NFI=NFI+1,FILIST(NFUN,NFI)=DEFARR(25,FFIND,5,FUNNUM,20,FI,0)
-	. S FILIST(NFUN,0)=NFI
-	;A finding may be used in more than one function in the function
-	;finding so build a list of the unique findings.
-	F IND=1:1:NFUN D
-	. F JND=1:1:FILIST(IND,0) D
-	.. S TEMP=$P(DEFARR(20,FILIST(IND,JND),0),U,1)
-	.. S ITEM=$P(TEMP,";",1)
-	.. S FILENUM=$$GETFNUM^PXRMDATA($P(TEMP,";",2))
-	.. S UNIQFIL(FILIST(IND,JND))=""
-	K ^TMP($J,"PXRMFFDFN")
-	S IND=0
-	F  S IND=$O(UNIQFIL(IND)) Q:IND=""  D
-	. S FINDPA(0)=DEFARR(20,IND,0)
-	. S FINDPA(3)=DEFARR(20,IND,3)
-	. S FINDPA(10)=DEFARR(20,IND,10)
-	. S FINDPA(11)=DEFARR(20,IND,11)
-	. D GENTERM^PXRMPLST(FINDPA(0),IND,.TERMARR)
-	. S LNAME(IND)="PXRMFF"_IND
-	. K ^TMP($J,LNAME(IND))
-	. D EVALPL^PXRMTERL(.FINDPA,.TERMARR,LNAME(IND))
-	.;Get rid of the false part of the list.
-	. K ^TMP($J,LNAME(IND),0)
-	.;Build a complete list of patients.
-	. S DFN=0
-	. F  S DFN=$O(^TMP($J,LNAME(IND),1,DFN)) Q:DFN=""  S ^TMP($J,"PXRMFFDFN",DFN)=""
-	;Evaluate the function finding for each patient. If the function
-	;finding is true then add the patient to PLIST.
-	S DFN=0
-	F  S DFN=$O(^TMP($J,"PXRMFFDFN",DFN)) Q:DFN=""  D
-	. K FIEVAL
-	. S IND=""
-	. F  S IND=$O(UNIQFIL(IND)) Q:IND=""  D
-	.. S FIEVAL(IND)=0
-	.. S ITEM=""
-	.. F  S ITEM=$O(^TMP($J,LNAME(IND),1,DFN,ITEM)) Q:ITEM=""  D
-	... S COUNT=0
-	... F  S COUNT=$O(^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT)) Q:COUNT=""  D
-	.... S FILENUM=$O(^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT,""))
-	.... S TEMP=^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT,FILENUM)
-	.... S DAS=$P(TEMP,U,1)
-	.... S DATE=$P(TEMP,U,2)
-	.... K FIEVT
-	.... D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT)
-	.... M FIEVAL(IND,COUNT)=FIEVT
-	.... S FIEVAL(IND,COUNT,"DATE")=DATE,FIEVAL(IND,COUNT)=1
-	.;Save the top level results for each finding.
-	. S IND=0
-	. F  S IND=$O(FIEVAL(IND)) Q:IND=""  D
-	.. K FIEVT M FIEVT=FIEVAL(IND)
-	.. S NFI=+$O(FIEVT(""),-1)
-	.. D SFRES^PXRMUTIL(-1,NFI,.FIEVT)
-	.. K FIEVAL(IND) M FIEVAL(IND)=FIEVT
-	.;Evaluate the function finding for this patient.
-	. K FN
-	. F IND=1:1:NFUN D
-	.. K FIL M FIL=FILIST(IND)
-	.. D @ROUTINE(IND)
-	.. S FN(IND)=FVALUE
-	. I @LOGIC S ^TMP($J,PLIST,1,DFN,1,FFIND)=""
-	;Clean up.
-	K ^TMP($J,"PXRMFFDFN")
-	S IND=""
-	F  S IND=$O(UNIQFIL(IND)) Q:IND=""  K ^TMP($J,LNAME(IND))
-	Q
-	;
-	;===========================================
-MHVOUT(INDENT,IFIEVAL,NLINES,TEXT)	;Produce the MHV output.
-	;None currently defined.
-	Q
-	;
-	;===========================================
-OUTPUT(INDENT,IFIEVAL,NLINES,TEXT)	;Produce the clinical
-	;maintenance output. None currently defined.
-	Q
-	;
+PXRMFF ;SLC/PKR - Clinical Reminders function finding evaluation. ;07/17/2006
+ ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+ ;===========================================
+EVAL(DFN,DEFARR,FIEVAL) ;Evaluate function findings.
+ N FFIND,FFN,FILIST,FN,FUN,FUNIND,FUNN,FVALUE,JND
+ N LOGIC,NL,ROUTINE,TEMP
+ I '$D(DEFARR(25)) Q
+ S FFN="FF"
+ F  S FFN=$O(DEFARR(25,FFN)) Q:FFN'["FF"  D
+ . K FN
+ . S FUNIND=0
+ . F  S FUNIND=+$O(DEFARR(25,FFN,5,FUNIND)) Q:FUNIND=0  D
+ .. S FUNN=$P(DEFARR(25,FFN,5,FUNIND,0),U,1)
+ .. S FUN=$P(DEFARR(25,FFN,5,FUNIND,0),U,2)
+ .. S TEMP=^PXRMD(802.4,FUN,0)
+ .. S ROUTINE=$P(TEMP,U,2,3)_"(.FILIST,.FIEVAL,.FVALUE)"
+ .. K FILIST
+ .. S (JND,NL)=0
+ .. F  S JND=+$O(DEFARR(25,FFN,5,FUNIND,20,JND)) Q:JND=0  D
+ ... S NL=NL+1
+ ... S FILIST(NL)=DEFARR(25,FFN,5,FUNIND,20,JND,0)
+ .. S FILIST(0)=NL
+ .. D @ROUTINE
+ .. S FN(FUNIND)=FVALUE
+ . S LOGIC=$G(DEFARR(25,FFN,10))
+ . S LOGIC=$S(LOGIC'="":LOGIC,1:0)
+ . I @LOGIC
+ . S FIEVAL(FFN)=$T
+ . S FIEVAL(FFN,"NUMBER")=$P(FFN,"FF",2)
+ . S FIEVAL(FFN,"FINDING")=$G(FUN)_";PXRMD(802.4,"
+ Q
+ ;
+ ;===========================================
+EVALPL(DEFARR,FFIND,PLIST) ;Build a list of patients based on a function
+ ;finding.
+ N COUNT,DAS,DATE,DFN
+ N FI,FIEVAL,FIEVT,FIL,FILIST,FILENUM,FINDPA,FN
+ N FUN,FUNNM,FUNN,FUNNUM,FVALUE
+ N IND,ITEM,JND,LOGIC,LNAME,NFI,NFUN,ROUTINE,TEMP,TERMARR,UNIQFIL
+ S LOGIC=DEFARR(25,FFIND,10)
+ I LOGIC="" Q
+ ;Build the list of functions and findings used by the function finding.
+ S (FUNNUM,NFUN)=0
+ F  S FUNNUM=+$O(DEFARR(25,FFIND,5,FUNNUM)) Q:FUNNUM=0  D
+ . S NFUN=NFUN+1
+ . S FUNN=$P(DEFARR(25,FFIND,5,FUNNUM,0),U,1)
+ . S FUN=$P(DEFARR(25,FFIND,5,FUNNUM,0),U,2)
+ . S TEMP=^PXRMD(802.4,FUN,0)
+ . S ROUTINE(NFUN)=$P(TEMP,U,2,3)_"(.FIL,.FIEVAL,.FVALUE)"
+ . S (FI,NFI)=0
+ . F  S FI=+$O(DEFARR(25,FFIND,5,FUNNUM,20,FI)) Q:FI=0  D
+ .. S NFI=NFI+1,FILIST(NFUN,NFI)=DEFARR(25,FFIND,5,FUNNUM,20,FI,0)
+ . S FILIST(NFUN,0)=NFI
+ ;A finding may be used in more than one function in the function
+ ;finding so build a list of the unique findings.
+ F IND=1:1:NFUN D
+ . F JND=1:1:FILIST(IND,0) D
+ .. S TEMP=$P(DEFARR(20,FILIST(IND,JND),0),U,1)
+ .. S ITEM=$P(TEMP,";",1)
+ .. S FILENUM=$$GETFNUM^PXRMDATA($P(TEMP,";",2))
+ .. S UNIQFIL(FILIST(IND,JND))=""
+ K ^TMP($J,"PXRMFFDFN")
+ S IND=0
+ F  S IND=$O(UNIQFIL(IND)) Q:IND=""  D
+ . S FINDPA(0)=DEFARR(20,IND,0)
+ . S FINDPA(3)=DEFARR(20,IND,3)
+ . S FINDPA(10)=DEFARR(20,IND,10)
+ . S FINDPA(11)=DEFARR(20,IND,11)
+ . D GENTERM^PXRMPLST(FINDPA(0),IND,.TERMARR)
+ . S LNAME(IND)="PXRMFF"_IND
+ . K ^TMP($J,LNAME(IND))
+ . D EVALPL^PXRMTERM(.FINDPA,.TERMARR,LNAME(IND))
+ .;Get rid of the false part of the list.
+ . K ^TMP($J,LNAME(IND),0)
+ .;Build a complete list of patients.
+ . S DFN=0
+ . F  S DFN=$O(^TMP($J,LNAME(IND),1,DFN)) Q:DFN=""  S ^TMP($J,"PXRMFFDFN",DFN)=""
+ ;Evaluate the function finding for each patient. If the function
+ ;finding is true then add the patient to PLIST.
+ S DFN=0
+ F  S DFN=$O(^TMP($J,"PXRMFFDFN",DFN)) Q:DFN=""  D
+ . K FIEVAL
+ . S IND=""
+ . F  S IND=$O(UNIQFIL(IND)) Q:IND=""  D
+ .. S FIEVAL(IND)=0
+ .. S ITEM=""
+ .. F  S ITEM=$O(^TMP($J,LNAME(IND),1,DFN,ITEM)) Q:ITEM=""  D
+ ... S COUNT=0
+ ... F  S COUNT=$O(^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT)) Q:COUNT=""  D
+ .... S FILENUM=$O(^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT,""))
+ .... S TEMP=^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT,FILENUM)
+ .... S DAS=$P(TEMP,U,1)
+ .... S DATE=$P(TEMP,U,2)
+ .... K FIEVT
+ .... D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT)
+ .... M FIEVAL(IND,COUNT)=FIEVT
+ .... S FIEVAL(IND,COUNT,"DATE")=DATE,FIEVAL(IND,COUNT)=1
+ .;Save the top level results for each finding.
+ . S IND=0
+ . F  S IND=$O(FIEVAL(IND)) Q:IND=""  D
+ .. K FIEVT M FIEVT=FIEVAL(IND)
+ .. S NFI=+$O(FIEVT(""),-1)
+ .. D SFRES^PXRMUTIL(-1,NFI,.FIEVT)
+ .. K FIEVAL(IND) M FIEVAL(IND)=FIEVT
+ .;Evaluate the function finding for this patient.
+ . K FN
+ . F IND=1:1:NFUN D
+ .. K FIL M FIL=FILIST(IND)
+ .. D @ROUTINE(IND)
+ .. S FN(IND)=FVALUE
+ . I @LOGIC S ^TMP($J,PLIST,1,DFN,1,FFIND)=""
+ ;Clean up.
+ K ^TMP($J,"PXRMFFDFN")
+ S IND=""
+ F  S IND=$O(UNIQFIL(IND)) Q:IND=""  K ^TMP($J,LNAME(IND))
+ Q
+ ;
+ ;===========================================
+MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+ ;None currently defined.
+ Q
+ ;
+ ;===========================================
+OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+ ;maintenance output. None currently defined.
+ Q
+ ;
