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

PXRMTERM.m

Go to the documentation of this file. 
  1. PXRMTERM ;SLC/PKR - Handle reminder terms. ;10-Jun-2015 11:41;du
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,1001,11,18,26,1005**;Feb 04, 2005;Build 23
  1.  ;
  1.  ;IHS/MSC/MGH Patch 1001 added call for V measurements
  1.  ;=============================================
  1. COPY(NOCC,SDIR,TFIEVAL,DATEORDR,FINDING,FIEVAL,STF) ;Copy the NOCC date ordered
  1.  ;findings from TFIEVAL to FIEVAL(FINDING).
  1.  N DATE,IND,JND,MRS,NFOUND,TFI
  1.  ;Start with most recent and go to oldest finding.
  1.  S MRS=1
  1.  S NFOUND=0
  1.  S DATE=""
  1.  F  S DATE=$O(DATEORDR(DATE),SDIR) Q:(NFOUND=NOCC)!(DATE="")  D
  1.  . S TFI=0
  1.  . F  S TFI=$O(DATEORDR(DATE,TFI)) Q:(NFOUND=NOCC)!(TFI="")  D
  1.  .. I MRS D
  1.  ...;Save the main result node.
  1.  ... S FIEVAL(FINDING)=TFIEVAL(TFI)
  1.  ... S MRS=0
  1.  ... I 'FIEVAL(FINDING) Q
  1.  ... S JND="@"
  1.  ... F  S JND=$O(TFIEVAL(TFI,JND)) Q:JND=""  M FIEVAL(FINDING,JND)=TFIEVAL(TFI,JND)
  1.  .. I 'FIEVAL(FINDING) Q
  1.  .. S IND=0
  1.  .. F  S IND=$O(DATEORDR(DATE,TFI,IND)) Q:(NFOUND=NOCC)!(IND="")  D
  1.  ...;Only save true sub-results.
  1.  ... I 'TFIEVAL(TFI,IND) Q
  1.  ... S NFOUND=NFOUND+1
  1.  ... M FIEVAL(FINDING,NFOUND)=TFIEVAL(TFI,IND)
  1.  ... S FIEVAL(FINDING,NFOUND,"FILE NUMBER")=TFIEVAL(TFI,"FILE NUMBER")
  1.  ... S FIEVAL(FINDING,NFOUND,"FINDING")=TFIEVAL(TFI,"FINDING")
  1.  ... I STF S FIEVAL(FINDING,NFOUND,"TERM FINDING")=TFI
  1.  ... S JND=0
  1.  ... F  S JND=$O(TFIEVAL(TFI,IND,JND)) Q:JND=""  M FIEVAL(FINDING,NFOUND,JND)=TFIEVAL(TFI,IND,JND)
  1.  Q
  1.  ;
  1.  ;=============================================
  1. DORDER(TFIEVAL,DATEORDR) ;Order term findings by date, term finding,
  1.  ;and term finding occurrence.
  1.  N DATE,FI,IND
  1.  K DATEORDR
  1.  S FI=0
  1.  F  S FI=+$O(TFIEVAL(FI)) Q:FI=0  D
  1.  . S IND=0
  1.  . F  S IND=+$O(TFIEVAL(FI,IND)) Q:IND=0  D
  1.  .. S DATE=$G(TFIEVAL(FI,IND,"DATE"))
  1.  .. I DATE'="" S DATEORDR(DATE,FI,IND)=""
  1.  Q
  1.  ;
  1.  ;=============================================
  1. EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate all reminder terms in a
  1.  ;definition.
  1.  N CASESEN,CONVAL,DATE,DATEORDR
  1.  N FIEVT,FINDING,FINDPA,IND,NOCC
  1.  N SDIR,TFIND3,TFIND4,TERMARR,TERMIEN,TFI,TFIEVAL,UCIFS
  1.  S TERMIEN=""
  1.  F  S TERMIEN=$O(DEFARR("E",ENODE,TERMIEN)) Q:+TERMIEN=0  D
  1.  . I '$D(^PXRMD(811.5,TERMIEN,20,"E")) D  Q
  1.  .. S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFI",TERMIEN)="Warning no findings items in reminder term "_$P(^PXRMD(811.5,TERMIEN,0),U,1)
  1.  .. S FINDING=""
  1.  .. F  S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:FINDING=""  S FIEVAL(FINDING)=0
  1.  . D TERM^PXRMLDR(TERMIEN,.TERMARR)
  1.  . S FINDING=""
  1.  . F  S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:+FINDING=0  D
  1.  .. S FIEVAL(FINDING)=0
  1.  .. S FIEVAL(FINDING,"TERM")=TERMARR(0)
  1.  .. S FIEVAL(FINDING,"TERM IEN")=TERMIEN
  1.  .. K FINDPA,TFIEVAL
  1.  .. M FINDPA=DEFARR(20,FINDING)
  1.  .. D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
  1.  .. I $G(PXRMTDEB) M ^TMP("PXRMTDEB",$J,FINDING)=TFIEVAL
  1.  ..;Set NOCC and SDIR.
  1.  .. S NOCC=$P(FINDPA(0),U,14)
  1.  .. I NOCC="" S NOCC=1
  1.  .. S SDIR=$S(NOCC<0:+1,1:-1)
  1.  .. S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
  1.  ..;Order the term findings by date.
  1.  .. D DORDER(.TFIEVAL,.DATEORDR)
  1.  .. D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL,1)
  1.  .. S IND=0
  1.  .. F  S IND=+$O(FIEVAL(FINDING,IND)) Q:IND=0  S FIEVAL(FINDING,IND,"TERM FINDING")=$P(TERMARR(20,FIEVAL(FINDING,IND,"TERM FINDING"),0),U,1)
  1.  Q
  1.  ;
  1.  ;=============================================
  1. EVALTERM(DFN,FINDPA,TERMARR,TFIEVAL) ;Evaluate all the findings in
  1.  ;a term. Use the "E" cross-reference just like the finding evaluation.
  1.  N ENODE,PXRMDEFS
  1.  S ENODE=""
  1.  F  S ENODE=$O(TERMARR("E",ENODE)) Q:ENODE=""  D
  1.  . I ENODE="AUTTEDT(" D EVALTERM^PXRMEDU(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="AUTTEXAM(" D EVALTERM^PXRMEXAM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="AUTTHF(" D EVALTERM^PXRMHF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="AUTTIMM(" D EVALTERM^PXRMIMM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="AUTTSK(" D EVALTERM^PXRMSKIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="GMRD(120.51," D EVALTERM^PXRMVITL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="LAB(60," D EVALTERM^PXRMLAB(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="ORD(101.43," D EVALTERM^PXRMORDR(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PXD(811.2," D EVALTERM^PXRMTAX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PXRMD(810.9," D EVALTERM^PXRMLOCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PXRMD(811.4," D EVALTERM^PXRMCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PS(50.605," D EVALTERM^PXRMDRCL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PS(55," D EVALTERM^PXRMDIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PS(55NVA," D EVALTERM^PXRMDNVA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PSDRUG(" D EVALTERM^PXRMDRUG(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PSRX(" D EVALTERM^PXRMDOUT(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="PSNDF(50.6," D EVALTERM^PXRMDGEN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="RAMIS(71," D EVALTERM^PXRMRAD(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  . I ENODE="YTT(601.71," D EVALTERM^PXRMMH(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  .;IHS/MSC/MGH added calls for V files
  1.  .I ENODE="AUTTMSR(" D EVALTERM^BPXRMEA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
  1.  Q
  1.  ;
  1.  ;=============================================
  1. IEVALTER(DFN,FINDPA,TERMARR,FINDING,FIEVAL) ;Evaluate an individual term
  1.  ;put the result in FIEVAL(FINDING).
  1.  N DATEORDR,NOCC,SDIR,TFIEVAL
  1.  I '$D(PXRMDATE) N PXRMDATE S PXRMDATE=DT
  1.  I $D(PXRMPDEM) G DEMOK
  1.  N PXRMPDEM D DEM^PXRMPINF(DFN,DT,.PXRMPDEM)
  1.  ;Create the local demographic variables for use in Condition.
  1.  N PXRMAGE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMSEX
  1.  S PXRMAGE=PXRMPDEM("AGE"),PXRMDOB=PXRMPDEM("DOB"),PXRMDOD=PXRMPDEM("DOD")
  1.  S PXRMLAD=PXRMPDEM("LAD"),PXRMSEX=PXRMPDEM("SEX")
  1. DEMOK S FIEVAL(FINDING)=0
  1.  D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
  1.  ;Set NOCC and SDIR.
  1.  S NOCC=$P(FINDPA(0),U,14)
  1.  I NOCC="" S NOCC=1
  1.  S SDIR=$S(NOCC<0:+1,1:-1)
  1.  S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
  1.  ;Order the term findings by date.
  1.  D DORDER(.TFIEVAL,.DATEORDR)
  1.  D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL,0)
  1.  K ^TMP($J,"SVC",DFN)
  1.  Q
  1.  ;
  1.  ;=============================================
  1. MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
  1.  D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"MHV")
  1.  Q
  1.  ;
  1.  ;=============================================
  1. OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
  1.  ;maintenance output.
  1.  D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"CM")
  1.  Q
  1.  ;
  1.  ;=============================================
  1. OPT(INDENT,IFIEVAL,NLINES,TEXT,TYPE) ;General output.
  1.  N DG,DGL,DGN,IEN,IND,JND,KND,INDENTT,FILENUM,TEMP,TIFIEVAL
  1.  ;Build the display grouping.
  1.  S FILENUM=IFIEVAL(1,"FILE NUMBER")
  1.  S IEN=$P(IFIEVAL(1,"FINDING"),";",1)
  1.  S DG(FILENUM,IEN)=1,DGL(1)=FILENUM_U_IEN,DGL(1,1)=""
  1.  S (DGN,IND)=1
  1.  F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
  1.  . S FILENUM=IFIEVAL(IND,"FILE NUMBER")
  1.  . S IEN=$P(IFIEVAL(IND,"FINDING"),";",1)
  1.  . I '$D(DG(FILENUM,IEN)) D
  1.  .. S DGN=DGN+1,DG(FILENUM,IEN)=DGN
  1.  .. S DGL(DGN)=FILENUM_U_IEN,DGL(DGN,IND)=""
  1.  . I $D(DG(FILENUM,IEN)) D
  1.  .. S TEMP=DG(FILENUM,IEN),DGL(TEMP,IND)=""
  1.  S INDENTT=INDENT+1
  1.  S TEMP=$$INSCHR^PXRMEXLC(INDENT," ")_"Reminder Term: "_$P(FIEVAL(FINDING,"TERM"),U,1)
  1.  S NLINES=NLINES+1,TEXT(NLINES)=TEMP
  1.  F IND=1:1:DGN D
  1.  . K TIFIEVAL
  1.  . S (JND,KND)=0
  1.  . F  S JND=$O(DGL(IND,JND)) Q:JND=""  D
  1.  .. S KND=KND+1
  1.  .. I KND=1 M TIFIEVAL=IFIEVAL(JND)
  1.  .. M TIFIEVAL(KND)=IFIEVAL(JND)
  1.  . I TYPE="CM" D FOUT^PXRMOUTC(INDENTT,.TIFIEVAL,.NLINES,.TEXT)
  1.  . I TYPE="MHV" D FOUT^PXRMOUTM(INDENTT,.TIFIEVAL,.NLINES,.TEXT)
  1.  Q
  1.  ;
  1.  ;=============================================
  1. SPFINDPA(FINDPA,TFINDPA,PFINDPA) ;Set the finding parameter array
  1.  ;for terms.
  1.  N FIND0,PIECE,PFIND0,TFIND0,VAL
  1.  S FIND0=$G(FINDPA(0))
  1.  S (PFIND0,TFIND0)=TFINDPA(0)
  1.  ;Set the 0 node.
  1.  F PIECE=9,10,12,13,14,15,16 D
  1.  . S VAL=$P(TFIND0,U,PIECE)
  1.  . I VAL="" S VAL=$P(FIND0,U,PIECE)
  1.  . S $P(PFIND0,U,PIECE)=VAL
  1.  ;BDT and EDT are treated as a pair.
  1.  I $P(TFIND0,U,8)="",$P(TFIND0,U,11)="" F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(FIND0,U,PIECE)
  1.  E  F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(TFIND0,U,PIECE)
  1.  S PFINDPA(0)=PFIND0
  1.  I $P($G(TFINDPA(3)),U,1)'="" S PFINDPA(3)=TFINDPA(3),PFINDPA(10)=TFINDPA(10),PFINDPA(11)=TFINDPA(11)
  1.  E  S PFINDPA(3)=$G(FINDPA(3)),PFINDPA(10)=$G(FINDPA(10)),PFINDPA(11)=$G(FINDPA(11))
  1.  ;Get the status list.
  1.  I $D(TFINDPA(5)) M PFINDPA(5)=TFINDPA(5)
  1.  E  M PFINDPA(5)=FINDPA(5)
  1.  I $D(TFINDPA(15)) S PFINDPA(15)=TFINDPA(15)
  1.  E  S PFINDPA(15)=$G(FINDPA(15))
  1.  Q
  1.  ;