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

PXRMFRPT.m

Go to the documentation of this file. 
  1. PXRMFRPT ;SLC/PKR - Finding usage report. ;06/11/2013
  1.  ;;2.0;CLINICAL REMINDERS;**12,17,16,18,22,26**;Feb 04, 2005;Build 404
  1.  ;==============================
  1. BLDLIST(FILENUM,GBL,FIEN,SUB) ;
  1.  I FILENUM'=811.9 D DEFLIST(FILENUM,GBL,FIEN,SUB)
  1.  I FILENUM'=811.5 D TERMLIST(FILENUM,GBL,FIEN,SUB)
  1.  D DIALOG(FILENUM,GBL,FIEN,SUB)
  1.  D OIGLIST(FILENUM,GBL,FIEN,SUB)
  1.  I (FILENUM=811.5)!(FILENUM=811.9) D
  1.  . D OCRLIST(FILENUM,GBL,FIEN,SUB)
  1.  . D RSETLIST(FILENUM,GBL,FIEN,SUB)
  1.  Q
  1.  ;
  1.  ;==============================
  1. 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
  1.  ;those findings.
  1.  N FI,FNDIEN,IEN
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0  D
  1.  . I '$D(^PXD(811.9,IEN,20,"E",GBL)) Q
  1.  . I +FIEN>0 D
  1.  .. S FI=""
  1.  .. F  S FI=$O(^PXD(811.9,IEN,20,"E",GBL,FIEN,FI)) Q:FI=""  D
  1.  ... S ^TMP($J,SUB,FILENUM,FIEN,"DEF",IEN,FI)=""
  1.  . I +FIEN=0 D
  1.  ..;No finding specified, find all of them.
  1.  .. S FNDIEN=""
  1.  .. F  S FNDIEN=$O(^PXD(811.9,IEN,20,"E",GBL,FNDIEN)) Q:FNDIEN=""  D
  1.  ... S FI=""
  1.  ... F  S FI=$O(^PXD(811.9,IEN,20,"E",GBL,FNDIEN,FI)) Q:FI=""  D
  1.  .... S ^TMP($J,SUB,FILENUM,FNDIEN,"DEF",IEN,FI)=""
  1.  Q
  1.  ;
  1.  ;==============================
  1. DIALDSAR(OUTPUT) ;
  1.  ;This is used for individual dialog element checks, may be better in a
  1.  ;different routine
  1.  N FILENUM,IND,STATUS,TEMP
  1.  S IND=0 F  S IND=+$O(^DD(801.41,15,"V",IND)) Q:IND=0  D
  1.  . S TEMP=^DD(801.41,15,"V",IND,0)
  1.  . S FILENUM=$P(TEMP,U)
  1.  .;DBIA #4640
  1.  . S STATUS=+$$GETSTAT^HDISVF01(FILENUM)
  1.  . I STATUS'=6,STATUS'=7 Q
  1.  . S OUTPUT($$ROOT^DILFD(FILENUM))=FILENUM_U_STATUS
  1.  ;DBIA #4640
  1.  S STATUS=+$$GETSTAT^HDISVF01(101.43) I STATUS'=6,STATUS'=7 Q
  1.  S OUTPUT($$ROOT^DILFD("^101.43,"))=101.43_U_STATUS
  1.  Q
  1.  ;
  1.  ;==============================
  1. DIALOG(FILENUM,GBL,FIEN,SUB) ;
  1.  N DIEN,FIELD,FIND
  1.  I '$D(^TMP($J,"DLG FIND")) D BLDDLGTM^PXRMSTS("DLG FIND")
  1.  I +FIEN>0 D  Q
  1.  .I '$D(^TMP($J,"DLG FIND",GBL,FIEN)) Q
  1.  .S DIEN=0
  1.  .F  S DIEN=$O(^TMP($J,"DLG FIND",GBL,FIEN,DIEN)) Q:DIEN'>0  D
  1.  ..S FIELD=""
  1.  ..F  S FIELD=$O(^TMP($J,"DLG FIND",GBL,FIEN,DIEN,FIELD)) Q:FIELD=""  D
  1.  ...S ^TMP($J,SUB,FILENUM,FIEN,"DIALOG",DIEN,FIELD)=""
  1.  ;
  1.  S FIND="" F  S FIND=$O(^TMP($J,"DLG FIND",GBL,FIND)) Q:FIND=""  D
  1.  .S DIEN=0
  1.  .F  S DIEN=$O(^TMP($J,"DLG FIND",GBL,FIND,DIEN)) Q:DIEN'>0  D
  1.  ..S FIELD=""
  1.  ..F  S FIELD=$O(^TMP($J,"DLG FIND",GBL,FIND,DIEN,FIELD)) Q:FIELD=""  D
  1.  ...S ^TMP($J,SUB,FILENUM,FIND,"DIALOG",DIEN,FIELD)=""
  1.  Q
  1.  ;
  1.  ;==============================
  1. FINDDIAL(RESULT,GBL,FIEN) ;
  1.  ;This api is used to return a list of dialogs that contains a specific
  1.  ;finding
  1.  K ^TMP($J,"DLG FIND")
  1.  D BLDDLGTM^PXRMSTS("DLG FIND")
  1.  N DIEN,FIELD,FIND,NAME
  1.  I +FIEN'>0 Q
  1.  I '$D(^TMP($J,"DLG FIND",GBL,FIEN)) Q
  1.  S DIEN=0
  1.  F  S DIEN=$O(^TMP($J,"DLG FIND",GBL,FIEN,DIEN)) Q:DIEN'>0  D
  1.  .S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U) Q:NAME=""
  1.  .S RESULT(NAME)=DIEN
  1.  Q
  1.  ;
  1.  ;==============================
  1. FSEL(FNUM,GBL,GNAME,LIST) ;Build a list of reminder findings and let the user
  1.  ;select from the list.
  1.  N ALIST,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILENUM,FLIST,IND,INUM
  1.  N STAR,TEMP,TLIST,X,Y
  1.  S (IND,INUM)=0
  1.  ;Create a temporary list ordered by file name.
  1.  S TLIST("REMINDER DEFINITION")=811.9
  1.  ;DBIA #2991, #5149 for access to ^DD.
  1.  F  S IND=+$O(^DD(811.902,.01,"V",IND)) Q:IND=0  D
  1.  . S TEMP=^DD(811.902,.01,"V",IND,0)
  1.  . S TLIST($P(TEMP,U,2))=$P(TEMP,U,1)
  1.  ;Scan dialogs for additional findings.
  1.  S IND=0
  1.  F  S IND=+$O(^DD(801.41,15,"V",IND)) Q:IND=0  D
  1.  . S TEMP=^DD(801.41,15,"V",IND,0)
  1.  . S TLIST($P(TEMP,U,2))=$P(TEMP,U,1)
  1.  S IND="",INUM=0
  1.  F  S IND=$O(TLIST(IND)) Q:IND=""  D
  1.  . S INUM=INUM+1
  1.  . S FILENUM=TLIST(IND)
  1.  .;DBIA #4640
  1.  . S STAR=$S($$SCREEN^HDISVF01(FILENUM):" *",1:"")
  1.  . S FLIST(FILENUM)=INUM
  1.  . S GNAME(INUM)=IND
  1.  . S ALIST(INUM)=" "_$J(INUM,4)_" - "_GNAME(INUM)_STAR
  1.  . S FNUM(INUM)=FILENUM
  1.  . S GBL(INUM)=$P($$GET1^DID(FILENUM,"","","GLOBAL NAME"),"^",2)
  1.  M DIR("A")=ALIST
  1.  S DIR("A")="Enter your list for the report"
  1.  S DIR(0)="LO^1:"_INUM
  1.  W !!,"Select from the following reminder findings (* signifies standardized):"
  1.  D ^DIR
  1.  I $D(DIROUT)!$D(DIRUT) S LIST="" Q
  1.  I $D(DUOUT)!$D(DTOUT) S LIST="" Q
  1.  S LIST=Y
  1.  Q
  1.  ;
  1.  ;==============================
  1. ISEL(FNUM,GBL,GNAME,LIST,ITEMLIST) ;See if the user wants selected items or
  1.  ;all from the selected finding types.
  1.  N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IND,LI,NUM,SEL,TEXT,Y
  1.  S DIC(0)="AEMQ"
  1.  S DIR(0)="S^1:ALL;2:SELECTED"
  1.  S DIR("B")="SELECTED"
  1.  S NUM=$L(LIST,",")-1
  1.  F IND=1:1:NUM D
  1.  . S LI=$P(LIST,",",IND)
  1.  . S TEXT="Search for all or selected "_GNAME(LI)
  1.  . S TEXT=TEXT_$S($E(TEXT,$L(TEXT))="S":"?",1:"S?")
  1.  . W !,TEXT
  1.  . D ^DIR
  1.  . I $D(DIROUT)!$D(DIRUT) Q
  1.  . I $D(DUOUT)!$D(DTOUT) Q
  1.  . I Y=1 S ITEMLIST="ALL" Q
  1.  . S DIC=FNUM(LI)
  1.  . S DIC("A")="Select "_GNAME(LI)_": "
  1.  . S SEL=1
  1.  . F  Q:'SEL  D
  1.  .. D ^DIC
  1.  .. I ($D(DTOUT))!($D(DUOUT)) S SEL=0 Q
  1.  .. I Y=-1 S SEL=0 Q
  1.  .. S ITEMLIST(FNUM(LI),$P(Y,U,1))=""
  1.  Q
  1.  ;
  1.  ;==============================
  1. 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
  1.  ;for only those findings.
  1.  I FILENUM=811.5,'$D(^PXD(801.1,"T")) Q
  1.  I FILENUM=811.9,'$D(^PXD(801.1,"R")) Q
  1.  N IEN
  1.  I FILENUM=811.5 D
  1.  . I +FIEN>0 D
  1.  .. S IEN=0
  1.  .. F  S IEN=$O(^PXD(801.1,"T",FIEN,IEN)) Q:IEN'>0  S ^TMP($J,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
  1.  . I +FIEN=0 D
  1.  .. S FIEN=""
  1.  .. F  S FIEN=$O(^PXD(801.1,"T",FIEN)) Q:FIEN=""  D
  1.  ... S IEN=0
  1.  ... F  S IEN=$O(^PXD(801.1,"T",FIEN,IEN)) Q:IEN'>0  S ^TMP($J,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
  1.  I FILENUM=811.9 D
  1.  . I +FIEN>0 D
  1.  .. S IEN=0
  1.  .. F  S IEN=$O(^PXD(801.1,"R",FIEN,IEN)) Q:IEN'>0  S ^TMP($J,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
  1.  . I +FIEN=0 D
  1.  .. S FIEN=""
  1.  .. F  S FIEN=$O(^PXD(801.1,"R",FIEN)) Q:FIEN=""  D
  1.  ... S IEN=0
  1.  ... F  S IEN=$O(^PXD(801.1,"R",FIEN,IEN)) Q:IEN'>0  S ^TMP($J,SUB,FILENUM,FIEN,"OCRULE",IEN)=""
  1.  Q
  1.  ;
  1.  ;==============================
  1. 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
  1.  ;for only those findings.
  1.  N IEN,ITEM,NODE,RIEN,RNAME
  1.  S NODE=$S(FNUM=101.43:"O",FNUM=50.605:"P",FNUM=50:"P",FNUM=50.6:"P",1:"")
  1.  I NODE="" Q
  1.  S ITEM=$S(NODE="P":FIEN_";"_GBL,1:FIEN)
  1.  I +FIEN>0 D  Q
  1.  . I '$D(^PXD(801,NODE,ITEM)) Q
  1.  . S IEN=0 F  S IEN=$O(^PXD(801,NODE,ITEM,IEN)) Q:IEN'>0  D
  1.  .. S ^TMP($J,SUB,FNUM,FIEN,"ROC",IEN)="" Q
  1.  I '$D(^PXD(801,NODE)) Q
  1.  S ITEM="" F  S ITEM=$O(^PXD(801,NODE,ITEM)) Q:ITEM=""  D
  1.  . S FIEN=$S(NODE="P":$P(ITEM,";"),1:ITEM)
  1.  . S IEN=0 F  S IEN=$O(^PXD(801,NODE,ITEM,IEN)) Q:IEN'>0  D
  1.  .. S ^TMP($J,SUB,FNUM,FIEN,"ROC",IEN)=""
  1.  Q
  1.  ;
  1.  ;==============================
  1. REPD ;Main report driver.
  1.  N DONE,FI,FIEN,FIENS,FILES,FILENUM,FNUM,GBL,GNAME,IEN,IND,ITEMLIST
  1.  N LI,LIST,NL,NUM,REP,STATUS,TYPE
  1.  S DONE=0
  1.  W !,"Clinical Reminders Usage Report"
  1.  F  Q:DONE  D
  1.  . K ^TMP($J,"DIALOG MESSAGE"),^TMP($J,"DLG FIND")
  1.  . K ^TMP($J,"FDATA"),^TMP("PXRMXMZ",$J)
  1.  . K FNUM,GBL,GNAME,ITEMLIST,LIST
  1.  .;Get a list of findings for the report.
  1.  . D FSEL(.FNUM,.GBL,.GNAME,.LIST)
  1.  . S NUM=$L(LIST,",")-1
  1.  . I NUM=0 S DONE=1 Q
  1.  . D ISEL(.FNUM,.GBL,.GNAME,.LIST,.ITEMLIST)
  1.  . I '$D(ITEMLIST) Q
  1.  . D BLDDLGTM^PXRMSTS("DLG FIND")
  1.  . F IND=1:1:NUM D
  1.  .. S LI=$P(LIST,",",IND)
  1.  .. I '$D(ITEMLIST(FNUM(LI))) D BLDLIST(FNUM(LI),GBL(LI),"","FDATA") Q
  1.  .. I $D(ITEMLIST(FNUM(LI))) D
  1.  ... S FIEN=""
  1.  ... F  S FIEN=$O(ITEMLIST(FNUM(LI),FIEN)) Q:FIEN=""  D BLDLIST(FNUM(LI),GBL(LI),FIEN,"FDATA")
  1.  .;Process the finding list and generate the MailMan message.
  1.  . D REPORT
  1.  . K ^TMP($J,"FDATA"),^TMP($J,"SDATA"),^TMP("PXRMXMZ",$J),^TMP($J,"DLG FIND")
  1.  Q
  1.  ;
  1.  ;==============================
  1. REPORT ;Generate the report.
  1.  N DTYP,FILENUM,FNAME,FNUMLIST,GNAME,IND,NAME,NL,NOUT,NTYPE
  1.  N REPFNAME,REPGNAME,RNUM,STANDARD,STATUS
  1.  N TEXT,TEXTOUT,TO,TYPELIST
  1.  D SORT
  1.  S FNUMLIST("DEF")=811.9,TYPELIST("DEF")="Reminder Definition"
  1.  S FNUMLIST("DIALOG")=801.41,TYPELIST("DIALOG")="Reminder Dialog"
  1.  S FNUMLIST("LRULE")=810.4,TYPELIST("LRULE")="Reminder List Rule"
  1.  S FNUMLIST("OCRULE")=801.1,TYPELIST("OCRULE")="Reminder Order Check Rules"
  1.  S FNUMLIST("ROC")=801,TYPELIST("ROC")="Reminder Order Check Items Group"
  1.  S FNUMLIST("TERM")=811.5,TYPELIST("TERM")="Reminder Term"
  1.  K ^TMP("PXRMXMZ",$J)
  1.  S NL=1,^TMP("PXRMXMZ",$J,NL,0)="Clinical Reminders finding usage report."
  1.  S GNAME=""
  1.  F  S GNAME=$O(^TMP($J,"SDATA",GNAME)) Q:GNAME=""  D
  1.  . S FILENUM=$P(^TMP($J,"SDATA",GNAME),U,1)
  1.  . S STANDARD=$P(^TMP($J,"SDATA",GNAME),U,2)
  1.  . S NTYPE=0
  1.  . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1.  . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="The following "_GNAME_"(s) are used as follows:"
  1.  . I STANDARD S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="(This file has been standardized.)"
  1.  . S FNAME=""
  1.  . F  S FNAME=$O(^TMP($J,"SDATA",GNAME,FNAME)) Q:FNAME=""  D
  1.  .. S FIEN=^TMP($J,"SDATA",GNAME,FNAME)
  1.  .. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1.  .. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="======================================================="
  1.  .. S TEXT=GNAME_" - "_FNAME_" (IEN="_FIEN_")"
  1.  .. D FORMATS^PXRMTEXT(1,72,TEXT,.NOUT,.TEXTOUT)
  1.  .. F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1.  .. I STANDARD D
  1.  ... S STATUS=^TMP($J,"SDATA",GNAME,FNAME,"STD")
  1.  ... S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="  status is: "_STATUS
  1.  ... I $D(^TMP($J,"SDATA",GNAME,FNAME,"STD","REP")) D
  1.  .... S REPGNAME=$P(^TMP($J,"SDATA",GNAME,FNAME,"STD","REP"),U,1)
  1.  .... S REPFNAME=$P(^TMP($J,"SDATA",GNAME,FNAME,"STD","REP"),U,2)
  1.  .... S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="  its replacement is "_REPGNAME_"; "_REPFNAME
  1.  .. S TYPE=""
  1.  .. F  S TYPE=$O(TYPELIST(TYPE)) Q:TYPE=""  D
  1.  ... I '$D(^TMP($J,"FDATA",FILENUM,FIEN,TYPE)) Q
  1.  ... S NTYPE=NTYPE+1
  1.  ... S RNUM=FNUMLIST(TYPE)
  1.  ... S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1.  ... I NTYPE>1 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="---------------------------------"
  1.  ... S TEXT=" Is used in the following "_TYPELIST(TYPE)_"(s):"
  1.  ... D FORMATS^PXRMTEXT(4,72,TEXT,.NOUT,.TEXTOUT)
  1.  ... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1.  ... S IEN=0
  1.  ... F  S IEN=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN)) Q:IEN=""  D
  1.  .... S NAME=$$GET1^DIQ(RNUM,IEN,.01)
  1.  .... I NAME="" S NAME="Undefined"
  1.  .... S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1.  ....;
  1.  .... I TYPE="DIALOG" D 
  1.  ..... S DTYP=$P(^PXRMD(801.41,IEN,0),U,4)
  1.  ..... S TEXT="Dialog "_$S(DTYP="E":"element",DTYP="G":"group",DTYP="S":"result group",1:"item")
  1.  ..... S TEXT=TEXT_" "_NAME_$S($P(^PXRMD(801.41,IEN,0),U,3)=1:" (Disable)",1:"")_" (IEN="_IEN_")"
  1.  ..... S TEXT=TEXT_", used in the"
  1.  ..... D FORMATS^PXRMTEXT(6,72,TEXT,.NOUT,.TEXTOUT)
  1.  ..... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1.  ..... S FI=0
  1.  ..... F  S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN,FI)) Q:FI=""  D
  1.  ...... S TEXT=$S(FI=15:"Finding Item field",FI=17:"Orderable Item field",FI=18:"Additional Finding field",FI=119:"MH Test field",1:"")
  1.  ...... D FORMATS^PXRMTEXT(8,72,TEXT,.NOUT,.TEXTOUT)
  1.  ...... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1.  ....;
  1.  .... I TYPE'="DIALOG" D
  1.  ..... S TEXT=NAME_" (IEN="_IEN_")"
  1.  ..... D FORMATS^PXRMTEXT(6,72,TEXT,.NOUT,.TEXTOUT)
  1.  ..... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1.  ..... S FI=0
  1.  ..... F  S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,TYPE,IEN,FI)) Q:FI=""  D
  1.  ...... S TEXT="Finding number "_FI
  1.  ...... D FORMATS^PXRMTEXT(8,72,TEXT,.NOUT,.TEXTOUT)
  1.  ...... F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1.  .....;
  1.  ;Deliver the report.
  1.  I NL=1 D  Q
  1.  . W !,"None of the selected findings are used."
  1.  . K ^TMP("PXRMXMZ",$J)
  1.  N ANS,BOP,X
  1.  S BOP=$$BORP^PXRMUTIL("B")
  1.  I BOP="B" D
  1.  . S X="IORESET"
  1.  . D ENDR^%ZISS
  1.  . D BROWSE^DDBR("^TMP(""PXRMXMZ"",$J)","NR","Reminder Usage Report")
  1.  . W IORESET
  1.  . D KILL^%ZISS
  1.  I BOP="P" D GPRINT^PXRMUTIL("^TMP(""PXRMXMZ"",$J)")
  1.  ;Ask the user if they want the report delivered through MailMan.
  1.  S ANS=$$ASKYN^PXRMEUT("N","Deliver the report as a MailMan message")
  1.  I ANS="1" D
  1.  . S TO(DUZ)=""
  1.  . D SEND^PXRMMSG("PXRMXMZ","Clinical Reminders Finding Usage Report",.TO,DUZ)
  1.  K ^TMP("PXRMXMZ",$J)
  1.  Q
  1.  ;
  1.  ;==============================
  1. 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
  1.  ;findings.
  1.  N FNDIEN,IEN,TEMP,TYPE
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXRM(810.4,IEN)) Q:IEN=0  D
  1.  . S TEMP=^PXRM(810.4,IEN,0)
  1.  . S TYPE=$P(TEMP,U,3)
  1.  .;If it is not a finding rule or reminder rule skip it.
  1.  . I (TYPE=3)!(TYPE=5) Q
  1.  . S FNDIEN=+$S(FILENUM=811.5:$P(TEMP,U,7),FILENUM=811.9:$P(TEMP,U,10),1:0)
  1.  . I FNDIEN=0 Q
  1.  .;If no finding specified find, all of them.
  1.  . I (FIEN=FNDIEN)!(FIEN="") S ^TMP($J,SUB,FILENUM,FNDIEN,"LRULE",IEN)=""
  1.  Q
  1.  ;
  1.  ;==============================
  1. SORT ;Sort by global name and finding name.
  1.  N FIEN,FILENUM,FNAME,GNAME,STANDARD
  1.  K ^TMP($J,"SDATA")
  1.  S FILENUM=0
  1.  F  S FILENUM=$O(^TMP($J,"FDATA",FILENUM)) Q:FILENUM=""  D
  1.  . S GNAME=$$GET1^DID(FILENUM,"","","NAME")
  1.  .;DBIA #4640
  1.  . S STANDARD=$$SCREEN^HDISVF01(FILENUM)
  1.  . S ^TMP($J,"SDATA",GNAME)=FILENUM_U_STANDARD
  1.  . S FIEN=0
  1.  . F  S FIEN=$O(^TMP($J,"FDATA",FILENUM,FIEN)) Q:FIEN=""  D
  1.  .. S FNAME=$$GET1^DIQ(FILENUM,FIEN,.01)
  1.  .. I FNAME="" S FNAME="Undefined"
  1.  .. S ^TMP($J,"SDATA",GNAME,FNAME)=FIEN
  1.  .. I STANDARD D
  1.  ... N REPFNAME,REPFNUM,REPGNAME,REPIEN,STATUS
  1.  ...;DBIA #4631
  1.  ... S STATUS=$P($$GETSTAT^XTID(FILENUM,.01,FIEN_","),U,3)
  1.  ... I STATUS="" S STATUS="undefined"
  1.  ... S ^TMP($J,"SDATA",GNAME,FNAME,"STD")=STATUS
  1.  ... S REP=$$RPLCMNT^XTIDTRM(FILENUM,FIEN)
  1.  ... I REP=(FIEN_";"_FILENUM) S REP=""
  1.  ... I REP'="" D
  1.  .... S REPIEN=$P(REP,";",1)
  1.  .... S REPFNUM=$P(REP,";",2)
  1.  .... S REPGNAME=$$GET1^DID(REPFNUM,"","","NAME")
  1.  .... S REPFNAME=$$GET1^DIQ(REPFNUM,REPIEN,.01)
  1.  .... S ^TMP($J,"SDATA",GNAME,FNAME,"STD","REP")=REPGNAME_U_REPFNAME
  1.  Q
  1.  ;
  1.  ;==============================
  1. 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
  1.  ;findings.
  1.  N FI,FNDIEN,IEN
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXRMD(811.5,IEN)) Q:IEN=0  D
  1.  . I '$D(^PXRMD(811.5,IEN,20,"E",GBL)) Q
  1.  . I +FIEN>0 D
  1.  .. S FI=""
  1.  .. F  S FI=$O(^PXRMD(811.5,IEN,20,"E",GBL,FIEN,FI)) Q:FI=""  D
  1.  ... S ^TMP($J,SUB,FILENUM,FIEN,"TERM",IEN,FI)=""
  1.  . I +FIEN=0 D
  1.  ..;No finding specified find, all of them.
  1.  .. S FNDIEN=""
  1.  .. F  S FNDIEN=$O(^PXRMD(811.5,IEN,20,"E",GBL,FNDIEN)) Q:FNDIEN=""  D
  1.  ... S FI=""
  1.  ... F  S FI=$O(^PXRMD(811.5,IEN,20,"E",GBL,FNDIEN,FI)) Q:FI=""  D
  1.  .... S ^TMP($J,SUB,FILENUM,FNDIEN,"TERM",IEN,FI)=""
  1.  Q
  1.  ;