Index: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETXR.m
===================================================================
--- WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETXR.m	(revision 613)
+++ WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETXR.m	(revision 623)
@@ -1,251 +1,248 @@
-PXRMETXR	; SLC/PJH,PKR - Reminder section of extract ;02/22/2007
-	;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
-	; 
-	; Called from PXRMETX
-	;
-DATE	;Check if finding is most recent in evaluation group
-	N FDATE,GDATE
-	;Determine finding date and existing group date
-	S FDATE=$G(FIEV(FNUM,"DATE")),GDATE=$G(GROUP(GSEQ,"DATE")) Q:FDATE=""
-	;Ignore findings outside to the extract period
-	;I $$FMDIFF^XLFDT(PXRMSTRT,FDATE,2)>0 Q
-	;If this is first or only entry in group then save finding date
-	I 'GDATE S GROUP(GSEQ,"DATE")=FDATE,GROUP(GSEQ)=FSEQ Q
-	;Save finding if most recent date for the group
-	I $$FMDIFF^XLFDT(FDATE,GDATE,2)>0 S GROUP(GSEQ,"DATE")=FDATE,GROUP(GSEQ)=FSEQ Q
-	Q
-	;
-FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP)	;Process findings for reminder
-	;Default is extract no findings
-	N DATA,FCNT,FIEN,FIND,FNUM,FSEQ,GDATA,GROUP,GSEQ,GTYP
-	S FNUM=0,FCNT=0
-	F  S FNUM=$O(FIEV(FNUM)) Q:'FNUM  D
-	.;Ignore if not found for patient
-	.I +FIEV(FNUM)=0 Q
-	.;Only terms are counted
-	.S FIND=$G(FIEV(FNUM,"TERM IEN")) Q:FIND=""
-	.;Check if in list to be accumulated
-	.I '$D(REM(RCNT,FIND)) Q
-	.;Find groups to which finding belongs
-	.S GSEQ=""
-	.F  S GSEQ=$O(REM(RCNT,FIND,GSEQ)) Q:GSEQ=""  D
-	..;Determine Evaluation type
-	..S GTYP=REM(RCNT,FIND,GSEQ)
-	..;Ignore utilization groups
-	..I GTYP="UR" Q
-	..;Sequence determines where the finding will be stored
-	..S FSEQ=""
-	..F  S FSEQ=$O(REM(RCNT,FIND,GSEQ,FSEQ)) Q:FSEQ=""  D
-	...;Evaluation Group logic to save latest entry only
-	...I GTYP="MRFP" D DATE Q
-	...;Save finding totals
-	...D UPD(1)
-	;
-	;Check for group totals
-	S GSEQ=""
-	F  S GSEQ=$O(GROUP(GSEQ)) Q:GSEQ=""  D
-	.S GDATA=$G(GROUP(GSEQ)) Q:GDATA=""
-	.;Update if found
-	.S FSEQ=$P(GDATA,U) D UPD(1)
-	;
-	;Utilization counts are done separately
-	N CNT,FDATA,FIND,FINDPA,FTIEN,GTYP,TERMARR,TFIEVAL
-	;modify start date to include incomplete dates
-	I $E(PXRMSTRT,6,7)="01" S PXRMSTRT=$E(PXRMSTRT,1,5)_"00"
-	;Include incomplete dates in January
-	I $E(PXRMSTRT,4,5)="01" S PXRMSTRT=$E(PXRMSTRT,1,3)_"0000"
-	;Set start and stop dates for term
-	;S $P(FINDPA(0),U,8)=PXRMSTRT,$P(FINDPA(0),U,11)=PXRMSTOP
-	S $P(FINDPA(0),U,11)=PXRMSTOP
-	;Count all entries
-	S $P(FINDPA(0),U,14)="*"
-	;
-	S FTIEN="",GTYP="UR"
-	F  S FTIEN=$O(FUTIL(RCNT,FTIEN)) Q:FTIEN=""  D
-	.S GSEQ=""
-	.F  S GSEQ=$O(FUTIL(RCNT,FTIEN,GSEQ)) Q:GSEQ=""  D
-	..S FSEQ=""
-	..F  S FSEQ=$O(FUTIL(RCNT,FTIEN,GSEQ,FSEQ)) Q:FSEQ=""  D
-	...;Recover list of term findings
-	...K TERMARR M TERMARR=FUTIL(RCNT,FTIEN,GSEQ,FSEQ)
-	...;Process term 
-	...K TFIEVAL D EVALTERM^PXRMTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
-	...D URCNT(PXRMSTRT,PXRMSTOP,.TFIEVAL)
-	;Determine count from PLIST then add to ETX
-	;S CNT=+$O(PLIST(1,999999),-1) Q:'CNT
-	;D UPD(CNT)
-	Q
-	;
-FRULE(FRIEN,RCNT,SEQ,REM,FUTIL)	;Build array of findings in the finding rule
-	N DATA,FIND,FSEQ,GIEN,GNAM,GSEQ,GTYP,GSTA,SUB,TLIST
-	S GSEQ=0
-	F  S GSEQ=$O(^PXRM(810.7,FRIEN,10,"B",GSEQ)) Q:GSEQ=""  D
-	.S SUB=$O(^PXRM(810.7,FRIEN,10,"B",GSEQ,"")) Q:'SUB
-	.S DATA=$G(^PXRM(810.7,FRIEN,10,SUB,0)) Q:DATA=""
-	.;Get the finding group ien and reminder status
-	.S GIEN=$P(DATA,U,2),GSTA=$P(DATA,U,3) Q:'GIEN
-	.;If no status then report finding totals for all patients 
-	.I GSTA="" S GSTA="T"
-	.;Get finding group info
-	.S DATA=$G(^PXRM(810.8,GIEN,0)) Q:DATA=""
-	.;Get group name and count type
-	.S GTYP=$P(DATA,U,3),GNAM=$P(DATA,U) Q:GTYP=""
-	.;Save group in workfile
-	.S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ)=GNAM_U_GTYP_U_GSTA
-	.;Get all findings in group
-	.S FSEQ=0
-	.F  S FSEQ=$O(^PXRM(810.8,GIEN,10,"B",FSEQ)) Q:FSEQ=""  D
-	..S SUB=$O(^PXRM(810.8,GIEN,10,"B",FSEQ,"")) Q:'SUB
-	..S DATA=$G(^PXRM(810.8,GIEN,10,SUB,0)) Q:DATA=""
-	..;Get the finding ien and exclusion status
-	..S FIND=$P(DATA,U,2) Q:'FIND
-	..;Initialize count for finding
-	..S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)=FIND
-	..;Reminder evaluation counts work from REM
-	..I GTYP'="UR" D  Q
-	...S REM(RCNT,FIND,GSEQ,FSEQ)=""
-	...S REM(RCNT,FIND,GSEQ)=GTYP
-	..;Utilization counts work from FUTIL
-	..D TERM^PXRMLDR(FIND,.TLIST)
-	..;Save TLIST
-	..M FUTIL(RCNT,FIND,GSEQ,FSEQ)=TLIST
-	Q
-	;
-REM(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE)	;Run reminders against patient
-	;lists.
-	N APPL,DATA,DEFARR,DEFSITE,DFN,DUE,FIEV,FRIEN,FUTIL,IND,INST
-	N PXRMDATE,RCNT,REM,REMSEQ,RIEN,RNAM,STATUS,SUB1,TODAY
-	N END,START
-	;S START=$H
-	S TODAY=$$DT^XLFDT
-	;Evaluation date is period end except if the period is incomplete
-	S PXRMDATE=$S($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
-	;Scan reminders for this parameter set
-	S (RCNT,SUB1)=0
-	S REMSEQ=""
-	F  S REMSEQ=$O(^PXRM(810.2,IEN,10,SUB,10,"B",REMSEQ)) Q:REMSEQ=""  D
-	.F  S SUB1=$O(^PXRM(810.2,IEN,10,SUB,10,"B",REMSEQ,SUB1)) Q:'SUB1  D
-	..S DATA=$G(^PXRM(810.2,IEN,10,SUB,10,SUB1,0)) Q:DATA=""
-	..;Reminder ien
-	..S RIEN=$P(DATA,U,2) Q:'RIEN
-	..;Evaluation date is period end except if the period is incomplete.
-	..S PXRMDATE=$S($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
-	..;Finding Rule
-	..S FRIEN=$P(DATA,U,3)
-	..;Reminder print name
-	..S RNAM=$P($G(^PXD(811.9,RIEN,0)),U,3)
-	..I RNAM="" S RNAM=$P(^PXD(811.9,RIEN,0),U,1)
-	..;Save details to REM array
-	..S RCNT=RCNT+1,REM(RCNT)=RIEN_U_RNAM_U_FRIEN
-	..;Build list of terms from extract finding rule #810.7
-	..I FRIEN D FRULE(FRIEN,RCNT,SEQ,.REM,.FUTIL) Q
-	..;If no extract finding rule defined collect all findings in reminder
-	..I 'FRIEN D REMF(RIEN,RCNT,SEQ,.REM)
-	;
-	;Process patient list
-	S IND=0,DEFSITE=+$P($$SITE^VASITE,U,3)
-	F  S IND=$O(^PXRMXP(810.5,PXRMLIST,30,IND)) Q:'IND  D
-	.S DFN=$P($G(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U) Q:'DFN
-	.S INST=$P($G(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U,2)
-	.I INST="" S INST=DEFSITE
-	.S RCNT=0
-	.F  S RCNT=$O(REM(RCNT)) Q:'RCNT  D
-	..S RIEN=$P(REM(RCNT),U),RNAM=$P(REM(RCNT),U,2),FRIEN=$P(REM(RCNT),U,3)
-	..;Clear evaluation arrays.
-	..K ^TMP("PXRHM",$J),^TMP("PXRMID",$J),FIEV
-	..;Evaluate reminders and store results
-	..D DEF^PXRMLDR(RIEN,.DEFARR)
-	..D EVAL^PXRM(DFN,.DEFARR,1,1,.FIEV,PXRMDATE)
-	..;Determine update from reminder status
-	..S STATUS=$P($G(^TMP("PXRHM",$J,RIEN,RNAM)),U) I STATUS="" Q
-	..;Ignore not applicables
-	..S APPL=$S(STATUS["DUE":1,STATUS="RESOLVED":1,STATUS="DONE":1,1:0)
-	..;Check if due
-	..S DUE=$S(STATUS="DUE NOW":1,1:0)
-	..;Compliance totals
-	..S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT))
-	..;Reminder ien
-	..I $P(DATA,U)="" S $P(DATA,U)=RIEN
-	..;Evaluated total
-	..S $P(DATA,U,2)=$P(DATA,U,2)+1
-	..;Applicable total
-	..S $P(DATA,U,3)=$P(DATA,U,3)+APPL
-	..;Not applicable total
-	..I 'APPL,'DUE S $P(DATA,U,4)=$P(DATA,U,4)+1
-	..;Due total
-	..S $P(DATA,U,5)=$P(DATA,U,5)+DUE
-	..;Not due count
-	..I APPL,'DUE S $P(DATA,U,6)=$P(DATA,U,6)+1
-	..;Add patient list
-	..I $P(DATA,U,7)="" S $P(DATA,U,7)=PXRMLIST
-	..;Update workfile
-	..S ^TMP("PXRMETX",$J,SEQ,INST,RCNT)=DATA
-	..;Save finding totals
-	..I PARTYPE="CF" D FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP)
-	;Clear evaluation fields
-	K ^TMP("PXRHM",$J),^TMP("PXRMID",$J)
-	;S END=$H
-	;W !,"REMINDER EVALUATION TIME"
-	;D DETIME^PXRMXSEL(START,END)
-	Q
-	;
-REMF(RIEN,RCNT,SEQ,REM)	;Build array of all findings in the reminder
-	N GNAM,GSEQ,FIND,FSEQ,GTYP,SUB
-	S GNAM="Finding totals",GSEQ="001",FSEQ=0,GTYP="MRF"
-	;Save group name
-	S ^TMP("PXRMETX",$J,SEQ,RCNT,GSEQ)=GNAM_U_GTYP
-	;Select all findings in the reminder
-	S SUB=0
-	F  S SUB=$O(^PXD(811.9,RIEN,20,SUB)) Q:'SUB  D
-	.;Ignore if finding is not a term
-	.S FIND=$P($G(^PXD(811.9,RIEN,20,SUB,0)),U) Q:FIND'["PXRMD(811.5"
-	.;Convert to term ien
-	.S FIND=$P(FIND,";")
-	.;Build sequence number
-	.S FSEQ=FSEQ+1,FSEQ=$$RJ^XLFSTR(FSEQ,3,0)
-	.;Evaluation counts
-	.S REM(RCNT,FIND,GSEQ,FSEQ)=""
-	.S REM(RCNT,FIND,GSEQ)=GTYP
-	.;Update Workfile
-	.S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)=FIND
-	Q
-	;
-URCNT(PXRMSTRT,PXRMSTOP,TFIEVAL)	;
-	;Handle counting all valid occurrences for the finding items.
-	;Includes historical entries that were entered within the reporting
-	;period, cut the encounter date if it is outside the reporting period.
-	N CNT,DATEENT,FDATE,FILE,FNUM,FOCCNUM,HIST,NODE,SCAT,VIEN
-	S CNT=0,FNUM=0
-	F  S FNUM=$O(TFIEVAL(FNUM)) Q:FNUM'>0  D
-	.S FILE=$G(TFIEVAL(FNUM,"FILE NUMBER"))
-	.S HIST=$S(FILE=9000010.18:1,FILE=9000010.13:1,FILE=9000010.23:1,FILE=9000010.16:1,FILE=9000010.07:1,FILE=9000010.12:1,FILE=9000010.15:1,1:0)
-	.S FOCCNUM=0 F  S FOCCNUM=$O(TFIEVAL(FNUM,FOCCNUM)) Q:FOCCNUM'>0  D
-	..S FDATE=$P(TFIEVAL(FNUM,FOCCNUM,"DATE"),".") Q:FDATE'>0
-	..I HIST=0,FDATE=PXRMSTRT!(FDATE>PXRMSTRT) S CNT=CNT+1
-	..I HIST=1 D
-	...S VIEN=TFIEVAL(FNUM,FOCCNUM,"VISIT") Q:VIEN'>0
-	...S NODE=$G(^AUPNVSIT(VIEN,0))
-	...S SCAT=$P(NODE,U,7),DATEENT=$P($P(NODE,U,2),".")
-	...I FDATE=PXRMSTRT!(FDATE>PXRMSTRT),SCAT'="E" S CNT=CNT+1 Q
-	...I SCAT="E",(DATEENT=PXRMSTRT!(DATEENT>PXRMSTRT))&(DATEENT=PXRMSTOP!(DATEENT<PXRMSTOP)) S CNT=CNT+1
-	D UPD(CNT)
-	Q
-	;
-UPD(CNT)	;Update totals
-	S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ))
-	;Total count
-	S $P(DATA,U,2)=$P(DATA,U,2)+CNT
-	;Applicable count
-	S $P(DATA,U,3)=$P(DATA,U,3)+(APPL*CNT)
-	;Not applicable count
-	I 'APPL,'DUE S $P(DATA,U,4)=$P(DATA,U,4)+CNT
-	;Due count
-	S $P(DATA,U,5)=$P(DATA,U,5)+(DUE*CNT)
-	;Not due count
-	I APPL,'DUE S $P(DATA,U,6)=$P(DATA,U,6)+CNT
-	;Update current count
-	S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ)=DATA
-	;AGP REMOVE UNTIL A DECISION CAN BE MADE
-	;I CNT=1,APPL=1 S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)=DFN
-	Q
-	;
+PXRMETXR ; SLC/PJH,PKR - Reminder section of extract ;05/01/2006
+ ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+ ; 
+ ; Called from PXRMETX
+ ;
+DATE ;Check if finding is most recent in evaluation group
+ N FDATE,GDATE
+ ;Determine finding date and existing group date
+ S FDATE=$G(FIEV(FNUM,"DATE")),GDATE=$G(GROUP(GSEQ,"DATE")) Q:FDATE=""
+ ;Ignore findings outside to the extract period
+ ;I $$FMDIFF^XLFDT(PXRMSTRT,FDATE,2)>0 Q
+ ;If this is first or only entry in group then save finding date
+ I 'GDATE S GROUP(GSEQ,"DATE")=FDATE,GROUP(GSEQ)=FSEQ Q
+ ;Save finding if most recent date for the group
+ I $$FMDIFF^XLFDT(FDATE,GDATE,2)>0 S GROUP(GSEQ,"DATE")=FDATE,GROUP(GSEQ)=FSEQ Q
+ Q
+ ;
+FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP) ;Process findings for reminder
+ ;Default is extract no findings
+ N DATA,FCNT,FIEN,FIND,FNUM,FSEQ,GDATA,GROUP,GSEQ,GTYP
+ S FNUM=0,FCNT=0
+ F  S FNUM=$O(FIEV(FNUM)) Q:'FNUM  D
+ .;Ignore if not found for patient
+ .I +FIEV(FNUM)=0 Q
+ .;Only terms are counted
+ .S FIND=$G(FIEV(FNUM,"TERM IEN")) Q:FIND=""
+ .;Check if in list to be accumulated
+ .I '$D(REM(RCNT,FIND)) Q
+ .;Find groups to which finding belongs
+ .S GSEQ=""
+ .F  S GSEQ=$O(REM(RCNT,FIND,GSEQ)) Q:GSEQ=""  D
+ ..;Determine Evaluation type
+ ..S GTYP=REM(RCNT,FIND,GSEQ)
+ ..;Ignore utilization groups
+ ..I GTYP="UR" Q
+ ..;Sequence determines where the finding will be stored
+ ..S FSEQ=""
+ ..F  S FSEQ=$O(REM(RCNT,FIND,GSEQ,FSEQ)) Q:FSEQ=""  D
+ ...;Evaluation Group logic to save latest entry only
+ ...I GTYP="MRFP" D DATE Q
+ ...;Save finding totals
+ ...D UPD(1)
+ ;
+ ;Check for group totals
+ S GSEQ=""
+ F  S GSEQ=$O(GROUP(GSEQ)) Q:GSEQ=""  D
+ .S GDATA=$G(GROUP(GSEQ)) Q:GDATA=""
+ .;Update if found
+ .S FSEQ=$P(GDATA,U) D UPD(1)
+ ;
+ ;Utilization counts are done separately
+ N CNT,FDATA,FIND,FINDPA,FTIEN,GTYP,TERMARR,TFIEVAL
+ ;modify start date to include incomplete dates
+ I $E(PXRMSTRT,6,7)="01" S PXRMSTRT=$E(PXRMSTRT,1,5)_"00"
+ ;Include incomplete dates in January
+ I $E(PXRMSTRT,4,5)="01" S PXRMSTRT=$E(PXRMSTRT,1,3)_"0000"
+ ;Set start and stop dates for term
+ ;S $P(FINDPA(0),U,8)=PXRMSTRT,$P(FINDPA(0),U,11)=PXRMSTOP
+ S $P(FINDPA(0),U,11)=PXRMSTOP
+ ;Count all entries
+ S $P(FINDPA(0),U,14)="*"
+ ;
+ S FTIEN="",GTYP="UR"
+ F  S FTIEN=$O(FUTIL(RCNT,FTIEN)) Q:FTIEN=""  D
+ .S GSEQ=""
+ .F  S GSEQ=$O(FUTIL(RCNT,FTIEN,GSEQ)) Q:GSEQ=""  D
+ ..S FSEQ=""
+ ..F  S FSEQ=$O(FUTIL(RCNT,FTIEN,GSEQ,FSEQ)) Q:FSEQ=""  D
+ ...;Recover list of term findings
+ ...K TERMARR M TERMARR=FUTIL(RCNT,FTIEN,GSEQ,FSEQ)
+ ...;Process term 
+ ...K TFIEVAL D EVALTERM^PXRMTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
+ ...D URCNT(PXRMSTRT,PXRMSTOP,.TFIEVAL)
+ ;Determine count from PLIST then add to ETX
+ ;S CNT=+$O(PLIST(1,999999),-1) Q:'CNT
+ ;D UPD(CNT)
+ Q
+ ;
+FRULE(FRIEN,RCNT,SEQ,REM,FUTIL) ;Build array of findings in the finding rule
+ N DATA,FIND,FSEQ,GIEN,GNAM,GSEQ,GTYP,GSTA,SUB,TLIST
+ S GSEQ=0
+ F  S GSEQ=$O(^PXRM(810.7,FRIEN,10,"B",GSEQ)) Q:GSEQ=""  D
+ .S SUB=$O(^PXRM(810.7,FRIEN,10,"B",GSEQ,"")) Q:'SUB
+ .S DATA=$G(^PXRM(810.7,FRIEN,10,SUB,0)) Q:DATA=""
+ .;Get the finding group ien and reminder status
+ .S GIEN=$P(DATA,U,2),GSTA=$P(DATA,U,3) Q:'GIEN
+ .;If no status then report finding totals for all patients 
+ .I GSTA="" S GSTA="T"
+ .;Get finding group info
+ .S DATA=$G(^PXRM(810.8,GIEN,0)) Q:DATA=""
+ .;Get group name and count type
+ .S GTYP=$P(DATA,U,3),GNAM=$P(DATA,U) Q:GTYP=""
+ .;Save group in workfile
+ .S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ)=GNAM_U_GTYP_U_GSTA
+ .;Get all findings in group
+ .S FSEQ=0
+ .F  S FSEQ=$O(^PXRM(810.8,GIEN,10,"B",FSEQ)) Q:FSEQ=""  D
+ ..S SUB=$O(^PXRM(810.8,GIEN,10,"B",FSEQ,"")) Q:'SUB
+ ..S DATA=$G(^PXRM(810.8,GIEN,10,SUB,0)) Q:DATA=""
+ ..;Get the finding ien and exclusion status
+ ..S FIND=$P(DATA,U,2) Q:'FIND
+ ..;Initialize count for finding
+ ..S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)=FIND
+ ..;Reminder evaluation counts work from REM
+ ..I GTYP'="UR" D  Q
+ ...S REM(RCNT,FIND,GSEQ,FSEQ)=""
+ ...S REM(RCNT,FIND,GSEQ)=GTYP
+ ..;Utilization counts work from FUTIL
+ ..D TERM^PXRMLDR(FIND,.TLIST)
+ ..;Save TLIST
+ ..M FUTIL(RCNT,FIND,GSEQ,FSEQ)=TLIST
+ Q
+ ;
+REM(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE) ;Run reminders against patient
+ ;lists.
+ N APPL,DATA,DEFARR,DEFSITE,DFN,DUE,FIEV,FRIEN,FUTIL,IND,INST
+ N PXRMDATE,RCNT,REM,RIEN,RNAM,STATUS,SUB1,TODAY
+ N END,START
+ ;S START=$H
+ S TODAY=$$DT^XLFDT
+ ;Evaluation date is period end except if the period is incomplete
+ S PXRMDATE=$S($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
+ ;Scan reminders for this parameter set
+ S (RCNT,SUB1)=0
+ F  S SUB1=$O(^PXRM(810.2,IEN,10,SUB,10,SUB1)) Q:'SUB1  D
+ .S DATA=$G(^PXRM(810.2,IEN,10,SUB,10,SUB1,0)) Q:DATA=""
+ .;Reminder ien
+ .S RIEN=$P(DATA,U,2) Q:'RIEN
+ .;Evaluation date is period end except if the period is incomplete.
+ .S PXRMDATE=$S($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
+ .;Finding Rule
+ .S FRIEN=$P(DATA,U,3)
+ .;Reminder print name
+ .S RNAM=$P($G(^PXD(811.9,RIEN,0)),U,3)
+ .;Save details to REM array
+ .S RCNT=RCNT+1,REM(RCNT)=RIEN_U_RNAM_U_FRIEN
+ .;Build list of terms from extract finding rule #810.7
+ .I FRIEN D FRULE(FRIEN,RCNT,SEQ,.REM,.FUTIL) Q
+ .;If no extract finding rule defined collect all findings in reminder
+ .I 'FRIEN D REMF(RIEN,RCNT,SEQ,.REM)
+ ;
+ ;Process patient list
+ S IND=0,DEFSITE=+$P($$SITE^VASITE,U,3)
+ F  S IND=$O(^PXRMXP(810.5,PXRMLIST,30,IND)) Q:'IND  D
+ .S DFN=$P($G(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U) Q:'DFN
+ .S INST=$P($G(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U,2)
+ .I INST="" S INST=DEFSITE
+ .S RCNT=0
+ .F  S RCNT=$O(REM(RCNT)) Q:'RCNT  D
+ ..S RIEN=$P(REM(RCNT),U),RNAM=$P(REM(RCNT),U,2),FRIEN=$P(REM(RCNT),U,3)
+ ..;Clear evaluation arrays.
+ ..K ^TMP("PXRHM",$J),^TMP("PXRMID",$J),FIEV
+ ..;Evaluate reminders and store results
+ ..D DEF^PXRMLDR(RIEN,.DEFARR)
+ ..D EVAL^PXRM(DFN,.DEFARR,1,1,.FIEV,PXRMDATE)
+ ..;Determine update from reminder status
+ ..S STATUS=$P($G(^TMP("PXRHM",$J,RIEN,RNAM)),U) I STATUS="" Q
+ ..;Ignore not applicables
+ ..S APPL=$S(STATUS["DUE":1,STATUS="RESOLVED":1,STATUS="DONE":1,1:0)
+ ..;Check if due
+ ..S DUE=$S(STATUS="DUE NOW":1,1:0)
+ ..;Compliance totals
+ ..S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT))
+ ..;Reminder ien
+ ..I $P(DATA,U)="" S $P(DATA,U)=RIEN
+ ..;Evaluated total
+ ..S $P(DATA,U,2)=$P(DATA,U,2)+1
+ ..;Applicable total
+ ..S $P(DATA,U,3)=$P(DATA,U,3)+APPL
+ ..;Not applicable total
+ ..I 'APPL,'DUE S $P(DATA,U,4)=$P(DATA,U,4)+1
+ ..;Due total
+ ..S $P(DATA,U,5)=$P(DATA,U,5)+DUE
+ ..;Not due count
+ ..I APPL,'DUE S $P(DATA,U,6)=$P(DATA,U,6)+1
+ ..;Add patient list
+ ..I $P(DATA,U,7)="" S $P(DATA,U,7)=PXRMLIST
+ ..;Update workfile
+ ..S ^TMP("PXRMETX",$J,SEQ,INST,RCNT)=DATA
+ ..;Save finding totals
+ ..I PARTYPE="CF" D FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP)
+ ;Clear evaluation fields
+ K ^TMP("PXRHM",$J),^TMP("PXRMID",$J)
+ ;S END=$H
+ ;W !,"REMINDER EVALUATION TIME"
+ ;D DETIME^PXRMXSEL(START,END)
+ Q
+ ;
+REMF(RIEN,RCNT,SEQ,REM) ;Build array of all findings in the reminder
+ N GNAM,GSEQ,FIND,FSEQ,GTYP,SUB
+ S GNAM="Finding totals",GSEQ="001",FSEQ=0,GTYP="MRF"
+ ;Save group name
+ S ^TMP("PXRMETX",$J,SEQ,RCNT,GSEQ)=GNAM_U_GTYP
+ ;Select all findings in the reminder
+ S SUB=0
+ F  S SUB=$O(^PXD(811.9,RIEN,20,SUB)) Q:'SUB  D
+ .;Ignore if finding is not a term
+ .S FIND=$P($G(^PXD(811.9,RIEN,20,SUB,0)),U) Q:FIND'["PXRMD(811.5"
+ .;Convert to term ien
+ .S FIND=$P(FIND,";")
+ .;Build sequence number
+ .S FSEQ=FSEQ+1,FSEQ=$$RJ^XLFSTR(FSEQ,3,0)
+ .;Evaluation counts
+ .S REM(RCNT,FIND,GSEQ,FSEQ)=""
+ .S REM(RCNT,FIND,GSEQ)=GTYP
+ .;Update Workfile
+ .S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)=FIND
+ Q
+ ;
+URCNT(PXRMSTRT,PXRMSTOP,TFIEVAL) ;
+ ;Handle counting all valid occurrences for the finding items.
+ ;Includes historical entries that were entered within the reporting
+ ;period, cut the encounter date if it is outside the reporting period.
+ N CNT,DATEENT,FDATE,FILE,FNUM,FOCCNUM,HIST,NODE,SCAT,VIEN
+ S CNT=0,FNUM=0
+ F  S FNUM=$O(TFIEVAL(FNUM)) Q:FNUM'>0  D
+ .S FILE=$G(TFIEVAL(FNUM,"FILE NUMBER"))
+ .S HIST=$S(FILE=9000010.18:1,FILE=9000010.13:1,FILE=9000010.23:1,FILE=9000010.16:1,FILE=9000010.07:1,FILE=9000010.12:1,FILE=9000010.15:1,1:0)
+ .S FOCCNUM=0 F  S FOCCNUM=$O(TFIEVAL(FNUM,FOCCNUM)) Q:FOCCNUM'>0  D
+ ..S FDATE=$P(TFIEVAL(FNUM,FOCCNUM,"DATE"),".") Q:FDATE'>0
+ ..I HIST=0,FDATE=PXRMSTRT!(FDATE>PXRMSTRT) S CNT=CNT+1
+ ..I HIST=1 D
+ ...S VIEN=TFIEVAL(FNUM,FOCCNUM,"VISIT") Q:VIEN'>0
+ ...S NODE=$G(^AUPNVSIT(VIEN,0))
+ ...S SCAT=$P(NODE,U,7),DATEENT=$P($P(NODE,U,2),".")
+ ...I FDATE=PXRMSTRT!(FDATE>PXRMSTRT),SCAT'="E" S CNT=CNT+1 Q
+ ...I SCAT="E",(DATEENT=PXRMSTRT!(DATEENT>PXRMSTRT))&(DATEENT=PXRMSTOP!(DATEENT<PXRMSTOP)) S CNT=CNT+1
+ D UPD(CNT)
+ Q
+ ;
+UPD(CNT) ;Update totals
+ S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ))
+ ;Total count
+ S $P(DATA,U,2)=$P(DATA,U,2)+CNT
+ ;Applicable count
+ S $P(DATA,U,3)=$P(DATA,U,3)+(APPL*CNT)
+ ;Not applicable count
+ I 'APPL,'DUE S $P(DATA,U,4)=$P(DATA,U,4)+CNT
+ ;Due count
+ S $P(DATA,U,5)=$P(DATA,U,5)+(DUE*CNT)
+ ;Not due count
+ I APPL,'DUE S $P(DATA,U,6)=$P(DATA,U,6)+CNT
+ ;Update current count
+ S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ)=DATA
+ ;AGP REMOVE UNTIL A DECISION CAN BE MADE
+ ;I CNT=1,APPL=1 S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)=DFN
+ Q
+ ;
