Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETXR.m

    r613 r623  
    1 PXRMETXR        ; SLC/PJH,PKR - Reminder section of extract ;02/22/2007
    2         ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
    3         ;
    4         ; Called from PXRMETX
    5         ;
    6 DATE    ;Check if finding is most recent in evaluation group
    7         N FDATE,GDATE
    8         ;Determine finding date and existing group date
    9         S FDATE=$G(FIEV(FNUM,"DATE")),GDATE=$G(GROUP(GSEQ,"DATE")) Q:FDATE=""
    10         ;Ignore findings outside to the extract period
    11         ;I $$FMDIFF^XLFDT(PXRMSTRT,FDATE,2)>0 Q
    12         ;If this is first or only entry in group then save finding date
    13         I 'GDATE S GROUP(GSEQ,"DATE")=FDATE,GROUP(GSEQ)=FSEQ Q
    14         ;Save finding if most recent date for the group
    15         I $$FMDIFF^XLFDT(FDATE,GDATE,2)>0 S GROUP(GSEQ,"DATE")=FDATE,GROUP(GSEQ)=FSEQ Q
    16         Q
    17         ;
    18 FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP)        ;Process findings for reminder
    19         ;Default is extract no findings
    20         N DATA,FCNT,FIEN,FIND,FNUM,FSEQ,GDATA,GROUP,GSEQ,GTYP
    21         S FNUM=0,FCNT=0
    22         F  S FNUM=$O(FIEV(FNUM)) Q:'FNUM  D
    23         .;Ignore if not found for patient
    24         .I +FIEV(FNUM)=0 Q
    25         .;Only terms are counted
    26         .S FIND=$G(FIEV(FNUM,"TERM IEN")) Q:FIND=""
    27         .;Check if in list to be accumulated
    28         .I '$D(REM(RCNT,FIND)) Q
    29         .;Find groups to which finding belongs
    30         .S GSEQ=""
    31         .F  S GSEQ=$O(REM(RCNT,FIND,GSEQ)) Q:GSEQ=""  D
    32         ..;Determine Evaluation type
    33         ..S GTYP=REM(RCNT,FIND,GSEQ)
    34         ..;Ignore utilization groups
    35         ..I GTYP="UR" Q
    36         ..;Sequence determines where the finding will be stored
    37         ..S FSEQ=""
    38         ..F  S FSEQ=$O(REM(RCNT,FIND,GSEQ,FSEQ)) Q:FSEQ=""  D
    39         ...;Evaluation Group logic to save latest entry only
    40         ...I GTYP="MRFP" D DATE Q
    41         ...;Save finding totals
    42         ...D UPD(1)
    43         ;
    44         ;Check for group totals
    45         S GSEQ=""
    46         F  S GSEQ=$O(GROUP(GSEQ)) Q:GSEQ=""  D
    47         .S GDATA=$G(GROUP(GSEQ)) Q:GDATA=""
    48         .;Update if found
    49         .S FSEQ=$P(GDATA,U) D UPD(1)
    50         ;
    51         ;Utilization counts are done separately
    52         N CNT,FDATA,FIND,FINDPA,FTIEN,GTYP,TERMARR,TFIEVAL
    53         ;modify start date to include incomplete dates
    54         I $E(PXRMSTRT,6,7)="01" S PXRMSTRT=$E(PXRMSTRT,1,5)_"00"
    55         ;Include incomplete dates in January
    56         I $E(PXRMSTRT,4,5)="01" S PXRMSTRT=$E(PXRMSTRT,1,3)_"0000"
    57         ;Set start and stop dates for term
    58         ;S $P(FINDPA(0),U,8)=PXRMSTRT,$P(FINDPA(0),U,11)=PXRMSTOP
    59         S $P(FINDPA(0),U,11)=PXRMSTOP
    60         ;Count all entries
    61         S $P(FINDPA(0),U,14)="*"
    62         ;
    63         S FTIEN="",GTYP="UR"
    64         F  S FTIEN=$O(FUTIL(RCNT,FTIEN)) Q:FTIEN=""  D
    65         .S GSEQ=""
    66         .F  S GSEQ=$O(FUTIL(RCNT,FTIEN,GSEQ)) Q:GSEQ=""  D
    67         ..S FSEQ=""
    68         ..F  S FSEQ=$O(FUTIL(RCNT,FTIEN,GSEQ,FSEQ)) Q:FSEQ=""  D
    69         ...;Recover list of term findings
    70         ...K TERMARR M TERMARR=FUTIL(RCNT,FTIEN,GSEQ,FSEQ)
    71         ...;Process term
    72         ...K TFIEVAL D EVALTERM^PXRMTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
    73         ...D URCNT(PXRMSTRT,PXRMSTOP,.TFIEVAL)
    74         ;Determine count from PLIST then add to ETX
    75         ;S CNT=+$O(PLIST(1,999999),-1) Q:'CNT
    76         ;D UPD(CNT)
    77         Q
    78         ;
    79 FRULE(FRIEN,RCNT,SEQ,REM,FUTIL) ;Build array of findings in the finding rule
    80         N DATA,FIND,FSEQ,GIEN,GNAM,GSEQ,GTYP,GSTA,SUB,TLIST
    81         S GSEQ=0
    82         F  S GSEQ=$O(^PXRM(810.7,FRIEN,10,"B",GSEQ)) Q:GSEQ=""  D
    83         .S SUB=$O(^PXRM(810.7,FRIEN,10,"B",GSEQ,"")) Q:'SUB
    84         .S DATA=$G(^PXRM(810.7,FRIEN,10,SUB,0)) Q:DATA=""
    85         .;Get the finding group ien and reminder status
    86         .S GIEN=$P(DATA,U,2),GSTA=$P(DATA,U,3) Q:'GIEN
    87         .;If no status then report finding totals for all patients
    88         .I GSTA="" S GSTA="T"
    89         .;Get finding group info
    90         .S DATA=$G(^PXRM(810.8,GIEN,0)) Q:DATA=""
    91         .;Get group name and count type
    92         .S GTYP=$P(DATA,U,3),GNAM=$P(DATA,U) Q:GTYP=""
    93         .;Save group in workfile
    94         .S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ)=GNAM_U_GTYP_U_GSTA
    95         .;Get all findings in group
    96         .S FSEQ=0
    97         .F  S FSEQ=$O(^PXRM(810.8,GIEN,10,"B",FSEQ)) Q:FSEQ=""  D
    98         ..S SUB=$O(^PXRM(810.8,GIEN,10,"B",FSEQ,"")) Q:'SUB
    99         ..S DATA=$G(^PXRM(810.8,GIEN,10,SUB,0)) Q:DATA=""
    100         ..;Get the finding ien and exclusion status
    101         ..S FIND=$P(DATA,U,2) Q:'FIND
    102         ..;Initialize count for finding
    103         ..S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)=FIND
    104         ..;Reminder evaluation counts work from REM
    105         ..I GTYP'="UR" D  Q
    106         ...S REM(RCNT,FIND,GSEQ,FSEQ)=""
    107         ...S REM(RCNT,FIND,GSEQ)=GTYP
    108         ..;Utilization counts work from FUTIL
    109         ..D TERM^PXRMLDR(FIND,.TLIST)
    110         ..;Save TLIST
    111         ..M FUTIL(RCNT,FIND,GSEQ,FSEQ)=TLIST
    112         Q
    113         ;
    114 REM(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE)     ;Run reminders against patient
    115         ;lists.
    116         N APPL,DATA,DEFARR,DEFSITE,DFN,DUE,FIEV,FRIEN,FUTIL,IND,INST
    117         N PXRMDATE,RCNT,REM,REMSEQ,RIEN,RNAM,STATUS,SUB1,TODAY
    118         N END,START
    119         ;S START=$H
    120         S TODAY=$$DT^XLFDT
    121         ;Evaluation date is period end except if the period is incomplete
    122         S PXRMDATE=$S($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
    123         ;Scan reminders for this parameter set
    124         S (RCNT,SUB1)=0
    125         S REMSEQ=""
    126         F  S REMSEQ=$O(^PXRM(810.2,IEN,10,SUB,10,"B",REMSEQ)) Q:REMSEQ=""  D
    127         .F  S SUB1=$O(^PXRM(810.2,IEN,10,SUB,10,"B",REMSEQ,SUB1)) Q:'SUB1  D
    128         ..S DATA=$G(^PXRM(810.2,IEN,10,SUB,10,SUB1,0)) Q:DATA=""
    129         ..;Reminder ien
    130         ..S RIEN=$P(DATA,U,2) Q:'RIEN
    131         ..;Evaluation date is period end except if the period is incomplete.
    132         ..S PXRMDATE=$S($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
    133         ..;Finding Rule
    134         ..S FRIEN=$P(DATA,U,3)
    135         ..;Reminder print name
    136         ..S RNAM=$P($G(^PXD(811.9,RIEN,0)),U,3)
    137         ..I RNAM="" S RNAM=$P(^PXD(811.9,RIEN,0),U,1)
    138         ..;Save details to REM array
    139         ..S RCNT=RCNT+1,REM(RCNT)=RIEN_U_RNAM_U_FRIEN
    140         ..;Build list of terms from extract finding rule #810.7
    141         ..I FRIEN D FRULE(FRIEN,RCNT,SEQ,.REM,.FUTIL) Q
    142         ..;If no extract finding rule defined collect all findings in reminder
    143         ..I 'FRIEN D REMF(RIEN,RCNT,SEQ,.REM)
    144         ;
    145         ;Process patient list
    146         S IND=0,DEFSITE=+$P($$SITE^VASITE,U,3)
    147         F  S IND=$O(^PXRMXP(810.5,PXRMLIST,30,IND)) Q:'IND  D
    148         .S DFN=$P($G(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U) Q:'DFN
    149         .S INST=$P($G(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U,2)
    150         .I INST="" S INST=DEFSITE
    151         .S RCNT=0
    152         .F  S RCNT=$O(REM(RCNT)) Q:'RCNT  D
    153         ..S RIEN=$P(REM(RCNT),U),RNAM=$P(REM(RCNT),U,2),FRIEN=$P(REM(RCNT),U,3)
    154         ..;Clear evaluation arrays.
    155         ..K ^TMP("PXRHM",$J),^TMP("PXRMID",$J),FIEV
    156         ..;Evaluate reminders and store results
    157         ..D DEF^PXRMLDR(RIEN,.DEFARR)
    158         ..D EVAL^PXRM(DFN,.DEFARR,1,1,.FIEV,PXRMDATE)
    159         ..;Determine update from reminder status
    160         ..S STATUS=$P($G(^TMP("PXRHM",$J,RIEN,RNAM)),U) I STATUS="" Q
    161         ..;Ignore not applicables
    162         ..S APPL=$S(STATUS["DUE":1,STATUS="RESOLVED":1,STATUS="DONE":1,1:0)
    163         ..;Check if due
    164         ..S DUE=$S(STATUS="DUE NOW":1,1:0)
    165         ..;Compliance totals
    166         ..S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT))
    167         ..;Reminder ien
    168         ..I $P(DATA,U)="" S $P(DATA,U)=RIEN
    169         ..;Evaluated total
    170         ..S $P(DATA,U,2)=$P(DATA,U,2)+1
    171         ..;Applicable total
    172         ..S $P(DATA,U,3)=$P(DATA,U,3)+APPL
    173         ..;Not applicable total
    174         ..I 'APPL,'DUE S $P(DATA,U,4)=$P(DATA,U,4)+1
    175         ..;Due total
    176         ..S $P(DATA,U,5)=$P(DATA,U,5)+DUE
    177         ..;Not due count
    178         ..I APPL,'DUE S $P(DATA,U,6)=$P(DATA,U,6)+1
    179         ..;Add patient list
    180         ..I $P(DATA,U,7)="" S $P(DATA,U,7)=PXRMLIST
    181         ..;Update workfile
    182         ..S ^TMP("PXRMETX",$J,SEQ,INST,RCNT)=DATA
    183         ..;Save finding totals
    184         ..I PARTYPE="CF" D FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP)
    185         ;Clear evaluation fields
    186         K ^TMP("PXRHM",$J),^TMP("PXRMID",$J)
    187         ;S END=$H
    188         ;W !,"REMINDER EVALUATION TIME"
    189         ;D DETIME^PXRMXSEL(START,END)
    190         Q
    191         ;
    192 REMF(RIEN,RCNT,SEQ,REM) ;Build array of all findings in the reminder
    193         N GNAM,GSEQ,FIND,FSEQ,GTYP,SUB
    194         S GNAM="Finding totals",GSEQ="001",FSEQ=0,GTYP="MRF"
    195         ;Save group name
    196         S ^TMP("PXRMETX",$J,SEQ,RCNT,GSEQ)=GNAM_U_GTYP
    197         ;Select all findings in the reminder
    198         S SUB=0
    199         F  S SUB=$O(^PXD(811.9,RIEN,20,SUB)) Q:'SUB  D
    200         .;Ignore if finding is not a term
    201         .S FIND=$P($G(^PXD(811.9,RIEN,20,SUB,0)),U) Q:FIND'["PXRMD(811.5"
    202         .;Convert to term ien
    203         .S FIND=$P(FIND,";")
    204         .;Build sequence number
    205         .S FSEQ=FSEQ+1,FSEQ=$$RJ^XLFSTR(FSEQ,3,0)
    206         .;Evaluation counts
    207         .S REM(RCNT,FIND,GSEQ,FSEQ)=""
    208         .S REM(RCNT,FIND,GSEQ)=GTYP
    209         .;Update Workfile
    210         .S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)=FIND
    211         Q
    212         ;
    213 URCNT(PXRMSTRT,PXRMSTOP,TFIEVAL)        ;
    214         ;Handle counting all valid occurrences for the finding items.
    215         ;Includes historical entries that were entered within the reporting
    216         ;period, cut the encounter date if it is outside the reporting period.
    217         N CNT,DATEENT,FDATE,FILE,FNUM,FOCCNUM,HIST,NODE,SCAT,VIEN
    218         S CNT=0,FNUM=0
    219         F  S FNUM=$O(TFIEVAL(FNUM)) Q:FNUM'>0  D
    220         .S FILE=$G(TFIEVAL(FNUM,"FILE NUMBER"))
    221         .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)
    222         .S FOCCNUM=0 F  S FOCCNUM=$O(TFIEVAL(FNUM,FOCCNUM)) Q:FOCCNUM'>0  D
    223         ..S FDATE=$P(TFIEVAL(FNUM,FOCCNUM,"DATE"),".") Q:FDATE'>0
    224         ..I HIST=0,FDATE=PXRMSTRT!(FDATE>PXRMSTRT) S CNT=CNT+1
    225         ..I HIST=1 D
    226         ...S VIEN=TFIEVAL(FNUM,FOCCNUM,"VISIT") Q:VIEN'>0
    227         ...S NODE=$G(^AUPNVSIT(VIEN,0))
    228         ...S SCAT=$P(NODE,U,7),DATEENT=$P($P(NODE,U,2),".")
    229         ...I FDATE=PXRMSTRT!(FDATE>PXRMSTRT),SCAT'="E" S CNT=CNT+1 Q
    230         ...I SCAT="E",(DATEENT=PXRMSTRT!(DATEENT>PXRMSTRT))&(DATEENT=PXRMSTOP!(DATEENT<PXRMSTOP)) S CNT=CNT+1
    231         D UPD(CNT)
    232         Q
    233         ;
    234 UPD(CNT)        ;Update totals
    235         S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ))
    236         ;Total count
    237         S $P(DATA,U,2)=$P(DATA,U,2)+CNT
    238         ;Applicable count
    239         S $P(DATA,U,3)=$P(DATA,U,3)+(APPL*CNT)
    240         ;Not applicable count
    241         I 'APPL,'DUE S $P(DATA,U,4)=$P(DATA,U,4)+CNT
    242         ;Due count
    243         S $P(DATA,U,5)=$P(DATA,U,5)+(DUE*CNT)
    244         ;Not due count
    245         I APPL,'DUE S $P(DATA,U,6)=$P(DATA,U,6)+CNT
    246         ;Update current count
    247         S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ)=DATA
    248         ;AGP REMOVE UNTIL A DECISION CAN BE MADE
    249         ;I CNT=1,APPL=1 S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)=DFN
    250         Q
    251         ;
     1PXRMETXR ; SLC/PJH,PKR - Reminder section of extract ;05/01/2006
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
     3 ;
     4 ; Called from PXRMETX
     5 ;
     6DATE ;Check if finding is most recent in evaluation group
     7 N FDATE,GDATE
     8 ;Determine finding date and existing group date
     9 S FDATE=$G(FIEV(FNUM,"DATE")),GDATE=$G(GROUP(GSEQ,"DATE")) Q:FDATE=""
     10 ;Ignore findings outside to the extract period
     11 ;I $$FMDIFF^XLFDT(PXRMSTRT,FDATE,2)>0 Q
     12 ;If this is first or only entry in group then save finding date
     13 I 'GDATE S GROUP(GSEQ,"DATE")=FDATE,GROUP(GSEQ)=FSEQ Q
     14 ;Save finding if most recent date for the group
     15 I $$FMDIFF^XLFDT(FDATE,GDATE,2)>0 S GROUP(GSEQ,"DATE")=FDATE,GROUP(GSEQ)=FSEQ Q
     16 Q
     17 ;
     18FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP) ;Process findings for reminder
     19 ;Default is extract no findings
     20 N DATA,FCNT,FIEN,FIND,FNUM,FSEQ,GDATA,GROUP,GSEQ,GTYP
     21 S FNUM=0,FCNT=0
     22 F  S FNUM=$O(FIEV(FNUM)) Q:'FNUM  D
     23 .;Ignore if not found for patient
     24 .I +FIEV(FNUM)=0 Q
     25 .;Only terms are counted
     26 .S FIND=$G(FIEV(FNUM,"TERM IEN")) Q:FIND=""
     27 .;Check if in list to be accumulated
     28 .I '$D(REM(RCNT,FIND)) Q
     29 .;Find groups to which finding belongs
     30 .S GSEQ=""
     31 .F  S GSEQ=$O(REM(RCNT,FIND,GSEQ)) Q:GSEQ=""  D
     32 ..;Determine Evaluation type
     33 ..S GTYP=REM(RCNT,FIND,GSEQ)
     34 ..;Ignore utilization groups
     35 ..I GTYP="UR" Q
     36 ..;Sequence determines where the finding will be stored
     37 ..S FSEQ=""
     38 ..F  S FSEQ=$O(REM(RCNT,FIND,GSEQ,FSEQ)) Q:FSEQ=""  D
     39 ...;Evaluation Group logic to save latest entry only
     40 ...I GTYP="MRFP" D DATE Q
     41 ...;Save finding totals
     42 ...D UPD(1)
     43 ;
     44 ;Check for group totals
     45 S GSEQ=""
     46 F  S GSEQ=$O(GROUP(GSEQ)) Q:GSEQ=""  D
     47 .S GDATA=$G(GROUP(GSEQ)) Q:GDATA=""
     48 .;Update if found
     49 .S FSEQ=$P(GDATA,U) D UPD(1)
     50 ;
     51 ;Utilization counts are done separately
     52 N CNT,FDATA,FIND,FINDPA,FTIEN,GTYP,TERMARR,TFIEVAL
     53 ;modify start date to include incomplete dates
     54 I $E(PXRMSTRT,6,7)="01" S PXRMSTRT=$E(PXRMSTRT,1,5)_"00"
     55 ;Include incomplete dates in January
     56 I $E(PXRMSTRT,4,5)="01" S PXRMSTRT=$E(PXRMSTRT,1,3)_"0000"
     57 ;Set start and stop dates for term
     58 ;S $P(FINDPA(0),U,8)=PXRMSTRT,$P(FINDPA(0),U,11)=PXRMSTOP
     59 S $P(FINDPA(0),U,11)=PXRMSTOP
     60 ;Count all entries
     61 S $P(FINDPA(0),U,14)="*"
     62 ;
     63 S FTIEN="",GTYP="UR"
     64 F  S FTIEN=$O(FUTIL(RCNT,FTIEN)) Q:FTIEN=""  D
     65 .S GSEQ=""
     66 .F  S GSEQ=$O(FUTIL(RCNT,FTIEN,GSEQ)) Q:GSEQ=""  D
     67 ..S FSEQ=""
     68 ..F  S FSEQ=$O(FUTIL(RCNT,FTIEN,GSEQ,FSEQ)) Q:FSEQ=""  D
     69 ...;Recover list of term findings
     70 ...K TERMARR M TERMARR=FUTIL(RCNT,FTIEN,GSEQ,FSEQ)
     71 ...;Process term
     72 ...K TFIEVAL D EVALTERM^PXRMTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
     73 ...D URCNT(PXRMSTRT,PXRMSTOP,.TFIEVAL)
     74 ;Determine count from PLIST then add to ETX
     75 ;S CNT=+$O(PLIST(1,999999),-1) Q:'CNT
     76 ;D UPD(CNT)
     77 Q
     78 ;
     79FRULE(FRIEN,RCNT,SEQ,REM,FUTIL) ;Build array of findings in the finding rule
     80 N DATA,FIND,FSEQ,GIEN,GNAM,GSEQ,GTYP,GSTA,SUB,TLIST
     81 S GSEQ=0
     82 F  S GSEQ=$O(^PXRM(810.7,FRIEN,10,"B",GSEQ)) Q:GSEQ=""  D
     83 .S SUB=$O(^PXRM(810.7,FRIEN,10,"B",GSEQ,"")) Q:'SUB
     84 .S DATA=$G(^PXRM(810.7,FRIEN,10,SUB,0)) Q:DATA=""
     85 .;Get the finding group ien and reminder status
     86 .S GIEN=$P(DATA,U,2),GSTA=$P(DATA,U,3) Q:'GIEN
     87 .;If no status then report finding totals for all patients
     88 .I GSTA="" S GSTA="T"
     89 .;Get finding group info
     90 .S DATA=$G(^PXRM(810.8,GIEN,0)) Q:DATA=""
     91 .;Get group name and count type
     92 .S GTYP=$P(DATA,U,3),GNAM=$P(DATA,U) Q:GTYP=""
     93 .;Save group in workfile
     94 .S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ)=GNAM_U_GTYP_U_GSTA
     95 .;Get all findings in group
     96 .S FSEQ=0
     97 .F  S FSEQ=$O(^PXRM(810.8,GIEN,10,"B",FSEQ)) Q:FSEQ=""  D
     98 ..S SUB=$O(^PXRM(810.8,GIEN,10,"B",FSEQ,"")) Q:'SUB
     99 ..S DATA=$G(^PXRM(810.8,GIEN,10,SUB,0)) Q:DATA=""
     100 ..;Get the finding ien and exclusion status
     101 ..S FIND=$P(DATA,U,2) Q:'FIND
     102 ..;Initialize count for finding
     103 ..S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)=FIND
     104 ..;Reminder evaluation counts work from REM
     105 ..I GTYP'="UR" D  Q
     106 ...S REM(RCNT,FIND,GSEQ,FSEQ)=""
     107 ...S REM(RCNT,FIND,GSEQ)=GTYP
     108 ..;Utilization counts work from FUTIL
     109 ..D TERM^PXRMLDR(FIND,.TLIST)
     110 ..;Save TLIST
     111 ..M FUTIL(RCNT,FIND,GSEQ,FSEQ)=TLIST
     112 Q
     113 ;
     114REM(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE) ;Run reminders against patient
     115 ;lists.
     116 N APPL,DATA,DEFARR,DEFSITE,DFN,DUE,FIEV,FRIEN,FUTIL,IND,INST
     117 N PXRMDATE,RCNT,REM,RIEN,RNAM,STATUS,SUB1,TODAY
     118 N END,START
     119 ;S START=$H
     120 S TODAY=$$DT^XLFDT
     121 ;Evaluation date is period end except if the period is incomplete
     122 S PXRMDATE=$S($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
     123 ;Scan reminders for this parameter set
     124 S (RCNT,SUB1)=0
     125 F  S SUB1=$O(^PXRM(810.2,IEN,10,SUB,10,SUB1)) Q:'SUB1  D
     126 .S DATA=$G(^PXRM(810.2,IEN,10,SUB,10,SUB1,0)) Q:DATA=""
     127 .;Reminder ien
     128 .S RIEN=$P(DATA,U,2) Q:'RIEN
     129 .;Evaluation date is period end except if the period is incomplete.
     130 .S PXRMDATE=$S($$FMDIFF^XLFDT(PXRMSTOP,TODAY,2)>0:TODAY,1:PXRMSTOP)
     131 .;Finding Rule
     132 .S FRIEN=$P(DATA,U,3)
     133 .;Reminder print name
     134 .S RNAM=$P($G(^PXD(811.9,RIEN,0)),U,3)
     135 .;Save details to REM array
     136 .S RCNT=RCNT+1,REM(RCNT)=RIEN_U_RNAM_U_FRIEN
     137 .;Build list of terms from extract finding rule #810.7
     138 .I FRIEN D FRULE(FRIEN,RCNT,SEQ,.REM,.FUTIL) Q
     139 .;If no extract finding rule defined collect all findings in reminder
     140 .I 'FRIEN D REMF(RIEN,RCNT,SEQ,.REM)
     141 ;
     142 ;Process patient list
     143 S IND=0,DEFSITE=+$P($$SITE^VASITE,U,3)
     144 F  S IND=$O(^PXRMXP(810.5,PXRMLIST,30,IND)) Q:'IND  D
     145 .S DFN=$P($G(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U) Q:'DFN
     146 .S INST=$P($G(^PXRMXP(810.5,PXRMLIST,30,IND,0)),U,2)
     147 .I INST="" S INST=DEFSITE
     148 .S RCNT=0
     149 .F  S RCNT=$O(REM(RCNT)) Q:'RCNT  D
     150 ..S RIEN=$P(REM(RCNT),U),RNAM=$P(REM(RCNT),U,2),FRIEN=$P(REM(RCNT),U,3)
     151 ..;Clear evaluation arrays.
     152 ..K ^TMP("PXRHM",$J),^TMP("PXRMID",$J),FIEV
     153 ..;Evaluate reminders and store results
     154 ..D DEF^PXRMLDR(RIEN,.DEFARR)
     155 ..D EVAL^PXRM(DFN,.DEFARR,1,1,.FIEV,PXRMDATE)
     156 ..;Determine update from reminder status
     157 ..S STATUS=$P($G(^TMP("PXRHM",$J,RIEN,RNAM)),U) I STATUS="" Q
     158 ..;Ignore not applicables
     159 ..S APPL=$S(STATUS["DUE":1,STATUS="RESOLVED":1,STATUS="DONE":1,1:0)
     160 ..;Check if due
     161 ..S DUE=$S(STATUS="DUE NOW":1,1:0)
     162 ..;Compliance totals
     163 ..S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT))
     164 ..;Reminder ien
     165 ..I $P(DATA,U)="" S $P(DATA,U)=RIEN
     166 ..;Evaluated total
     167 ..S $P(DATA,U,2)=$P(DATA,U,2)+1
     168 ..;Applicable total
     169 ..S $P(DATA,U,3)=$P(DATA,U,3)+APPL
     170 ..;Not applicable total
     171 ..I 'APPL,'DUE S $P(DATA,U,4)=$P(DATA,U,4)+1
     172 ..;Due total
     173 ..S $P(DATA,U,5)=$P(DATA,U,5)+DUE
     174 ..;Not due count
     175 ..I APPL,'DUE S $P(DATA,U,6)=$P(DATA,U,6)+1
     176 ..;Add patient list
     177 ..I $P(DATA,U,7)="" S $P(DATA,U,7)=PXRMLIST
     178 ..;Update workfile
     179 ..S ^TMP("PXRMETX",$J,SEQ,INST,RCNT)=DATA
     180 ..;Save finding totals
     181 ..I PARTYPE="CF" D FIND(SEQ,RCNT,PXRMSTRT,PXRMSTOP)
     182 ;Clear evaluation fields
     183 K ^TMP("PXRHM",$J),^TMP("PXRMID",$J)
     184 ;S END=$H
     185 ;W !,"REMINDER EVALUATION TIME"
     186 ;D DETIME^PXRMXSEL(START,END)
     187 Q
     188 ;
     189REMF(RIEN,RCNT,SEQ,REM) ;Build array of all findings in the reminder
     190 N GNAM,GSEQ,FIND,FSEQ,GTYP,SUB
     191 S GNAM="Finding totals",GSEQ="001",FSEQ=0,GTYP="MRF"
     192 ;Save group name
     193 S ^TMP("PXRMETX",$J,SEQ,RCNT,GSEQ)=GNAM_U_GTYP
     194 ;Select all findings in the reminder
     195 S SUB=0
     196 F  S SUB=$O(^PXD(811.9,RIEN,20,SUB)) Q:'SUB  D
     197 .;Ignore if finding is not a term
     198 .S FIND=$P($G(^PXD(811.9,RIEN,20,SUB,0)),U) Q:FIND'["PXRMD(811.5"
     199 .;Convert to term ien
     200 .S FIND=$P(FIND,";")
     201 .;Build sequence number
     202 .S FSEQ=FSEQ+1,FSEQ=$$RJ^XLFSTR(FSEQ,3,0)
     203 .;Evaluation counts
     204 .S REM(RCNT,FIND,GSEQ,FSEQ)=""
     205 .S REM(RCNT,FIND,GSEQ)=GTYP
     206 .;Update Workfile
     207 .S ^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)=FIND
     208 Q
     209 ;
     210URCNT(PXRMSTRT,PXRMSTOP,TFIEVAL) ;
     211 ;Handle counting all valid occurrences for the finding items.
     212 ;Includes historical entries that were entered within the reporting
     213 ;period, cut the encounter date if it is outside the reporting period.
     214 N CNT,DATEENT,FDATE,FILE,FNUM,FOCCNUM,HIST,NODE,SCAT,VIEN
     215 S CNT=0,FNUM=0
     216 F  S FNUM=$O(TFIEVAL(FNUM)) Q:FNUM'>0  D
     217 .S FILE=$G(TFIEVAL(FNUM,"FILE NUMBER"))
     218 .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)
     219 .S FOCCNUM=0 F  S FOCCNUM=$O(TFIEVAL(FNUM,FOCCNUM)) Q:FOCCNUM'>0  D
     220 ..S FDATE=$P(TFIEVAL(FNUM,FOCCNUM,"DATE"),".") Q:FDATE'>0
     221 ..I HIST=0,FDATE=PXRMSTRT!(FDATE>PXRMSTRT) S CNT=CNT+1
     222 ..I HIST=1 D
     223 ...S VIEN=TFIEVAL(FNUM,FOCCNUM,"VISIT") Q:VIEN'>0
     224 ...S NODE=$G(^AUPNVSIT(VIEN,0))
     225 ...S SCAT=$P(NODE,U,7),DATEENT=$P($P(NODE,U,2),".")
     226 ...I FDATE=PXRMSTRT!(FDATE>PXRMSTRT),SCAT'="E" S CNT=CNT+1 Q
     227 ...I SCAT="E",(DATEENT=PXRMSTRT!(DATEENT>PXRMSTRT))&(DATEENT=PXRMSTOP!(DATEENT<PXRMSTOP)) S CNT=CNT+1
     228 D UPD(CNT)
     229 Q
     230 ;
     231UPD(CNT) ;Update totals
     232 S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ))
     233 ;Total count
     234 S $P(DATA,U,2)=$P(DATA,U,2)+CNT
     235 ;Applicable count
     236 S $P(DATA,U,3)=$P(DATA,U,3)+(APPL*CNT)
     237 ;Not applicable count
     238 I 'APPL,'DUE S $P(DATA,U,4)=$P(DATA,U,4)+CNT
     239 ;Due count
     240 S $P(DATA,U,5)=$P(DATA,U,5)+(DUE*CNT)
     241 ;Not due count
     242 I APPL,'DUE S $P(DATA,U,6)=$P(DATA,U,6)+CNT
     243 ;Update current count
     244 S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ)=DATA
     245 ;AGP REMOVE UNTIL A DECISION CAN BE MADE
     246 ;I CNT=1,APPL=1 S ^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)=DFN
     247 Q
     248 ;
Note: See TracChangeset for help on using the changeset viewer.