Index: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTAX.m
===================================================================
--- WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTAX.m	(revision 613)
+++ WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTAX.m	(revision 623)
@@ -1,213 +1,213 @@
-PXRMTAX	; SLC/PKR - Handle taxonomy finding. ;10/11/2007
-	;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
-	;
-	;==================================================
-EVALFI(DFN,DEFARR,ENODE,FIEVAL)	;Evaluate taxonomy findings.
-	N FIEVT,FINDPA,FINDING
-	N TAXIEN
-	S TAXIEN=""
-	F  S TAXIEN=$O(DEFARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
-	. S FINDING=""
-	. F  S FINDING=$O(DEFARR("E",ENODE,TAXIEN,FINDING)) Q:+FINDING=0  D
-	.. K FINDPA
-	.. M FINDPA=DEFARR(20,FINDING)
-	.. K FIEVT
-	.. D FIEVAL(DFN,TAXIEN,.FINDPA,.FIEVT)
-	.. M FIEVAL(FINDING)=FIEVT
-	Q
-	;
-	;==================================================
-EVALPL(FINDPA,ENODE,TERMARR,PLIST)	;Evaluate taxonomy terms for
-	;building patient lists.
-	N PFIND3,PFIND4,PFINDPA,TAXIEN
-	N TFINDPA,TFINDING
-	S TAXIEN=""
-	F  S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
-	. S TFINDING=""
-	. F  S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0  D
-	.. K PFINDPA,TFINDPA
-	.. M TFINDPA=TERMARR(20,TFINDING)
-	..;Set the finding parameters.
-	.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
-	.. D GPLIST(TAXIEN,.PFINDPA,PLIST)
-	Q
-	;
-	;==================================================
-EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL)	;Evaluate taxonomy
-	;terms.
-	N FIEVT,PFINDPA
-	N TAXIEN,TFINDPA,TFINDING
-	S TAXIEN=""
-	F  S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
-	. S TFINDING=""
-	. F  S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0  D
-	.. K FIEVT,PFINDPA,TFINDPA
-	.. M TFINDPA=TERMARR(20,TFINDING)
-	..;Set the finding parameters.
-	.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
-	.. D FIEVAL(DFN,TAXIEN,.PFINDPA,.FIEVT)
-	.. M TFIEVAL(TFINDING)=FIEVT
-	Q
-	;
-	;==================================================
-FIEVAL(DFN,TAXIEN,FINDPA,FIEVAL)	;
-	N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,ENS,FIEVT,FILENUM,FLIST
-	N ICOND,IND,INS,INVFD
-	N NFOUND,NGET,NICD0,NICD9,NCPT,NOCC,NP,NRCPT,PLS
-	N RAS,SAVE,SDIR,STATUSA,TAXARR,TLIST,UCIFS,USEINP,VSLIST
-	;Set the finding search parameters.
-	D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT)
-	S INVFD=$P(FINDPA(0),U,16)
-	D TAX^PXRMLDR(TAXIEN,.TAXARR)
-	I TAXARR(0)["NO LOCK" S FIEVAL(1)=0 Q
-	D SETVAR^PXRMTAXS(.TAXARR,.ENS,.INS,.NICD0,.NICD9,.NCPT,.NRCPT,.PLS,.RAS)
-	D SCPAR^PXRMCOND(.FINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
-	S SDIR=$S(NOCC<0:+1,1:-1)
-	S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
-	S NGET=$S(UCIFS:50,1:NOCC)
-	;
-	I (NICD0>0),INS D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,"ICD0",.TLIST)
-	;
-	I (NICD9>0),INS D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,"ICD9",.TLIST)
-	I (NICD9>0),ENS D FPDAT^PXRMVPOV(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
-	I (NICD9>0),PLS D
-	. K STATUSA
-	. D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA)
-	. D FPDAT^PXRMPROB(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.STATUSA,.TLIST)
-	;
-	I (NCPT>0),(ENS) D FPDAT^PXRMVCPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
-	;
-	I (NRCPT>0),(RAS) D
-	. K STATUSA
-	. D GETSTATI^PXRMSTAT(70,.FINDPA,.STATUSA)
-	. D FPDAT^PXRMRCPT(DFN,.TAXARR,NOCC,BDT,EDT,.STATUSA,.TLIST)
-	;
-	;Process the found list, returning the NOCC most recent results.
-	S NFOUND=0
-	S DATE=""
-	F  S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NOCC)  D
-	. S IND=0
-	. F  S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NOCC)  D
-	.. S FILENUM=0
-	.. F  S FILENUM=$O(TLIST(DATE,IND,FILENUM)) Q:FILENUM=""  D
-	... S NFOUND=NFOUND+1
-	... S DAS=$P(TLIST(DATE,IND,FILENUM),U,1)
-	... S FLIST(NFOUND)=TLIST(DATE,IND,FILENUM)
-	... S FLIST(NFOUND)=DAS_U_DATE_U_FILENUM_U_$P(TLIST(DATE,IND,FILENUM),U,2,10)
-	I NFOUND=0 S FIEVAL=0 Q
-	S NP=0
-	F IND=1:1:NFOUND Q:NP=NOCC  D
-	. S DAS=$P(FLIST(IND),U,1)
-	. S FILENUM=$P(FLIST(IND),U,3)
-	. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT)
-	. I $D(FIEVT("VISIT")) D GETDATA^PXRMVSIT(FIEVT("VISIT"),.FIEVT,0)
-	. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVT),1:1)
-	. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
-	. I SAVE D
-	.. S NP=NP+1
-	.. S FIEVAL(NP)=CONVAL
-	.. S FIEVAL(NP,"CONDITION")=CONVAL
-	.. S FIEVAL(NP,"CODEP")=$P(FLIST(IND),U,4)
-	.. S FIEVAL(NP,"DAS")=DAS
-	.. S FIEVAL(NP,"DATE")=$P(FLIST(IND),U,2)
-	.. S FIEVAL(NP,"FILE NUMBER")=FILENUM
-	.. S FIEVAL(NP,"FILE SPECIFIC")=$P(FLIST(IND),U,5,10)
-	.. S FIEVAL(NP,"FINDING")=TAXIEN_";PXD(811.2,"
-	.. M FIEVAL(NP)=FIEVT
-	.. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVT
-	;Save the finding result.
-	D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
-	Q
-	;
-	;==================================================
-GPLIST(TAXIEN,FINDPA,PLIST)	;Get the list of patients with
-	;taxonomy TAXIEN. Return the list as:
-	; ^TMP($J,PLIST,T/F,DFN,TAXIEN,COUNT,FILE NUMBER)
-	; =DAS^DATE^CODE^TYPE^file specific. TAXIEN is like the item for
-	;non-taxonomy findings.
-	N BDT,COND,DATE,DFN,DLIST,EDT,ENS,FILENUM
-	N ICOND,IND,INS,IPLIST
-	N NF,NFOUND,NICD0,NICD9,NCPT,NF,NGET,NOCC,NRCPT
-	N PLS,RAS,STATUSA,UCIFS,USEINP,TAXARR,TF,TLIST,VSLIST
-	;Set the finding search parameters.
-	S TLIST="GPLIST_PXRMTAX"
-	K ^TMP($J,TLIST)
-	D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT)
-	D TAX^PXRMLDR(TAXIEN,.TAXARR)
-	D SETVAR^PXRMTAXS(.TAXARR,.ENS,.INS,.NICD0,.NICD9,.NCPT,.NRCPT,.PLS,.RAS)
-	D SCPAR^PXRMCOND(.FINDPA,.COND,.UCIFS,.ICOND,.VSLIST)
-	;
-	I (NICD0>0),INS D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,"ICD0",TLIST)
-	;
-	I (NICD9>0),INS D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,"ICD9",TLIST)
-	I (NICD9>0),PLS D 
-	. K STATUSA
-	. D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA)
-	. D GPLIST^PXRMPROB(.TAXARR,NOCC,BDT,EDT,.STATUSA,TLIST)
-	I (NICD9>0),ENS D GPLIST^PXRMVPOV(.TAXARR,NOCC,BDT,EDT,TLIST)
-	;
-	I (NCPT>0),ENS D GPLIST^PXRMVCPT(.TAXARR,NOCC,BDT,EDT,TLIST)
-	;
-	I (NRCPT>0),RAS D GPLIST^PXRMRCPT(.TAXARR,.FINDPA,TLIST)
-	;Conditions for taxonomies only apply to radiology findings, this
-	;is taken care of in PXRMRCPT.
-	;Process the found list, return up to NOCC of the most recent entries.
-	F TF=0,1 D
-	. I '$D(^TMP($J,TLIST,TF)) Q
-	. S DFN=""
-	. F  S DFN=$O(^TMP($J,TLIST,TF,DFN)) Q:DFN=""  D
-	.. K DLIST,IPLIST
-	.. S NFOUND=0
-	.. S NF=""
-	.. F  S NF=$O(^TMP($J,TLIST,TF,DFN,NF),-1) Q:NF=""  D
-	... S FILENUM=0
-	... F  S FILENUM=$O(^TMP($J,TLIST,TF,DFN,NF,FILENUM)) Q:FILENUM=""  D
-	.... S NFOUND=NFOUND+1
-	.... S DATE=$P(^TMP($J,TLIST,TF,DFN,NF,FILENUM),U,2)
-	.... S DLIST(DATE,NFOUND)=NF_U_FILENUM
-	..;
-	.. S DATE="",NFOUND=0
-	.. F  S DATE=$O(DLIST(DATE),-1) Q:(DATE="")!(NFOUND=NOCC)  D
-	... S NF=0
-	... F  S NF=$O(DLIST(DATE,NF)) Q:(NF="")!(NFOUND=NOCC)  D
-	.... S NFOUND=NFOUND+1
-	.... S IND=$P(DLIST(DATE,NF),U,1)
-	.... S FILENUM=$P(DLIST(DATE,NF),U,2)
-	.... S IPLIST(TF,DFN,TAXIEN,NFOUND,FILENUM)=^TMP($J,TLIST,TF,DFN,IND,FILENUM)
-	.. M ^TMP($J,PLIST)=IPLIST
-	K ^TMP($J,TLIST)
-	Q
-	;
-	;==================================================
-MHVOUT(INDENT,IFIEVAL,NLINES,TEXT)	;Produce the MHV output.
-	N IND,FILENUM,FNA,OCCLIST,TIFIEVAL
-	S IND=0
-	F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)=""
-	S FILENUM=""
-	F  S FILENUM=$O(FNA(FILENUM)) Q:FILENUM=""  D
-	. K OCCLIST
-	. M OCCLIST=FNA(FILENUM)
-	. I FILENUM=45 D MHVOUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
-	. I FILENUM=70 D MHVOUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
-	. I FILENUM=9000010.07 D MHVOUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
-	. I FILENUM=9000010.18 D MHVOUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
-	. I FILENUM=9000011 D MHVOUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
-	Q
-	;
-	;==================================================
-OUTPUT(INDENT,IFIEVAL,NLINES,TEXT)	;Produce the clinical
-	;maintenance output.
-	N IND,FILENUM,FNA,OCCLIST,TIFIEVAL
-	S IND=0
-	F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)=""
-	S FILENUM=""
-	F  S FILENUM=$O(FNA(FILENUM)) Q:FILENUM=""  D
-	. K OCCLIST
-	. M OCCLIST=FNA(FILENUM)
-	. I FILENUM=45 D OUTPUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
-	. I FILENUM=70 D OUTPUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
-	. I FILENUM=9000010.07 D OUTPUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
-	. I FILENUM=9000010.18 D OUTPUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
-	. I FILENUM=9000011 D OUTPUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
-	Q
-	;
+PXRMTAX ; SLC/PKR - Handle taxonomy finding. ;07/17/2006
+ ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+ ;
+ ;==================================================
+EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate taxonomy findings.
+ N FIEVT,FINDPA,FINDING
+ N TAXIEN
+ S TAXIEN=""
+ F  S TAXIEN=$O(DEFARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
+ . S FINDING=""
+ . F  S FINDING=$O(DEFARR("E",ENODE,TAXIEN,FINDING)) Q:+FINDING=0  D
+ .. K FINDPA
+ .. M FINDPA=DEFARR(20,FINDING)
+ .. K FIEVT
+ .. D FIEVAL(DFN,TAXIEN,.FINDPA,.FIEVT)
+ .. M FIEVAL(FINDING)=FIEVT
+ Q
+ ;
+ ;==================================================
+EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate taxonomy terms for
+ ;building patient lists.
+ N PFIND3,PFIND4,PFINDPA,TAXIEN
+ N TFINDPA,TFINDING
+ S TAXIEN=""
+ F  S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
+ . S TFINDING=""
+ . F  S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0  D
+ .. K PFINDPA,TFINDPA
+ .. M TFINDPA=TERMARR(20,TFINDING)
+ ..;Set the finding parameters.
+ .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+ .. D GPLIST(TAXIEN,.PFINDPA,PLIST)
+ Q
+ ;
+ ;==================================================
+EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate taxonomy
+ ;terms.
+ N FIEVT,PFINDPA
+ N TAXIEN,TFINDPA,TFINDING
+ S TAXIEN=""
+ F  S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
+ . S TFINDING=""
+ . F  S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0  D
+ .. K FIEVT,PFINDPA,TFINDPA
+ .. M TFINDPA=TERMARR(20,TFINDING)
+ ..;Set the finding parameters.
+ .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+ .. D FIEVAL(DFN,TAXIEN,.PFINDPA,.FIEVT)
+ .. M TFIEVAL(TFINDING)=FIEVT
+ Q
+ ;
+ ;==================================================
+FIEVAL(DFN,TAXIEN,FINDPA,FIEVAL) ;
+ N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,ENS,FIEVT,FILENUM,FLIST
+ N ICOND,IND,INS,INVFD
+ N NFOUND,NGET,NICD0,NICD9,NCPT,NOCC,NP,NRCPT,PLS
+ N RAS,SAVE,SDIR,STATUSA,TAXARR,TLIST,UCIFS,USEINP,VSLIST
+ ;Set the finding search parameters.
+ D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT)
+ S INVFD=$P(FINDPA(0),U,16)
+ D TAX^PXRMLDR(TAXIEN,.TAXARR)
+ I TAXARR(0)["NO LOCK" S FIEVAL(1)=0 Q
+ D SETVAR^PXRMTAXS(.TAXARR,.ENS,.INS,.NICD0,.NICD9,.NCPT,.NRCPT,.PLS,.RAS)
+ D SCPAR^PXRMCOND(.FINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
+ S SDIR=$S(NOCC<0:+1,1:-1)
+ S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
+ S NGET=$S(UCIFS:"*",1:NOCC)
+ ;
+ I (NICD0>0),INS D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,"ICD0",.TLIST)
+ ;
+ I (NICD9>0),INS D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,"ICD9",.TLIST)
+ I (NICD9>0),ENS D FPDAT^PXRMVPOV(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
+ I (NICD9>0),PLS D
+ . K STATUSA
+ . D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA)
+ . D FPDAT^PXRMPROB(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.STATUSA,.TLIST)
+ ;
+ I (NCPT>0),(ENS) D FPDAT^PXRMVCPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
+ ;
+ I (NRCPT>0),(RAS) D
+ . K STATUSA
+ . D GETSTATI^PXRMSTAT(70,.FINDPA,.STATUSA)
+ . D FPDAT^PXRMRCPT(DFN,.TAXARR,NOCC,BDT,EDT,.STATUSA,.TLIST)
+ ;
+ ;Process the found list, returning the NOCC most recent results.
+ S NFOUND=0
+ S DATE=""
+ F  S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NOCC)  D
+ . S IND=0
+ . F  S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NOCC)  D
+ .. S FILENUM=0
+ .. F  S FILENUM=$O(TLIST(DATE,IND,FILENUM)) Q:FILENUM=""  D
+ ... S NFOUND=NFOUND+1
+ ... S DAS=$P(TLIST(DATE,IND,FILENUM),U,1)
+ ... S FLIST(NFOUND)=TLIST(DATE,IND,FILENUM)
+ ... S FLIST(NFOUND)=DAS_U_DATE_U_FILENUM_U_$P(TLIST(DATE,IND,FILENUM),U,2,10)
+ I NFOUND=0 S FIEVAL=0 Q
+ S NP=0
+ F IND=1:1:NFOUND Q:NP=NOCC  D
+ . S DAS=$P(FLIST(IND),U,1)
+ . S FILENUM=$P(FLIST(IND),U,3)
+ . D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT)
+ . I $D(FIEVT("VISIT")) D GETDATA^PXRMVSIT(FIEVT("VISIT"),.FIEVT,0)
+ . S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVT),1:1)
+ . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
+ . I SAVE D
+ .. S NP=NP+1
+ .. S FIEVAL(NP)=CONVAL
+ .. S FIEVAL(NP,"CONDITION")=CONVAL
+ .. S FIEVAL(NP,"CODEP")=$P(FLIST(IND),U,4)
+ .. S FIEVAL(NP,"DAS")=DAS
+ .. S FIEVAL(NP,"DATE")=$P(FLIST(IND),U,2)
+ .. S FIEVAL(NP,"FILE NUMBER")=FILENUM
+ .. S FIEVAL(NP,"FILE SPECIFIC")=$P(FLIST(IND),U,5,10)
+ .. S FIEVAL(NP,"FINDING")=TAXIEN_";PXD(811.2,"
+ .. M FIEVAL(NP)=FIEVT
+ .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVT
+ ;Save the finding result.
+ D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
+ Q
+ ;
+ ;==================================================
+GPLIST(TAXIEN,FINDPA,PLIST) ;Get the list of patients with
+ ;taxonomy TAXIEN. Return the list as:
+ ; ^TMP($J,PLIST,T/F,DFN,TAXIEN,COUNT,FILE NUMBER)
+ ; =DAS^DATE^CODE^TYPE^file specific. TAXIEN is like the item for
+ ;non-taxonomy findings.
+ N BDT,COND,DATE,DFN,DLIST,EDT,ENS,FILENUM
+ N ICOND,IND,INS,IPLIST
+ N NF,NFOUND,NICD0,NICD9,NCPT,NF,NGET,NOCC,NRCPT
+ N PLS,RAS,STATUSA,UCIFS,USEINP,TAXARR,TF,TLIST,VSLIST
+ ;Set the finding search parameters.
+ S TLIST="GPLIST_PXRMTAX"
+ K ^TMP($J,TLIST)
+ D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT)
+ D TAX^PXRMLDR(TAXIEN,.TAXARR)
+ D SETVAR^PXRMTAXS(.TAXARR,.ENS,.INS,.NICD0,.NICD9,.NCPT,.NRCPT,.PLS,.RAS)
+ D SCPAR^PXRMCOND(.FINDPA,.COND,.UCIFS,.ICOND,.VSLIST)
+ ;
+ I (NICD0>0),INS D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,"ICD0",TLIST)
+ ;
+ I (NICD9>0),INS D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,"ICD9",TLIST)
+ I (NICD9>0),PLS D 
+ . K STATUSA
+ . D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA)
+ . D GPLIST^PXRMPROB(.TAXARR,NOCC,BDT,EDT,.STATUSA,TLIST)
+ I (NICD9>0),ENS D GPLIST^PXRMVPOV(.TAXARR,NOCC,BDT,EDT,TLIST)
+ ;
+ I (NCPT>0),ENS D GPLIST^PXRMVCPT(.TAXARR,NOCC,BDT,EDT,TLIST)
+ ;
+ I (NRCPT>0),RAS D GPLIST^PXRMRCPT(.TAXARR,.FINDPA,TLIST)
+ ;Conditions for taxonomies only apply to radiology findings, this
+ ;is taken care of in PXRMRCPT.
+ ;Process the found list, return up to NOCC of the most recent entries.
+ F TF=0,1 D
+ . I '$D(^TMP($J,TLIST,TF)) Q
+ . S DFN=""
+ . F  S DFN=$O(^TMP($J,TLIST,TF,DFN)) Q:DFN=""  D
+ .. K DLIST,IPLIST
+ .. S NFOUND=0
+ .. S NF=""
+ .. F  S NF=$O(^TMP($J,TLIST,TF,DFN,NF),-1) Q:NF=""  D
+ ... S FILENUM=0
+ ... F  S FILENUM=$O(^TMP($J,TLIST,TF,DFN,NF,FILENUM)) Q:FILENUM=""  D
+ .... S NFOUND=NFOUND+1
+ .... S DATE=$P(^TMP($J,TLIST,TF,DFN,NF,FILENUM),U,2)
+ .... S DLIST(DATE,NFOUND)=NF_U_FILENUM
+ ..;
+ .. S DATE="",NFOUND=0
+ .. F  S DATE=$O(DLIST(DATE),-1) Q:(DATE="")!(NFOUND=NOCC)  D
+ ... S NF=0
+ ... F  S NF=$O(DLIST(DATE,NF)) Q:(NF="")!(NFOUND=NOCC)  D
+ .... S NFOUND=NFOUND+1
+ .... S IND=$P(DLIST(DATE,NF),U,1)
+ .... S FILENUM=$P(DLIST(DATE,NF),U,2)
+ .... S IPLIST(TF,DFN,TAXIEN,NFOUND,FILENUM)=^TMP($J,TLIST,TF,DFN,IND,FILENUM)
+ .. M ^TMP($J,PLIST)=IPLIST
+ K ^TMP($J,TLIST)
+ Q
+ ;
+ ;==================================================
+MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+ N IND,FILENUM,FNA,OCCLIST,TIFIEVAL
+ S IND=0
+ F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)=""
+ S FILENUM=""
+ F  S FILENUM=$O(FNA(FILENUM)) Q:FILENUM=""  D
+ . K OCCLIST
+ . M OCCLIST=FNA(FILENUM)
+ . I FILENUM=45 D MHVOUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
+ . I FILENUM=70 D MHVOUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
+ . I FILENUM=9000010.07 D MHVOUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
+ . I FILENUM=9000010.18 D MHVOUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
+ . I FILENUM=9000011 D MHVOUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
+ Q
+ ;
+ ;==================================================
+OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+ ;maintenance output.
+ N IND,FILENUM,FNA,OCCLIST,TIFIEVAL
+ S IND=0
+ F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)=""
+ S FILENUM=""
+ F  S FILENUM=$O(FNA(FILENUM)) Q:FILENUM=""  D
+ . K OCCLIST
+ . M OCCLIST=FNA(FILENUM)
+ . I FILENUM=45 D OUTPUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
+ . I FILENUM=70 D OUTPUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
+ . I FILENUM=9000010.07 D OUTPUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
+ . I FILENUM=9000010.18 D OUTPUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
+ . I FILENUM=9000011 D OUTPUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
+ Q
+ ;
