- 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 Jan 18, 2025@02:45:57 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 ;