Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMETXR

PXRMETXR.m

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