PXRMETXR ; SLC/PJH,PKR - Reminder section of extract ;05/13/2016
;;2.0;CLINICAL REMINDERS;**4,6,26,47**;Feb 04, 2005;Build 291
;
; 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMETXR 9476 printed Nov 22, 2024@16:54:55 Page 2
PXRMETXR ; SLC/PJH,PKR - Reminder section of extract ;05/13/2016
+1 ;;2.0;CLINICAL REMINDERS;**4,6,26,47**;Feb 04, 2005;Build 291
+2 ;
+3 ; Called from PXRMETX
+4 ;
DATE ;Check if finding is most recent in evaluation group
+1 NEW FDATE,GDATE
+2 ;Determine finding date and existing group date
+3 SET FDATE=$GET(FIEV(FNUM,"DATE"))
SET GDATE=$GET(GROUP(GSEQ,"DATE"))
if FDATE=""
QUIT
+4 ;Ignore findings outside to the extract period
+5 ;I $$FMDIFF^XLFDT(PXRMSTRT,FDATE,2)>0 Q
+6 ;If this is first or only entry in group then save finding date
+7 IF 'GDATE
SET GROUP(GSEQ,"DATE")=FDATE
SET GROUP(GSEQ)=FSEQ
QUIT
+8 ;Save finding if most recent date for the group
+9 IF $$FMDIFF^XLFDT(FDATE,GDATE,2)>0
SET GROUP(GSEQ,"DATE")=FDATE
SET GROUP(GSEQ)=FSEQ
QUIT
+10 QUIT
+11 ;
FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP) ;Process findings for reminder
+1 ;Default is extract no findings
+2 NEW DATA,FCNT,FIEN,FIND,FNUM,FSEQ,GDATA,GROUP,GSEQ,GTYP
+3 SET FNUM=0
SET FCNT=0
+4 FOR
SET FNUM=$ORDER(FIEV(FNUM))
if 'FNUM
QUIT
Begin DoDot:1
+5 ;Ignore if not found for patient
+6 IF +FIEV(FNUM)=0
QUIT
+7 ;Only terms are counted
+8 SET FIND=$GET(FIEV(FNUM,"TERM IEN"))
if FIND=""
QUIT
+9 ;Check if in list to be accumulated
+10 IF '$DATA(REM(RCNT,FIND))
QUIT
+11 ;Find groups to which finding belongs
+12 SET GSEQ=""
+13 FOR
SET GSEQ=$ORDER(REM(RCNT,FIND,GSEQ))
if GSEQ=""
QUIT
Begin DoDot:2
+14 ;Determine Evaluation type
+15 SET GTYP=REM(RCNT,FIND,GSEQ)
+16 ;Ignore utilization groups
+17 IF GTYP="UR"
QUIT
+18 ;Sequence determines where the finding will be stored
+19 SET FSEQ=""
+20 FOR
SET FSEQ=$ORDER(REM(RCNT,FIND,GSEQ,FSEQ))
if FSEQ=""
QUIT
Begin DoDot:3
+21 ;Evaluation Group logic to save latest entry only
+22 IF GTYP="MRFP"
DO DATE
QUIT
+23 ;Save finding totals
+24 DO UPD(1)
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 ;Check for group totals
+27 SET GSEQ=""
+28 FOR
SET GSEQ=$ORDER(GROUP(GSEQ))
if GSEQ=""
QUIT
Begin DoDot:1
+29 SET GDATA=$GET(GROUP(GSEQ))
if GDATA=""
QUIT
+30 ;Update if found
+31 SET FSEQ=$PIECE(GDATA,U)
DO UPD(1)
End DoDot:1
+32 ;
+33 ;Utilization counts are done separately
+34 NEW CNT,FDATA,FIND,FINDPA,FTIEN,GTYP,TERMARR,TFIEVAL
+35 ;modify start date to include incomplete dates
+36 IF $EXTRACT(PXRMSTRT,6,7)="01"
SET PXRMSTRT=$EXTRACT(PXRMSTRT,1,5)_"00"
+37 ;Include incomplete dates in January
+38 IF $EXTRACT(PXRMSTRT,4,5)="01"
SET PXRMSTRT=$EXTRACT(PXRMSTRT,1,3)_"0000"
+39 ;Set start and stop dates for term
+40 ;S $P(FINDPA(0),U,8)=PXRMSTRT,$P(FINDPA(0),U,11)=PXRMSTOP
+41 SET $PIECE(FINDPA(0),U,11)=PXRMSTOP
+42 ;Count all entries
+43 SET $PIECE(FINDPA(0),U,14)="*"
+44 ;
+45 SET FTIEN=""
SET GTYP="UR"
+46 FOR
SET FTIEN=$ORDER(FUTIL(RCNT,FTIEN))
if FTIEN=""
QUIT
Begin DoDot:1
+47 SET GSEQ=""
+48 FOR
SET GSEQ=$ORDER(FUTIL(RCNT,FTIEN,GSEQ))
if GSEQ=""
QUIT
Begin DoDot:2
+49 SET FSEQ=""
+50 FOR
SET FSEQ=$ORDER(FUTIL(RCNT,FTIEN,GSEQ,FSEQ))
if FSEQ=""
QUIT
Begin DoDot:3
+51 ;Recover list of term findings
+52 KILL TERMARR
MERGE TERMARR=FUTIL(RCNT,FTIEN,GSEQ,FSEQ)
+53 ;Process term
+54 KILL TFIEVAL
DO EVALTERM^PXRMTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
+55 DO URCNT(PXRMSTRT,PXRMSTOP,.TFIEVAL)
End DoDot:3
End DoDot:2
End DoDot:1
+56 ;Determine count from PLIST then add to ETX
+57 ;S CNT=+$O(PLIST(1,999999),-1) Q:'CNT
+58 ;D UPD(CNT)
+59 QUIT
+60 ;
FRULE(FRIEN,RCNT,SEQ,REM,FUTIL) ;Build array of findings in the finding rule
+1 NEW DATA,FIND,FSEQ,GIEN,GNAM,GSEQ,GTYP,GSTA,SUB,TLIST
+2 SET GSEQ=0
+3 FOR
SET GSEQ=$ORDER(^PXRM(810.7,FRIEN,10,"B",GSEQ))
if GSEQ=""
QUIT
Begin DoDot:1
+4 SET SUB=$ORDER(^PXRM(810.7,FRIEN,10,"B",GSEQ,""))
if 'SUB
QUIT
+5 SET DATA=$GET(^PXRM(810.7,FRIEN,10,SUB,0))
if DATA=""
QUIT
+6 ;Get the finding group ien and reminder status
+7 SET GIEN=$PIECE(DATA,U,2)
SET GSTA=$PIECE(DATA,U,3)
if 'GIEN
QUIT
+8 ;If no status then report finding totals for all patients
+9 IF GSTA=""
SET GSTA="T"
+10 ;Get finding group info
+11 SET DATA=$GET(^PXRM(810.8,GIEN,0))
if DATA=""
QUIT
+12 ;Get group name and count type
+13 SET GTYP=$PIECE(DATA,U,3)
SET GNAM=$PIECE(DATA,U)
if GTYP=""
QUIT
+14 ;Save group in workfile
+15 SET ^TMP("PXRMETX1",$JOB,SEQ,RCNT,GSEQ)=GNAM_U_GTYP_U_GSTA
+16 ;Get all findings in group
+17 SET FSEQ=0
+18 FOR
SET FSEQ=$ORDER(^PXRM(810.8,GIEN,10,"B",FSEQ))
if FSEQ=""
QUIT
Begin DoDot:2
+19 SET SUB=$ORDER(^PXRM(810.8,GIEN,10,"B",FSEQ,""))
if 'SUB
QUIT
+20 SET DATA=$GET(^PXRM(810.8,GIEN,10,SUB,0))
if DATA=""
QUIT
+21 ;Get the finding ien and exclusion status
+22 SET FIND=$PIECE(DATA,U,2)
if 'FIND
QUIT
+23 ;Initialize count for finding
+24 SET ^TMP("PXRMETX1",$JOB,SEQ,RCNT,GSEQ,FSEQ)=FIND
+25 ;Reminder evaluation counts work from REM
+26 IF GTYP'="UR"
Begin DoDot:3
+27 SET REM(RCNT,FIND,GSEQ,FSEQ)=""
+28 SET REM(RCNT,FIND,GSEQ)=GTYP
End DoDot:3
QUIT
+29 ;Utilization counts work from FUTIL
+30 DO TERM^PXRMLDR(FIND,.TLIST)
+31 ;Save TLIST
+32 MERGE FUTIL(RCNT,FIND,GSEQ,FSEQ)=TLIST
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
REM(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE) ;Run reminders against patient
+1 ;lists.
+2 NEW APPL,DATA,DEFARR,DEFSITE,DFN,DUE,FIEV,FRIEN,FUTIL,IND,INST
+3 NEW PXRMDATE,RCNT,REM,REMSEQ,RIEN,RNAM,STATUS,SUB1,TODAY
+4 NEW END,START
+5 ;S START=$H
+6 SET TODAY=$$DT^XLFDT
+7 ;Evaluation date is period end except if the period is incomplete
+8 SET PXRMDATE=$SELECT($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
+9 ;Scan reminders for this parameter set
+10 SET (RCNT,SUB1)=0
+11 SET REMSEQ=""
+12 FOR
SET REMSEQ=$ORDER(^PXRM(810.2,IEN,10,SUB,10,"B",REMSEQ))
if REMSEQ=""
QUIT
Begin DoDot:1
+13 FOR
SET SUB1=$ORDER(^PXRM(810.2,IEN,10,SUB,10,"B",REMSEQ,SUB1))
if 'SUB1
QUIT
Begin DoDot:2
+14 SET DATA=$GET(^PXRM(810.2,IEN,10,SUB,10,SUB1,0))
if DATA=""
QUIT
+15 ;Reminder ien
+16 SET RIEN=$PIECE(DATA,U,2)
if 'RIEN
QUIT
+17 ;Evaluation date is period end except if the period is incomplete.
+18 SET PXRMDATE=$SELECT($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
+19 ;Finding Rule
+20 SET FRIEN=$PIECE(DATA,U,3)
+21 ;Reminder print name
+22 SET RNAM=$PIECE($GET(^PXD(811.9,RIEN,0)),U,3)
+23 IF RNAM=""
SET RNAM=$PIECE(^PXD(811.9,RIEN,0),U,1)
+24 ;Save details to REM array
+25 SET RCNT=RCNT+1
SET REM(RCNT)=RIEN_U_RNAM_U_FRIEN
+26 ;Build list of terms from extract finding rule #810.7
+27 IF FRIEN
DO FRULE(FRIEN,RCNT,SEQ,.REM,.FUTIL)
QUIT
+28 ;If no extract finding rule defined collect all findings in reminder
+29 IF 'FRIEN
DO REMF(RIEN,RCNT,SEQ,.REM)
End DoDot:2
End DoDot:1
+30 ;
+31 ;Process patient list
+32 SET IND=0
SET DEFSITE=+$PIECE($$SITE^VASITE,U,3)
+33 FOR
SET IND=$ORDER(^PXRMXP(810.5,PXRMLIST,30,IND))
if 'IND
QUIT
Begin DoDot:1
+34 SET DFN=$PIECE($GET(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U)
if 'DFN
QUIT
+35 SET INST=$PIECE($GET(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U,2)
+36 IF INST=""
SET INST=DEFSITE
+37 SET RCNT=0
+38 FOR
SET RCNT=$ORDER(REM(RCNT))
if 'RCNT
QUIT
Begin DoDot:2
+39 SET RIEN=$PIECE(REM(RCNT),U)
SET RNAM=$PIECE(REM(RCNT),U,2)
SET FRIEN=$PIECE(REM(RCNT),U,3)
+40 ;Clear evaluation arrays.
+41 KILL ^TMP("PXRHM",$JOB),^TMP("PXRMID",$JOB),FIEV
+42 ;Evaluate reminders and store results
+43 DO DEF^PXRMLDR(RIEN,.DEFARR)
+44 DO EVAL^PXRM(DFN,.DEFARR,1,1,.FIEV,PXRMDATE)
+45 ;Determine update from reminder status
+46 SET STATUS=$PIECE($GET(^TMP("PXRHM",$JOB,RIEN,RNAM)),U)
IF STATUS=""
QUIT
+47 ;Ignore not applicables
+48 SET APPL=$SELECT(STATUS["DUE":1,STATUS="RESOLVED":1,STATUS="DONE":1,1:0)
+49 ;Check if due
+50 SET DUE=$SELECT(STATUS="DUE NOW":1,1:0)
+51 ;Compliance totals
+52 SET DATA=$GET(^TMP("PXRMETX",$JOB,SEQ,INST,RCNT))
+53 ;Reminder ien
+54 IF $PIECE(DATA,U)=""
SET $PIECE(DATA,U)=RIEN
+55 ;Evaluated total
+56 SET $PIECE(DATA,U,2)=$PIECE(DATA,U,2)+1
+57 ;Applicable total
+58 SET $PIECE(DATA,U,3)=$PIECE(DATA,U,3)+APPL
+59 ;Not applicable total
+60 IF 'APPL
IF 'DUE
SET $PIECE(DATA,U,4)=$PIECE(DATA,U,4)+1
+61 ;Due total
+62 SET $PIECE(DATA,U,5)=$PIECE(DATA,U,5)+DUE
+63 ;Not due count
+64 IF APPL
IF 'DUE
SET $PIECE(DATA,U,6)=$PIECE(DATA,U,6)+1
+65 ;Add patient list
+66 IF $PIECE(DATA,U,7)=""
SET $PIECE(DATA,U,7)=PXRMLIST
+67 ;Update workfile
+68 SET ^TMP("PXRMETX",$JOB,SEQ,INST,RCNT)=DATA
+69 ;Save finding totals
+70 IF PARTYPE="CF"
DO FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP)
End DoDot:2
End DoDot:1
+71 ;Clear evaluation fields
+72 KILL ^TMP("PXRHM",$JOB),^TMP("PXRMID",$JOB)
+73 ;S END=$H
+74 ;W !,"REMINDER EVALUATION TIME"
+75 ;D DETIME^PXRMXSEL(START,END)
+76 QUIT
+77 ;
REMF(RIEN,RCNT,SEQ,REM) ;Build array of all findings in the reminder
+1 NEW GNAM,GSEQ,FIND,FSEQ,GTYP,SUB
+2 SET GNAM="Finding totals"
SET GSEQ="001"
SET FSEQ=0
SET GTYP="MRF"
+3 ;Save group name
+4 SET ^TMP("PXRMETX",$JOB,SEQ,RCNT,GSEQ)=GNAM_U_GTYP
+5 ;Select all findings in the reminder
+6 SET SUB=0
+7 FOR
SET SUB=$ORDER(^PXD(811.9,RIEN,20,SUB))
if 'SUB
QUIT
Begin DoDot:1
+8 ;Ignore if finding is not a term
+9 SET FIND=$PIECE($GET(^PXD(811.9,RIEN,20,SUB,0)),U)
if FIND'["PXRMD(811.5"
QUIT
+10 ;Convert to term ien
+11 SET FIND=$PIECE(FIND,";")
+12 ;Build sequence number
+13 SET FSEQ=FSEQ+1
SET FSEQ=$$RJ^XLFSTR(FSEQ,3,0)
+14 ;Evaluation counts
+15 SET REM(RCNT,FIND,GSEQ,FSEQ)=""
+16 SET REM(RCNT,FIND,GSEQ)=GTYP
+17 ;Update Workfile
+18 SET ^TMP("PXRMETX1",$JOB,SEQ,RCNT,GSEQ,FSEQ)=FIND
End DoDot:1
+19 QUIT
+20 ;
URCNT(PXRMSTRT,PXRMSTOP,TFIEVAL) ;
+1 ;Handle counting all valid occurrences for the finding items.
+2 ;Includes historical entries that were entered within the reporting
+3 ;period, cut the encounter date if it is outside the reporting period.
+4 NEW CNT,DATEENT,FDATE,FILE,FNUM,FOCCNUM,HIST,NODE,SCAT,VIEN
+5 SET CNT=0
SET FNUM=0
+6 FOR
SET FNUM=$ORDER(TFIEVAL(FNUM))
if FNUM'>0
QUIT
Begin DoDot:1
+7 SET FILE=$GET(TFIEVAL(FNUM,"FILE NUMBER"))
+8 SET HIST=$SELECT(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)
+9 SET FOCCNUM=0
FOR
SET FOCCNUM=$ORDER(TFIEVAL(FNUM,FOCCNUM))
if FOCCNUM'>0
QUIT
Begin DoDot:2
+10 SET FDATE=$PIECE(TFIEVAL(FNUM,FOCCNUM,"DATE"),".")
if FDATE'>0
QUIT
+11 IF HIST=0
IF FDATE=PXRMSTRT!(FDATE>PXRMSTRT)
SET CNT=CNT+1
+12 IF HIST=1
Begin DoDot:3
+13 SET VIEN=TFIEVAL(FNUM,FOCCNUM,"VISIT")
if VIEN'>0
QUIT
+14 SET NODE=$GET(^AUPNVSIT(VIEN,0))
+15 SET SCAT=$PIECE(NODE,U,7)
SET DATEENT=$PIECE($PIECE(NODE,U,2),".")
+16 IF FDATE=PXRMSTRT!(FDATE>PXRMSTRT)
IF SCAT'="E"
SET CNT=CNT+1
QUIT
+17 IF SCAT="E"
IF (DATEENT=PXRMSTRT!(DATEENT>PXRMSTRT))&(DATEENT=PXRMSTOP!(DATEENT<PXRMSTOP))
SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+18 DO UPD(CNT)
+19 QUIT
+20 ;
UPD(CNT) ;Update totals
+1 SET DATA=$GET(^TMP("PXRMETX",$JOB,SEQ,INST,RCNT,GSEQ,FSEQ))
+2 ;Total count
+3 SET $PIECE(DATA,U,2)=$PIECE(DATA,U,2)+CNT
+4 ;Applicable count
+5 SET $PIECE(DATA,U,3)=$PIECE(DATA,U,3)+(APPL*CNT)
+6 ;Not applicable count
+7 IF 'APPL
IF 'DUE
SET $PIECE(DATA,U,4)=$PIECE(DATA,U,4)+CNT
+8 ;Due count
+9 SET $PIECE(DATA,U,5)=$PIECE(DATA,U,5)+(DUE*CNT)
+10 ;Not due count
+11 IF APPL
IF 'DUE
SET $PIECE(DATA,U,6)=$PIECE(DATA,U,6)+CNT
+12 ;Update current count
+13 SET ^TMP("PXRMETX",$JOB,SEQ,INST,RCNT,GSEQ,FSEQ)=DATA
+14 ;AGP REMOVE UNTIL A DECISION CAN BE MADE
+15 ;I CNT=1,APPL=1 S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)=DFN
+16 QUIT
+17 ;
