PXRMFRPT ;SLC/PKR - Finding usage report. ;03/26/2015 13:12
;;2.0;CLINICAL REMINDERS;**12,17,16,18,22,26,53,45**;Feb 04, 2005;Build 566
;==============================
BLDLIST(FILENUM,GBL,FIEN,SUB) ;
I FILENUM'=811.9 D DEFLIST(FILENUM,GBL,FIEN,SUB)
I FILENUM'=811.5 D TERMLIST(FILENUM,GBL,FIEN,SUB)
D DIALOG(FILENUM,GBL,FIEN,SUB)
D OIGLIST(FILENUM,GBL,FIEN,SUB)
I (FILENUM=811.5)!(FILENUM=811.9) D
. D OCRLIST(FILENUM,GBL,FIEN,SUB)
. D RSETLIST(FILENUM,GBL,FIEN,SUB)
Q
;
;==============================
DEFLIST(FILENUM,GBL,FIEN,SUB) ;Search reminder definitions for any that are
;using GBL as a finding. If FIEN is not null then search for only
;those findings.
N FI,FNDIEN,IEN
S IEN=0
F S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0 D
. I '$D(^PXD(811.9,IEN,20,"E",GBL)) Q
. I +FIEN>0 D
.. S FI=""
.. F S FI=$O(^PXD(811.9,IEN,20,"E",GBL,FIEN,FI)) Q:FI="" D
... S ^TMP($J,SUB,FILENUM,FIEN,"DEF",IEN,FI)=""
. I +FIEN=0 D
..;No finding specified, find all of them.
.. S FNDIEN=""
.. F S FNDIEN=$O(^PXD(811.9,IEN,20,"E",GBL,FNDIEN)) Q:FNDIEN="" D
... S FI=""
... F S FI=$O(^PXD(811.9,IEN,20,"E",GBL,FNDIEN,FI)) Q:FI="" D
.... S ^TMP($J,SUB,FILENUM,FNDIEN,"DEF",IEN,FI)=""
Q
;
DFIND(TLIST) ;
S IND=0
F S IND=+$O(^DD(801.41,15,"V",IND)) Q:IND=0 D
. S TEMP=^DD(801.41,15,"V",IND,0)
. S TLIST($P(TEMP,U,2))=$P(TEMP,U,1)
;check branching logic sequence
S IND=0 F S IND=+$O(^DD(801.41143,1,"V",IND)) Q:IND=0 D
. S TEMP=^DD(801.41143,1,"V",IND,0)
. S TLIST($P(TEMP,U,2))=$P(TEMP,U,1)
Q
;==============================
DIALDSAR(OUTPUT) ;
;This is used for individual dialog element checks, may be better in a
;different routine
N FILENUM,IND,STATUS,TEMP
S IND=0 F S IND=+$O(^DD(801.41,15,"V",IND)) Q:IND=0 D
. S TEMP=^DD(801.41,15,"V",IND,0)
. S FILENUM=$P(TEMP,U)
.;DBIA #4640
. S STATUS=+$$GETSTAT^HDISVF01(FILENUM)
. I STATUS'=6,STATUS'=7 Q
. S OUTPUT($$ROOT^DILFD(FILENUM))=FILENUM_U_STATUS
;DBIA #4640
S STATUS=+$$GETSTAT^HDISVF01(101.43) I STATUS'=6,STATUS'=7 Q
S OUTPUT($$ROOT^DILFD("^101.43,"))=101.43_U_STATUS
Q
;
;==============================
DIALOG(FILENUM,GBL,FIEN,SUB) ;
N DIEN,FIELD,FIND
I '$D(^TMP($J,"DLG FIND")) D BLDDLGTM^PXRMSTS("DLG FIND")
I +FIEN>0 D Q
.I '$D(^TMP($J,"DLG FIND",GBL,FIEN)) Q
.S DIEN=0
.F S DIEN=$O(^TMP($J,"DLG FIND",GBL,FIEN,DIEN)) Q:DIEN'>0 D
..S FIELD=""
..F S FIELD=$O(^TMP($J,"DLG FIND",GBL,FIEN,DIEN,FIELD)) Q:FIELD="" D
...S ^TMP($J,SUB,FILENUM,FIEN,"DIALOG",DIEN,FIELD)=""
;
S FIND="" F S FIND=$O(^TMP($J,"DLG FIND",GBL,FIND)) Q:FIND="" D
.S DIEN=0
.F S DIEN=$O(^TMP($J,"DLG FIND",GBL,FIND,DIEN)) Q:DIEN'>0 D
..S FIELD=""
..F S FIELD=$O(^TMP($J,"DLG FIND",GBL,FIND,DIEN,FIELD)) Q:FIELD="" D
...S ^TMP($J,SUB,FILENUM,FIND,"DIALOG",DIEN,FIELD)=""
Q
;
;==============================
FINDDIAL(RESULT,GBL,FIEN) ;
;This api is used to return a list of dialogs that contains a specific
;finding
K ^TMP($J,"DLG FIND")
D BLDDLGTM^PXRMSTS("DLG FIND")
N DIEN,FIELD,FIND,NAME
I +FIEN'>0 Q
I '$D(^TMP($J,"DLG FIND",GBL,FIEN)) Q
S DIEN=0
F S DIEN=$O(^TMP($J,"DLG FIND",GBL,FIEN,DIEN)) Q:DIEN'>0 D
.S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U) Q:NAME=""
.S RESULT(NAME)=DIEN
Q
;
;==============================
FSEL(FNUM,GBL,GNAME,SOURCE,LIST) ;Build a list of reminder findings and let the user
;select from the list.
N ALIST,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILENUM,FLIST,IND,INUM
N STAR,TEMP,TLIST,X,Y
S (IND,INUM)=0
I $D(SOURCE("DEFINITION")) D RFIND(.TLIST)
I $D(SOURCE("DIALOG")) D DFIND(.TLIST)
S IND="",INUM=0
F S IND=$O(TLIST(IND)) Q:IND="" D
. S INUM=INUM+1
. S FILENUM=TLIST(IND)
.;DBIA #4640
. S STAR=$S($$SCREEN^HDISVF01(FILENUM):" *",1:"")
. S FLIST(FILENUM)=INUM
. S GNAME(INUM)=IND
. S ALIST(INUM)=" "_$J(INUM,4)_" - "_GNAME(INUM)_STAR
. S FNUM(INUM)=FILENUM
. S GBL(INUM)=$P($$GET1^DID(FILENUM,"","","GLOBAL NAME"),"^",2)
M DIR("A")=ALIST
S DIR("A")="Enter your list for the report"
S DIR(0)="LO^1:"_INUM
W !!,"Select from the following reminder findings (* signifies standardized):"
D ^DIR
I $D(DIROUT)!$D(DIRUT) S LIST="" Q
I $D(DUOUT)!$D(DTOUT) S LIST="" Q
S LIST=Y
Q
;
;==============================
ISEL(FNUM,GBL,GNAME,LIST,ITEMLIST) ;See if the user wants selected items or
;all from the selected finding types.
N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IND,LI,NUM,SEL,TEXT,Y
S DIC(0)="AEMQ"
S DIR(0)="S^1:ALL;2:SELECTED"
S DIR("B")="SELECTED"
S NUM=$L(LIST,",")-1
F IND=1:1:NUM D
. S LI=$P(LIST,",",IND)
. S TEXT="Search for all or selected "_GNAME(LI)
. S TEXT=TEXT_$S($E(TEXT,$L(TEXT))="S":"?",1:"S?")
. W !,TEXT
. D ^DIR
. I $D(DIROUT)!$D(DIRUT) Q
. I $D(DUOUT)!$D(DTOUT) Q
. I Y=1 S ITEMLIST="ALL" Q
. S DIC=FNUM(LI)
. S DIC("A")="Select "_GNAME(LI)_": "
. S SEL=1
. F Q:'SEL D
.. D ^DIC
.. I ($D(DTOUT))!($D(DUOUT)) S SEL=0 Q
.. I Y=-1 S SEL=0 Q
.. S ITEMLIST(FNUM(LI),$P(Y,U,1))=""
Q
;
;==============================
OCRLIST(FILENUM,GBL,FIEN,SUB) ;Search Reminder Order Check rules for
;any that are using GBL as a finding. If FIEN is not null then search
;for only those findings.
I FILENUM=811.5,'$D(^PXD(801.1,"T")) Q
I FILENUM=811.9,'$D(^PXD(801.1,"R")) Q
N IEN
I FILENUM=811.5 D
. I +FIEN>0 D
.. S IEN=0
.. F S IEN=$O(^PXD(801.1,"T",FIEN,IEN)) Q:IEN'>0 S ^TMP($J,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
. I +FIEN=0 D
.. S FIEN=""
.. F S FIEN=$O(^PXD(801.1,"T",FIEN)) Q:FIEN="" D
... S IEN=0
... F S IEN=$O(^PXD(801.1,"T",FIEN,IEN)) Q:IEN'>0 S ^TMP($J,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
I FILENUM=811.9 D
. I +FIEN>0 D
.. S IEN=0
.. F S IEN=$O(^PXD(801.1,"R",FIEN,IEN)) Q:IEN'>0 S ^TMP($J,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
. I +FIEN=0 D
.. S FIEN=""
.. F S FIEN=$O(^PXD(801.1,"R",FIEN)) Q:FIEN="" D
... S IEN=0
... F S IEN=$O(^PXD(801.1,"R",FIEN,IEN)) Q:IEN'>0 S ^TMP($J,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
Q
;
;==============================
OIGLIST(FNUM,GBL,FIEN,SUB) ;Search reminder orderable item groups for
;any that are using GBL as a finding. If FIEN is not null then search
;for only those findings.
N IEN,ITEM,NODE,RIEN,RNAME
S NODE=$S(FNUM=101.43:"O",FNUM=50.605:"P",FNUM=50:"P",FNUM=50.6:"P",1:"")
I NODE="" Q
S ITEM=$S(NODE="P":FIEN_";"_GBL,1:FIEN)
I +FIEN>0 D Q
. I '$D(^PXD(801,NODE,ITEM)) Q
. S IEN=0 F S IEN=$O(^PXD(801,NODE,ITEM,IEN)) Q:IEN'>0 D
.. S ^TMP($J,SUB,FNUM,FIEN,"ROC",IEN)="" Q
I '$D(^PXD(801,NODE)) Q
S ITEM="" F S ITEM=$O(^PXD(801,NODE,ITEM)) Q:ITEM="" D
. S FIEN=$S(NODE="P":$P(ITEM,";"),1:ITEM)
. S IEN=0 F S IEN=$O(^PXD(801,NODE,ITEM,IEN)) Q:IEN'>0 D
.. S ^TMP($J,SUB,FNUM,FIEN,"ROC",IEN)=""
Q
;
;==============================
REPD ;Main report driver.
N DONE,FI,FIEN,FIENS,FILES,FILENUM,FNUM,GBL,GNAME,IEN,IND,ITEMLIST
N LI,LIST,NL,NUM,REP,SOURCE,STATUS,TYPE
S DONE=0
S SOURCE("DEFINITION")="",SOURCE("DIALOG")=""
W !,"Clinical Reminders Usage Report"
F Q:DONE D
. K ^TMP($J,"DIALOG MESSAGE"),^TMP($J,"DLG FIND")
. K ^TMP($J,"FDATA"),^TMP("PXRMXMZ",$J)
. K FNUM,GBL,GNAME,ITEMLIST,LIST
.;Get a list of findings for the report.
. D FSEL(.FNUM,.GBL,.GNAME,.SOURCE,.LIST)
. S NUM=$L(LIST,",")-1
. I NUM=0 S DONE=1 Q
. D ISEL(.FNUM,.GBL,.GNAME,.LIST,.ITEMLIST)
. I '$D(ITEMLIST) Q
. D BLDDLGTM^PXRMSTS("DLG FIND")
. F IND=1:1:NUM D
.. S LI=$P(LIST,",",IND)
.. I '$D(ITEMLIST(FNUM(LI))) D BLDLIST(FNUM(LI),GBL(LI),"","FDATA") Q
.. I $D(ITEMLIST(FNUM(LI))) D
... S FIEN=""
... F S FIEN=$O(ITEMLIST(FNUM(LI),FIEN)) Q:FIEN="" D BLDLIST(FNUM(LI),GBL(LI),FIEN,"FDATA")
.;Process the finding list and generate the MailMan message.
. D REPORT
. K ^TMP($J,"FDATA"),^TMP($J,"SDATA"),^TMP("PXRMXMZ",$J),^TMP($J,"DLG FIND")
Q
;
;==============================
REPORT ;Generate the report.
N DTYP,FILENUM,FNAME,FNUMLIST,GNAME,IND,NAME,NL,NOUT,NTYPE
N REPFNAME,REPGNAME,RNUM,STANDARD,STATUS
N TEXT,TEXTOUT,TO,TYPELIST
D SORT
S FNUMLIST("DEF")=811.9,TYPELIST("DEF")="Reminder Definition"
S FNUMLIST("DIALOG")=801.41,TYPELIST("DIALOG")="Reminder Dialog"
S FNUMLIST("LRULE")=810.4,TYPELIST("LRULE")="Reminder List Rule"
S FNUMLIST("OCRULE")=801.1,TYPELIST("OCRULE")="Reminder Order Check Rules"
S FNUMLIST("ROC")=801,TYPELIST("ROC")="Reminder Order Check Items Group"
S FNUMLIST("TERM")=811.5,TYPELIST("TERM")="Reminder Term"
K ^TMP("PXRMXMZ",$J)
S NL=1,^TMP("PXRMXMZ",$J,NL,0)="Clinical Reminders finding usage report."
S GNAME=""
F S GNAME=$O(^TMP($J,"SDATA",GNAME)) Q:GNAME="" D
. S FILENUM=$P(^TMP($J,"SDATA",GNAME),U,1)
. S STANDARD=$P(^TMP($J,"SDATA",GNAME),U,2)
. S NTYPE=0
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="The following "_GNAME_"(s) are used as follows:"
. I STANDARD S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="(This file has been standardized.)"
. S FNAME=""
. F S FNAME=$O(^TMP($J,"SDATA",GNAME,FNAME)) Q:FNAME="" D
.. S FIEN=^TMP($J,"SDATA",GNAME,FNAME)
.. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
.. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="======================================================="
.. S TEXT=GNAME_" - "_FNAME_" (IEN="_FIEN_")"
.. D FORMATS^PXRMTEXT(1,72,TEXT,.NOUT,.TEXTOUT)
.. F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
.. I STANDARD D
... S STATUS=^TMP($J,"SDATA",GNAME,FNAME,"STD")
... S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" status is: "_STATUS
... I $D(^TMP($J,"SDATA",GNAME,FNAME,"STD","REP")) D
.... S REPGNAME=$P(^TMP($J,"SDATA",GNAME,FNAME,"STD","REP"),U,1)
.... S REPFNAME=$P(^TMP($J,"SDATA",GNAME,FNAME,"STD","REP"),U,2)
.... S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" its replacement is "_REPGNAME_"; "_REPFNAME
.. S TYPE=""
.. F S TYPE=$O(TYPELIST(TYPE)) Q:TYPE="" D
... I '$D(^TMP($J,"FDATA",FILENUM,FIEN,TYPE)) Q
... S NTYPE=NTYPE+1
... S RNUM=FNUMLIST(TYPE)
... S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
... I NTYPE>1 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="---------------------------------"
... S TEXT=" Is used in the following "_TYPELIST(TYPE)_"(s):"
... D FORMATS^PXRMTEXT(4,72,TEXT,.NOUT,.TEXTOUT)
... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
... S IEN=0
... F S IEN=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN)) Q:IEN="" D
.... S NAME=$$GET1^DIQ(RNUM,IEN,.01)
.... I NAME="" S NAME="Undefined"
.... S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
....;
.... I TYPE="DIALOG" D
..... S DTYP=$P(^PXRMD(801.41,IEN,0),U,4)
..... S TEXT="Dialog "_$S(DTYP="E":"element",DTYP="G":"group",DTYP="S":"result group",1:"item")
..... S TEXT=TEXT_" "_NAME_$S($P(^PXRMD(801.41,IEN,0),U,3)=1:" (Disable)",1:"")_" (IEN="_IEN_")"
..... S TEXT=TEXT_", used in the"
..... D FORMATS^PXRMTEXT(6,72,TEXT,.NOUT,.TEXTOUT)
..... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
..... S FI=""
..... F S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN,FI)) Q:FI="" D
...... S TEXT=$S(FI=15:"Finding Item field",FI=17:"Orderable Item field",FI=18:"Additional Finding field",FI=119:"MH Test field",FI="BL":"Branching Logic Evaluation Item field",1:"")
...... D FORMATS^PXRMTEXT(8,72,TEXT,.NOUT,.TEXTOUT)
...... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
....;
.... I TYPE'="DIALOG" D
..... S TEXT=NAME_" (IEN="_IEN_")"
..... D FORMATS^PXRMTEXT(6,72,TEXT,.NOUT,.TEXTOUT)
..... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
..... S FI=0
..... F S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN,FI)) Q:FI="" D
...... S TEXT="Finding number "_FI
...... D FORMATS^PXRMTEXT(8,72,TEXT,.NOUT,.TEXTOUT)
...... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
.....;
;Deliver the report.
I NL=1 D Q
. W !,"None of the selected findings are used."
. K ^TMP("PXRMXMZ",$J)
N ANS,BOP,X
S BOP=$$BORP^PXRMUTIL("B")
I BOP="B" D
. S X="IORESET"
. D ENDR^%ZISS
. D BROWSE^DDBR("^TMP(""PXRMXMZ"",$J)","NR","Reminder Usage Report")
. W IORESET
. D KILL^%ZISS
I BOP="P" D GPRINT^PXRMUTIL("^TMP(""PXRMXMZ"",$J)")
;Ask the user if they want the report delivered through MailMan.
S ANS=$$ASKYN^PXRMEUT("N","Deliver the report as a MailMan message")
I ANS="1" D
. S TO(DUZ)=""
. D SEND^PXRMMSG("PXRMXMZ","Clinical Reminders Finding Usage Report",.TO,DUZ)
K ^TMP("PXRMXMZ",$J)
Q
;
RFIND(TLIST) ;
N IND
S IND=0
;Create a temporary list ordered by file name.
S TLIST("REMINDER DEFINITION")=811.9
;DBIA #2991, #5149 for access to ^DD.
F S IND=+$O(^DD(811.902,.01,"V",IND)) Q:IND=0 D
. S TEMP=^DD(811.902,.01,"V",IND,0)
. S TLIST($P(TEMP,U,2))=$P(TEMP,U,1)
Q
;==============================
RSETLIST(FILENUM,GBL,FIEN,SUB) ;Search list rules for any that are using
;GBL as a finding. If FIEN is not null then search for only those
;findings.
N FNDIEN,IEN,TEMP,TYPE
S IEN=0
F S IEN=+$O(^PXRM(810.4,IEN)) Q:IEN=0 D
. S TEMP=^PXRM(810.4,IEN,0)
. S TYPE=$P(TEMP,U,3)
.;If it is not a finding rule or reminder rule skip it.
. I (TYPE=3)!(TYPE=5) Q
. S FNDIEN=+$S(FILENUM=811.5:$P(TEMP,U,7),FILENUM=811.9:$P(TEMP,U,10),1:0)
. I FNDIEN=0 Q
.;If no finding specified find, all of them.
. I (FIEN=FNDIEN)!(FIEN="") S ^TMP($J,SUB,FILENUM,FNDIEN,"LRULE",IEN)=""
Q
;
;==============================
SORT ;Sort by global name and finding name.
N FIEN,FILENUM,FNAME,GNAME,STANDARD
K ^TMP($J,"SDATA")
S FILENUM=0
F S FILENUM=$O(^TMP($J,"FDATA",FILENUM)) Q:FILENUM="" D
. S GNAME=$$GET1^DID(FILENUM,"","","NAME")
.;DBIA #4640
. S STANDARD=$$SCREEN^HDISVF01(FILENUM)
. S ^TMP($J,"SDATA",GNAME)=FILENUM_U_STANDARD
. S FIEN=0
. F S FIEN=$O(^TMP($J,"FDATA",FILENUM,FIEN)) Q:FIEN="" D
.. S FNAME=$$GET1^DIQ(FILENUM,FIEN,.01)
.. I FNAME="" S FNAME="Undefined"
.. S ^TMP($J,"SDATA",GNAME,FNAME)=FIEN
.. I STANDARD D
... N REPFNAME,REPFNUM,REPGNAME,REPIEN,STATUS
...;DBIA #4631
... S STATUS=$P($$GETSTAT^XTID(FILENUM,.01,FIEN_","),U,3)
... I STATUS="" S STATUS="undefined"
... S ^TMP($J,"SDATA",GNAME,FNAME,"STD")=STATUS
... S REP=$$RPLCMNT^XTIDTRM(FILENUM,FIEN)
... I REP=(FIEN_";"_FILENUM) S REP=""
... I REP'="" D
.... S REPIEN=$P(REP,";",1)
.... S REPFNUM=$P(REP,";",2)
.... S REPGNAME=$$GET1^DID(REPFNUM,"","","NAME")
.... S REPFNAME=$$GET1^DIQ(REPFNUM,REPIEN,.01)
.... S ^TMP($J,"SDATA",GNAME,FNAME,"STD","REP")=REPGNAME_U_REPFNAME
Q
;
;==============================
TERMLIST(FILENUM,GBL,FIEN,SUB) ;Search reminder terms for any that are using
;GBL as a finding. If FIEN is not null then search for only those
;findings.
N FI,FNDIEN,IEN
S IEN=0
F S IEN=+$O(^PXRMD(811.5,IEN)) Q:IEN=0 D
. I '$D(^PXRMD(811.5,IEN,20,"E",GBL)) Q
. I +FIEN>0 D
.. S FI=""
.. F S FI=$O(^PXRMD(811.5,IEN,20,"E",GBL,FIEN,FI)) Q:FI="" D
... S ^TMP($J,SUB,FILENUM,FIEN,"TERM",IEN,FI)=""
. I +FIEN=0 D
..;No finding specified find, all of them.
.. S FNDIEN=""
.. F S FNDIEN=$O(^PXRMD(811.5,IEN,20,"E",GBL,FNDIEN)) Q:FNDIEN="" D
... S FI=""
... F S FI=$O(^PXRMD(811.5,IEN,20,"E",GBL,FNDIEN,FI)) Q:FI="" D
.... S ^TMP($J,SUB,FILENUM,FNDIEN,"TERM",IEN,FI)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMFRPT 15205 printed Nov 22, 2024@16:55:45 Page 2
PXRMFRPT ;SLC/PKR - Finding usage report. ;03/26/2015 13:12
+1 ;;2.0;CLINICAL REMINDERS;**12,17,16,18,22,26,53,45**;Feb 04, 2005;Build 566
+2 ;==============================
BLDLIST(FILENUM,GBL,FIEN,SUB) ;
+1 IF FILENUM'=811.9
DO DEFLIST(FILENUM,GBL,FIEN,SUB)
+2 IF FILENUM'=811.5
DO TERMLIST(FILENUM,GBL,FIEN,SUB)
+3 DO DIALOG(FILENUM,GBL,FIEN,SUB)
+4 DO OIGLIST(FILENUM,GBL,FIEN,SUB)
+5 IF (FILENUM=811.5)!(FILENUM=811.9)
Begin DoDot:1
+6 DO OCRLIST(FILENUM,GBL,FIEN,SUB)
+7 DO RSETLIST(FILENUM,GBL,FIEN,SUB)
End DoDot:1
+8 QUIT
+9 ;
+10 ;==============================
DEFLIST(FILENUM,GBL,FIEN,SUB) ;Search reminder definitions for any that are
+1 ;using GBL as a finding. If FIEN is not null then search for only
+2 ;those findings.
+3 NEW FI,FNDIEN,IEN
+4 SET IEN=0
+5 FOR
SET IEN=+$ORDER(^PXD(811.9,IEN))
if IEN=0
QUIT
Begin DoDot:1
+6 IF '$DATA(^PXD(811.9,IEN,20,"E",GBL))
QUIT
+7 IF +FIEN>0
Begin DoDot:2
+8 SET FI=""
+9 FOR
SET FI=$ORDER(^PXD(811.9,IEN,20,"E",GBL,FIEN,FI))
if FI=""
QUIT
Begin DoDot:3
+10 SET ^TMP($JOB,SUB,FILENUM,FIEN,"DEF",IEN,FI)=""
End DoDot:3
End DoDot:2
+11 IF +FIEN=0
Begin DoDot:2
+12 ;No finding specified, find all of them.
+13 SET FNDIEN=""
+14 FOR
SET FNDIEN=$ORDER(^PXD(811.9,IEN,20,"E",GBL,FNDIEN))
if FNDIEN=""
QUIT
Begin DoDot:3
+15 SET FI=""
+16 FOR
SET FI=$ORDER(^PXD(811.9,IEN,20,"E",GBL,FNDIEN,FI))
if FI=""
QUIT
Begin DoDot:4
+17 SET ^TMP($JOB,SUB,FILENUM,FNDIEN,"DEF",IEN,FI)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
DFIND(TLIST) ;
+1 SET IND=0
+2 FOR
SET IND=+$ORDER(^DD(801.41,15,"V",IND))
if IND=0
QUIT
Begin DoDot:1
+3 SET TEMP=^DD(801.41,15,"V",IND,0)
+4 SET TLIST($PIECE(TEMP,U,2))=$PIECE(TEMP,U,1)
End DoDot:1
+5 ;check branching logic sequence
+6 SET IND=0
FOR
SET IND=+$ORDER(^DD(801.41143,1,"V",IND))
if IND=0
QUIT
Begin DoDot:1
+7 SET TEMP=^DD(801.41143,1,"V",IND,0)
+8 SET TLIST($PIECE(TEMP,U,2))=$PIECE(TEMP,U,1)
End DoDot:1
+9 QUIT
+10 ;==============================
DIALDSAR(OUTPUT) ;
+1 ;This is used for individual dialog element checks, may be better in a
+2 ;different routine
+3 NEW FILENUM,IND,STATUS,TEMP
+4 SET IND=0
FOR
SET IND=+$ORDER(^DD(801.41,15,"V",IND))
if IND=0
QUIT
Begin DoDot:1
+5 SET TEMP=^DD(801.41,15,"V",IND,0)
+6 SET FILENUM=$PIECE(TEMP,U)
+7 ;DBIA #4640
+8 SET STATUS=+$$GETSTAT^HDISVF01(FILENUM)
+9 IF STATUS'=6
IF STATUS'=7
QUIT
+10 SET OUTPUT($$ROOT^DILFD(FILENUM))=FILENUM_U_STATUS
End DoDot:1
+11 ;DBIA #4640
+12 SET STATUS=+$$GETSTAT^HDISVF01(101.43)
IF STATUS'=6
IF STATUS'=7
QUIT
+13 SET OUTPUT($$ROOT^DILFD("^101.43,"))=101.43_U_STATUS
+14 QUIT
+15 ;
+16 ;==============================
DIALOG(FILENUM,GBL,FIEN,SUB) ;
+1 NEW DIEN,FIELD,FIND
+2 IF '$DATA(^TMP($JOB,"DLG FIND"))
DO BLDDLGTM^PXRMSTS("DLG FIND")
+3 IF +FIEN>0
Begin DoDot:1
+4 IF '$DATA(^TMP($JOB,"DLG FIND",GBL,FIEN))
QUIT
+5 SET DIEN=0
+6 FOR
SET DIEN=$ORDER(^TMP($JOB,"DLG FIND",GBL,FIEN,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+7 SET FIELD=""
+8 FOR
SET FIELD=$ORDER(^TMP($JOB,"DLG FIND",GBL,FIEN,DIEN,FIELD))
if FIELD=""
QUIT
Begin DoDot:3
+9 SET ^TMP($JOB,SUB,FILENUM,FIEN,"DIALOG",DIEN,FIELD)=""
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+10 ;
+11 SET FIND=""
FOR
SET FIND=$ORDER(^TMP($JOB,"DLG FIND",GBL,FIND))
if FIND=""
QUIT
Begin DoDot:1
+12 SET DIEN=0
+13 FOR
SET DIEN=$ORDER(^TMP($JOB,"DLG FIND",GBL,FIND,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+14 SET FIELD=""
+15 FOR
SET FIELD=$ORDER(^TMP($JOB,"DLG FIND",GBL,FIND,DIEN,FIELD))
if FIELD=""
QUIT
Begin DoDot:3
+16 SET ^TMP($JOB,SUB,FILENUM,FIND,"DIALOG",DIEN,FIELD)=""
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
+19 ;==============================
FINDDIAL(RESULT,GBL,FIEN) ;
+1 ;This api is used to return a list of dialogs that contains a specific
+2 ;finding
+3 KILL ^TMP($JOB,"DLG FIND")
+4 DO BLDDLGTM^PXRMSTS("DLG FIND")
+5 NEW DIEN,FIELD,FIND,NAME
+6 IF +FIEN'>0
QUIT
+7 IF '$DATA(^TMP($JOB,"DLG FIND",GBL,FIEN))
QUIT
+8 SET DIEN=0
+9 FOR
SET DIEN=$ORDER(^TMP($JOB,"DLG FIND",GBL,FIEN,DIEN))
if DIEN'>0
QUIT
Begin DoDot:1
+10 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
if NAME=""
QUIT
+11 SET RESULT(NAME)=DIEN
End DoDot:1
+12 QUIT
+13 ;
+14 ;==============================
FSEL(FNUM,GBL,GNAME,SOURCE,LIST) ;Build a list of reminder findings and let the user
+1 ;select from the list.
+2 NEW ALIST,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILENUM,FLIST,IND,INUM
+3 NEW STAR,TEMP,TLIST,X,Y
+4 SET (IND,INUM)=0
+5 IF $DATA(SOURCE("DEFINITION"))
DO RFIND(.TLIST)
+6 IF $DATA(SOURCE("DIALOG"))
DO DFIND(.TLIST)
+7 SET IND=""
SET INUM=0
+8 FOR
SET IND=$ORDER(TLIST(IND))
if IND=""
QUIT
Begin DoDot:1
+9 SET INUM=INUM+1
+10 SET FILENUM=TLIST(IND)
+11 ;DBIA #4640
+12 SET STAR=$SELECT($$SCREEN^HDISVF01(FILENUM):" *",1:"")
+13 SET FLIST(FILENUM)=INUM
+14 SET GNAME(INUM)=IND
+15 SET ALIST(INUM)=" "_$JUSTIFY(INUM,4)_" - "_GNAME(INUM)_STAR
+16 SET FNUM(INUM)=FILENUM
+17 SET GBL(INUM)=$PIECE($$GET1^DID(FILENUM,"","","GLOBAL NAME"),"^",2)
End DoDot:1
+18 MERGE DIR("A")=ALIST
+19 SET DIR("A")="Enter your list for the report"
+20 SET DIR(0)="LO^1:"_INUM
+21 WRITE !!,"Select from the following reminder findings (* signifies standardized):"
+22 DO ^DIR
+23 IF $DATA(DIROUT)!$DATA(DIRUT)
SET LIST=""
QUIT
+24 IF $DATA(DUOUT)!$DATA(DTOUT)
SET LIST=""
QUIT
+25 SET LIST=Y
+26 QUIT
+27 ;
+28 ;==============================
ISEL(FNUM,GBL,GNAME,LIST,ITEMLIST) ;See if the user wants selected items or
+1 ;all from the selected finding types.
+2 NEW DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IND,LI,NUM,SEL,TEXT,Y
+3 SET DIC(0)="AEMQ"
+4 SET DIR(0)="S^1:ALL;2:SELECTED"
+5 SET DIR("B")="SELECTED"
+6 SET NUM=$LENGTH(LIST,",")-1
+7 FOR IND=1:1:NUM
Begin DoDot:1
+8 SET LI=$PIECE(LIST,",",IND)
+9 SET TEXT="Search for all or selected "_GNAME(LI)
+10 SET TEXT=TEXT_$SELECT($EXTRACT(TEXT,$LENGTH(TEXT))="S":"?",1:"S?")
+11 WRITE !,TEXT
+12 DO ^DIR
+13 IF $DATA(DIROUT)!$DATA(DIRUT)
QUIT
+14 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+15 IF Y=1
SET ITEMLIST="ALL"
QUIT
+16 SET DIC=FNUM(LI)
+17 SET DIC("A")="Select "_GNAME(LI)_": "
+18 SET SEL=1
+19 FOR
if 'SEL
QUIT
Begin DoDot:2
+20 DO ^DIC
+21 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET SEL=0
QUIT
+22 IF Y=-1
SET SEL=0
QUIT
+23 SET ITEMLIST(FNUM(LI),$PIECE(Y,U,1))=""
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
+26 ;==============================
OCRLIST(FILENUM,GBL,FIEN,SUB) ;Search Reminder Order Check rules for
+1 ;any that are using GBL as a finding. If FIEN is not null then search
+2 ;for only those findings.
+3 IF FILENUM=811.5
IF '$DATA(^PXD(801.1,"T"))
QUIT
+4 IF FILENUM=811.9
IF '$DATA(^PXD(801.1,"R"))
QUIT
+5 NEW IEN
+6 IF FILENUM=811.5
Begin DoDot:1
+7 IF +FIEN>0
Begin DoDot:2
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(^PXD(801.1,"T",FIEN,IEN))
if IEN'>0
QUIT
SET ^TMP($JOB,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
End DoDot:2
+10 IF +FIEN=0
Begin DoDot:2
+11 SET FIEN=""
+12 FOR
SET FIEN=$ORDER(^PXD(801.1,"T",FIEN))
if FIEN=""
QUIT
Begin DoDot:3
+13 SET IEN=0
+14 FOR
SET IEN=$ORDER(^PXD(801.1,"T",FIEN,IEN))
if IEN'>0
QUIT
SET ^TMP($JOB,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF FILENUM=811.9
Begin DoDot:1
+16 IF +FIEN>0
Begin DoDot:2
+17 SET IEN=0
+18 FOR
SET IEN=$ORDER(^PXD(801.1,"R",FIEN,IEN))
if IEN'>0
QUIT
SET ^TMP($JOB,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
End DoDot:2
+19 IF +FIEN=0
Begin DoDot:2
+20 SET FIEN=""
+21 FOR
SET FIEN=$ORDER(^PXD(801.1,"R",FIEN))
if FIEN=""
QUIT
Begin DoDot:3
+22 SET IEN=0
+23 FOR
SET IEN=$ORDER(^PXD(801.1,"R",FIEN,IEN))
if IEN'>0
QUIT
SET ^TMP($JOB,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
+26 ;==============================
OIGLIST(FNUM,GBL,FIEN,SUB) ;Search reminder orderable item groups for
+1 ;any that are using GBL as a finding. If FIEN is not null then search
+2 ;for only those findings.
+3 NEW IEN,ITEM,NODE,RIEN,RNAME
+4 SET NODE=$SELECT(FNUM=101.43:"O",FNUM=50.605:"P",FNUM=50:"P",FNUM=50.6:"P",1:"")
+5 IF NODE=""
QUIT
+6 SET ITEM=$SELECT(NODE="P":FIEN_";"_GBL,1:FIEN)
+7 IF +FIEN>0
Begin DoDot:1
+8 IF '$DATA(^PXD(801,NODE,ITEM))
QUIT
+9 SET IEN=0
FOR
SET IEN=$ORDER(^PXD(801,NODE,ITEM,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+10 SET ^TMP($JOB,SUB,FNUM,FIEN,"ROC",IEN)=""
QUIT
End DoDot:2
End DoDot:1
QUIT
+11 IF '$DATA(^PXD(801,NODE))
QUIT
+12 SET ITEM=""
FOR
SET ITEM=$ORDER(^PXD(801,NODE,ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+13 SET FIEN=$SELECT(NODE="P":$PIECE(ITEM,";"),1:ITEM)
+14 SET IEN=0
FOR
SET IEN=$ORDER(^PXD(801,NODE,ITEM,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+15 SET ^TMP($JOB,SUB,FNUM,FIEN,"ROC",IEN)=""
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ;==============================
REPD ;Main report driver.
+1 NEW DONE,FI,FIEN,FIENS,FILES,FILENUM,FNUM,GBL,GNAME,IEN,IND,ITEMLIST
+2 NEW LI,LIST,NL,NUM,REP,SOURCE,STATUS,TYPE
+3 SET DONE=0
+4 SET SOURCE("DEFINITION")=""
SET SOURCE("DIALOG")=""
+5 WRITE !,"Clinical Reminders Usage Report"
+6 FOR
if DONE
QUIT
Begin DoDot:1
+7 KILL ^TMP($JOB,"DIALOG MESSAGE"),^TMP($JOB,"DLG FIND")
+8 KILL ^TMP($JOB,"FDATA"),^TMP("PXRMXMZ",$JOB)
+9 KILL FNUM,GBL,GNAME,ITEMLIST,LIST
+10 ;Get a list of findings for the report.
+11 DO FSEL(.FNUM,.GBL,.GNAME,.SOURCE,.LIST)
+12 SET NUM=$LENGTH(LIST,",")-1
+13 IF NUM=0
SET DONE=1
QUIT
+14 DO ISEL(.FNUM,.GBL,.GNAME,.LIST,.ITEMLIST)
+15 IF '$DATA(ITEMLIST)
QUIT
+16 DO BLDDLGTM^PXRMSTS("DLG FIND")
+17 FOR IND=1:1:NUM
Begin DoDot:2
+18 SET LI=$PIECE(LIST,",",IND)
+19 IF '$DATA(ITEMLIST(FNUM(LI)))
DO BLDLIST(FNUM(LI),GBL(LI),"","FDATA")
QUIT
+20 IF $DATA(ITEMLIST(FNUM(LI)))
Begin DoDot:3
+21 SET FIEN=""
+22 FOR
SET FIEN=$ORDER(ITEMLIST(FNUM(LI),FIEN))
if FIEN=""
QUIT
DO BLDLIST(FNUM(LI),GBL(LI),FIEN,"FDATA")
End DoDot:3
End DoDot:2
+23 ;Process the finding list and generate the MailMan message.
+24 DO REPORT
+25 KILL ^TMP($JOB,"FDATA"),^TMP($JOB,"SDATA"),^TMP("PXRMXMZ",$JOB),^TMP($JOB,"DLG FIND")
End DoDot:1
+26 QUIT
+27 ;
+28 ;==============================
REPORT ;Generate the report.
+1 NEW DTYP,FILENUM,FNAME,FNUMLIST,GNAME,IND,NAME,NL,NOUT,NTYPE
+2 NEW REPFNAME,REPGNAME,RNUM,STANDARD,STATUS
+3 NEW TEXT,TEXTOUT,TO,TYPELIST
+4 DO SORT
+5 SET FNUMLIST("DEF")=811.9
SET TYPELIST("DEF")="Reminder Definition"
+6 SET FNUMLIST("DIALOG")=801.41
SET TYPELIST("DIALOG")="Reminder Dialog"
+7 SET FNUMLIST("LRULE")=810.4
SET TYPELIST("LRULE")="Reminder List Rule"
+8 SET FNUMLIST("OCRULE")=801.1
SET TYPELIST("OCRULE")="Reminder Order Check Rules"
+9 SET FNUMLIST("ROC")=801
SET TYPELIST("ROC")="Reminder Order Check Items Group"
+10 SET FNUMLIST("TERM")=811.5
SET TYPELIST("TERM")="Reminder Term"
+11 KILL ^TMP("PXRMXMZ",$JOB)
+12 SET NL=1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Clinical Reminders finding usage report."
+13 SET GNAME=""
+14 FOR
SET GNAME=$ORDER(^TMP($JOB,"SDATA",GNAME))
if GNAME=""
QUIT
Begin DoDot:1
+15 SET FILENUM=$PIECE(^TMP($JOB,"SDATA",GNAME),U,1)
+16 SET STANDARD=$PIECE(^TMP($JOB,"SDATA",GNAME),U,2)
+17 SET NTYPE=0
+18 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+19 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="The following "_GNAME_"(s) are used as follows:"
+20 IF STANDARD
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="(This file has been standardized.)"
+21 SET FNAME=""
+22 FOR
SET FNAME=$ORDER(^TMP($JOB,"SDATA",GNAME,FNAME))
if FNAME=""
QUIT
Begin DoDot:2
+23 SET FIEN=^TMP($JOB,"SDATA",GNAME,FNAME)
+24 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+25 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="======================================================="
+26 SET TEXT=GNAME_" - "_FNAME_" (IEN="_FIEN_")"
+27 DO FORMATS^PXRMTEXT(1,72,TEXT,.NOUT,.TEXTOUT)
+28 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
+29 IF STANDARD
Begin DoDot:3
+30 SET STATUS=^TMP($JOB,"SDATA",GNAME,FNAME,"STD")
+31 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" status is: "_STATUS
+32 IF $DATA(^TMP($JOB,"SDATA",GNAME,FNAME,"STD","REP"))
Begin DoDot:4
+33 SET REPGNAME=$PIECE(^TMP($JOB,"SDATA",GNAME,FNAME,"STD","REP"),U,1)
+34 SET REPFNAME=$PIECE(^TMP($JOB,"SDATA",GNAME,FNAME,"STD","REP"),U,2)
+35 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" its replacement is "_REPGNAME_"; "_REPFNAME
End DoDot:4
End DoDot:3
+36 SET TYPE=""
+37 FOR
SET TYPE=$ORDER(TYPELIST(TYPE))
if TYPE=""
QUIT
Begin DoDot:3
+38 IF '$DATA(^TMP($JOB,"FDATA",FILENUM,FIEN,TYPE))
QUIT
+39 SET NTYPE=NTYPE+1
+40 SET RNUM=FNUMLIST(TYPE)
+41 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+42 IF NTYPE>1
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="---------------------------------"
+43 SET TEXT=" Is used in the following "_TYPELIST(TYPE)_"(s):"
+44 DO FORMATS^PXRMTEXT(4,72,TEXT,.NOUT,.TEXTOUT)
+45 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
+46 SET IEN=0
+47 FOR
SET IEN=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,TYPE,IEN))
if IEN=""
QUIT
Begin DoDot:4
+48 SET NAME=$$GET1^DIQ(RNUM,IEN,.01)
+49 IF NAME=""
SET NAME="Undefined"
+50 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+51 ;
+52 IF TYPE="DIALOG"
Begin DoDot:5
+53 SET DTYP=$PIECE(^PXRMD(801.41,IEN,0),U,4)
+54 SET TEXT="Dialog "_$SELECT(DTYP="E":"element",DTYP="G":"group",DTYP="S":"result group",1:"item")
+55 SET TEXT=TEXT_" "_NAME_$SELECT($PIECE(^PXRMD(801.41,IEN,0),U,3)=1:" (Disable)",1:"")_" (IEN="_IEN_")"
+56 SET TEXT=TEXT_", used in the"
+57 DO FORMATS^PXRMTEXT(6,72,TEXT,.NOUT,.TEXTOUT)
+58 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
+59 SET FI=""
+60 FOR
SET FI=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,TYPE,IEN,FI))
if FI=""
QUIT
Begin DoDot:6
+61 SET TEXT=$SELECT(FI=15:"Finding Item field",FI=17:"Orderable Item field",FI=18:"Additional Finding field",FI=119:"MH Test field",FI="BL":"Branching Logic Evaluation Item field",1:"")
+62 DO FORMATS^PXRMTEXT(8,72,TEXT,.NOUT,.TEXTOUT)
+63 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
End DoDot:6
End DoDot:5
+64 ;
+65 IF TYPE'="DIALOG"
Begin DoDot:5
+66 SET TEXT=NAME_" (IEN="_IEN_")"
+67 DO FORMATS^PXRMTEXT(6,72,TEXT,.NOUT,.TEXTOUT)
+68 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
+69 SET FI=0
+70 FOR
SET FI=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,TYPE,IEN,FI))
if FI=""
QUIT
Begin DoDot:6
+71 SET TEXT="Finding number "_FI
+72 DO FORMATS^PXRMTEXT(8,72,TEXT,.NOUT,.TEXTOUT)
+73 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
End DoDot:6
+74 ;
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+75 ;Deliver the report.
+76 IF NL=1
Begin DoDot:1
+77 WRITE !,"None of the selected findings are used."
+78 KILL ^TMP("PXRMXMZ",$JOB)
End DoDot:1
QUIT
+79 NEW ANS,BOP,X
+80 SET BOP=$$BORP^PXRMUTIL("B")
+81 IF BOP="B"
Begin DoDot:1
+82 SET X="IORESET"
+83 DO ENDR^%ZISS
+84 DO BROWSE^DDBR("^TMP(""PXRMXMZ"",$J)","NR","Reminder Usage Report")
+85 WRITE IORESET
+86 DO KILL^%ZISS
End DoDot:1
+87 IF BOP="P"
DO GPRINT^PXRMUTIL("^TMP(""PXRMXMZ"",$J)")
+88 ;Ask the user if they want the report delivered through MailMan.
+89 SET ANS=$$ASKYN^PXRMEUT("N","Deliver the report as a MailMan message")
+90 IF ANS="1"
Begin DoDot:1
+91 SET TO(DUZ)=""
+92 DO SEND^PXRMMSG("PXRMXMZ","Clinical Reminders Finding Usage Report",.TO,DUZ)
End DoDot:1
+93 KILL ^TMP("PXRMXMZ",$JOB)
+94 QUIT
+95 ;
RFIND(TLIST) ;
+1 NEW IND
+2 SET IND=0
+3 ;Create a temporary list ordered by file name.
+4 SET TLIST("REMINDER DEFINITION")=811.9
+5 ;DBIA #2991, #5149 for access to ^DD.
+6 FOR
SET IND=+$ORDER(^DD(811.902,.01,"V",IND))
if IND=0
QUIT
Begin DoDot:1
+7 SET TEMP=^DD(811.902,.01,"V",IND,0)
+8 SET TLIST($PIECE(TEMP,U,2))=$PIECE(TEMP,U,1)
End DoDot:1
+9 QUIT
+10 ;==============================
RSETLIST(FILENUM,GBL,FIEN,SUB) ;Search list rules for any that are using
+1 ;GBL as a finding. If FIEN is not null then search for only those
+2 ;findings.
+3 NEW FNDIEN,IEN,TEMP,TYPE
+4 SET IEN=0
+5 FOR
SET IEN=+$ORDER(^PXRM(810.4,IEN))
if IEN=0
QUIT
Begin DoDot:1
+6 SET TEMP=^PXRM(810.4,IEN,0)
+7 SET TYPE=$PIECE(TEMP,U,3)
+8 ;If it is not a finding rule or reminder rule skip it.
+9 IF (TYPE=3)!(TYPE=5)
QUIT
+10 SET FNDIEN=+$SELECT(FILENUM=811.5:$PIECE(TEMP,U,7),FILENUM=811.9:$PIECE(TEMP,U,10),1:0)
+11 IF FNDIEN=0
QUIT
+12 ;If no finding specified find, all of them.
+13 IF (FIEN=FNDIEN)!(FIEN="")
SET ^TMP($JOB,SUB,FILENUM,FNDIEN,"LRULE",IEN)=""
End DoDot:1
+14 QUIT
+15 ;
+16 ;==============================
SORT ;Sort by global name and finding name.
+1 NEW FIEN,FILENUM,FNAME,GNAME,STANDARD
+2 KILL ^TMP($JOB,"SDATA")
+3 SET FILENUM=0
+4 FOR
SET FILENUM=$ORDER(^TMP($JOB,"FDATA",FILENUM))
if FILENUM=""
QUIT
Begin DoDot:1
+5 SET GNAME=$$GET1^DID(FILENUM,"","","NAME")
+6 ;DBIA #4640
+7 SET STANDARD=$$SCREEN^HDISVF01(FILENUM)
+8 SET ^TMP($JOB,"SDATA",GNAME)=FILENUM_U_STANDARD
+9 SET FIEN=0
+10 FOR
SET FIEN=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN))
if FIEN=""
QUIT
Begin DoDot:2
+11 SET FNAME=$$GET1^DIQ(FILENUM,FIEN,.01)
+12 IF FNAME=""
SET FNAME="Undefined"
+13 SET ^TMP($JOB,"SDATA",GNAME,FNAME)=FIEN
+14 IF STANDARD
Begin DoDot:3
+15 NEW REPFNAME,REPFNUM,REPGNAME,REPIEN,STATUS
+16 ;DBIA #4631
+17 SET STATUS=$PIECE($$GETSTAT^XTID(FILENUM,.01,FIEN_","),U,3)
+18 IF STATUS=""
SET STATUS="undefined"
+19 SET ^TMP($JOB,"SDATA",GNAME,FNAME,"STD")=STATUS
+20 SET REP=$$RPLCMNT^XTIDTRM(FILENUM,FIEN)
+21 IF REP=(FIEN_";"_FILENUM)
SET REP=""
+22 IF REP'=""
Begin DoDot:4
+23 SET REPIEN=$PIECE(REP,";",1)
+24 SET REPFNUM=$PIECE(REP,";",2)
+25 SET REPGNAME=$$GET1^DID(REPFNUM,"","","NAME")
+26 SET REPFNAME=$$GET1^DIQ(REPFNUM,REPIEN,.01)
+27 SET ^TMP($JOB,"SDATA",GNAME,FNAME,"STD","REP")=REPGNAME_U_REPFNAME
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
+30 ;==============================
TERMLIST(FILENUM,GBL,FIEN,SUB) ;Search reminder terms for any that are using
+1 ;GBL as a finding. If FIEN is not null then search for only those
+2 ;findings.
+3 NEW FI,FNDIEN,IEN
+4 SET IEN=0
+5 FOR
SET IEN=+$ORDER(^PXRMD(811.5,IEN))
if IEN=0
QUIT
Begin DoDot:1
+6 IF '$DATA(^PXRMD(811.5,IEN,20,"E",GBL))
QUIT
+7 IF +FIEN>0
Begin DoDot:2
+8 SET FI=""
+9 FOR
SET FI=$ORDER(^PXRMD(811.5,IEN,20,"E",GBL,FIEN,FI))
if FI=""
QUIT
Begin DoDot:3
+10 SET ^TMP($JOB,SUB,FILENUM,FIEN,"TERM",IEN,FI)=""
End DoDot:3
End DoDot:2
+11 IF +FIEN=0
Begin DoDot:2
+12 ;No finding specified find, all of them.
+13 SET FNDIEN=""
+14 FOR
SET FNDIEN=$ORDER(^PXRMD(811.5,IEN,20,"E",GBL,FNDIEN))
if FNDIEN=""
QUIT
Begin DoDot:3
+15 SET FI=""
+16 FOR
SET FI=$ORDER(^PXRMD(811.5,IEN,20,"E",GBL,FNDIEN,FI))
if FI=""
QUIT
Begin DoDot:4
+17 SET ^TMP($JOB,SUB,FILENUM,FNDIEN,"TERM",IEN,FI)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
