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

PXRMOUTC.m

Go to the documentation of this file. 
  1. PXRMOUTC ; SLC/PKR - Clinical Maintenance output. ;13-Apr-2015 10:44;DU
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,1001,17,26,1005**;Feb 04, 2005;Build 23
  1.  ;IHS/MSC/MGH Added lookup for non-VA files
  1.  ;================================================
  1. CM(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,OUTTYPE) ;Prepare the
  1.  ;Clinical maintenance (OUTTYPE=5) and order check (OUTTPYPE=55)
  1.  ;output.
  1.  N IND,JND,FINDING,FLIST,FTYPE
  1.  N HDR,NHDR,IFIEVAL,LIST,NFLINES,NTXT,NUM
  1.  N TEMP,TEXT
  1.  S NTXT=0
  1.  ;Check for a dead patient
  1.  I +$G(PXRMPDEM("DOD"))>0 D
  1.  . S TEMP=$$FMTE^XLFDT(PXRMPDEM("DOD"),"5DZ")
  1.  . S TEXT="Patient is deceased, date of death: "_TEMP
  1.  . D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
  1.  ;Display the frequency information only if there is resolution logic.
  1.  I RESLOGIC'="",OUTTYPE=5 D FREQ(.DEFARR,.NTXT,.TEXT)
  1.  ;Output the AGE match/no match text.
  1.  D AGE^PXRMFNFT(PXRMPDEM("DFN"),.DEFARR,.FIEVAL,.NTXT)
  1.  ;Process the findings in the order: patient cohort, resolution,
  1.  ;age, and informational.
  1.  F FTYPE="PCL","RES","AGE","INFO" D
  1.  . S LIST=$S(FTYPE="PCL":DEFARR(32),FTYPE="RES":DEFARR(36),FTYPE="AGE":DEFARR(40),FTYPE="INFO":DEFARR(42))
  1.  .;Output the general logic text.
  1.  . I FTYPE="PCL" D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,FTYPE,"D",.DEFARR,.NTXT)
  1.  . I FTYPE="RES",$P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,FTYPE,"D",.DEFARR,.NTXT)
  1.  .;Process the findings for each type.
  1.  . K TEXT
  1.  . S (NHDR,NFLINES)=0
  1.  . S NUM=+$P(LIST,U,1)
  1.  . S FLIST=$P(LIST,U,2)
  1.  . F IND=1:1:NUM D
  1.  .. S FINDING=$P(FLIST,";",IND)
  1.  ..;No output for age or sex findings.
  1.  .. I (FINDING="AGE")!(FINDING="SEX") Q
  1.  ..;If the finding is not defined skip it. This can occur when the
  1.  ..;reminder is N/A.
  1.  .. I '$D(FIEVAL(FINDING)) Q
  1.  .. K IFIEVAL
  1.  .. I FIEVAL(FINDING) D
  1.  ... M IFIEVAL=FIEVAL(FINDING)
  1.  ...;Remove any false occurrences so they are not displayed.
  1.  ... S JND=0
  1.  ... F  S JND=+$O(IFIEVAL(JND)) Q:JND=0  K:'IFIEVAL(JND) IFIEVAL(JND)
  1.  .. E  S IFIEVAL=0
  1.  ..;If the regular finding is false all we need to do is process the
  1.  ..;not found text. If it is true we also need to output the finding
  1.  ..;information.
  1.  ..;Function findings are processed as a group.
  1.  .. I IFIEVAL,FINDING'["FF" D FOUT(1,.IFIEVAL,.NFLINES,.TEXT)
  1.  ..;Output the found/not found text for the finding.
  1.  .. D FINDING^PXRMFNFT(3,PXRMPDEM("DFN"),FINDING,.IFIEVAL,.NFLINES,.TEXT)
  1.  .;
  1.  .;Display function finding values for this FTYPE, skip INFO only.
  1.  . I (FTYPE'="INFO"),(FLIST["FF") D FFOUT(3,NUM,FLIST,.FIEVAL,.NFLINES,.TEXT)
  1.  .;If there was any text for this finding type create a header.
  1.  . I OUTTYPE=5 D HEADER(FTYPE,NFLINES,RESDATE,.NHDR,.HDR)
  1.  .;Output the header and the finding text.
  1.  . D ADDTXTA^PXRMOUTU(1,PXRMRM,.NTXT,NHDR,.HDR)
  1.  . D COPYTXT^PXRMOUTU(.NTXT,NFLINES,.TEXT)
  1.  ;Output INFO nodes
  1.  D INFO^PXRMOUTU(PXRMITEM,.NTXT)
  1.  Q
  1.  ;
  1.  ;================================================
  1. FOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Do output for individual findings
  1.  ;in the FINDING array.
  1.  I $D(IFIEVAL("TERM")) D OUTPUT^PXRMTERM(1,.IFIEVAL,.NFLINES,.TEXT) Q
  1.  N FTYPE
  1.  S FTYPE=$P(IFIEVAL("FINDING"),U,1)
  1.  S FTYPE=$P(FTYPE,";",2)
  1.  I FTYPE="AUTTEDT(" D OUTPUT^PXRMEDU(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTEXAM(" D OUTPUT^PXRMEXAM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTHF(" D OUTPUT^PXRMHF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTIMM(" D OUTPUT^PXRMIMM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTSK(" D OUTPUT^PXRMSKIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="GMRD(120.51," D OUTPUT^PXRMVITL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="LAB(60," D OUTPUT^PXRMLAB(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="ORD(101.43," D OUTPUT^PXRMORDR(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PS(50.605," D OUTPUT^PXRMDRCL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PSDRUG(" D OUTPUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PSNDF(50.6," D OUTPUT^PXRMDGEN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PS(55," D OUTPUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PS(55NVA," D OUTPUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PSRX(" D OUTPUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PXD(811.2," D OUTPUT^PXRMTAX(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PXRMD(802.4," D OUTPUT^PXRMFF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PXRMD(810.9," D OUTPUT^PXRMLOCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PXRMD(811.4," D OUTPUT^PXRMCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="RAMIS(71," D OUTPUT^PXRMRAD(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="YTT(601.71," D OUTPUT^PXRMMH(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  ;IHS/MSC/MGH Added lookup for non-VA files
  1.  I FTYPE="AUTTMSR(" D OUTPUT^BPXRMEA(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTREFT(" D OUTPUT^BPXRMREF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="APCDACV(" D OUTPUT^BPXRMAS1(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  Q
  1.  ;
  1.  ;================================================
  1. FFOUT(INDENT,NUM,FLIST,FIEVAL,NLINES,TEXT) ;Output for function findings.
  1.  I '$D(PXRMDEBG) Q
  1.  N IND,FFNUM,FFLIST,FFTEXT,FINDING,NOUT,TEXTOUT
  1.  F IND=1:1:NUM D
  1.  . S FINDING=$P(FLIST,";",IND)
  1.  . I '$D(FIEVAL(FINDING)) Q
  1.  . I $E(FINDING,1,2)="FF" S FFNUM=$P(FINDING,"FF",2),FFLIST(FFNUM)=""
  1.  I '$D(FFLIST) Q
  1.  S FFNUM=$O(FFLIST(0))
  1.  S FFTEXT="FF("_FFNUM_")="_FIEVAL("FF"_FFNUM)
  1.  F  S FFNUM=$O(FFLIST(FFNUM)) Q:FFNUM=""  D
  1.  . S FFTEXT=FFTEXT_", FF("_FFNUM_")="_FIEVAL("FF"_FFNUM)
  1.  S NLINES=NLINES+1,TEXT(NLINES)=""
  1.  D FORMATS^PXRMTEXT(INDENT,PXRMRM,FFTEXT,.NOUT,.TEXTOUT)
  1.  F IND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(IND)
  1.  Q
  1.  ;
  1.  ;================================================
  1. FREQ(DEFARR,NTXT,TEXT) ;Display the frequency information.
  1.  N FREQ,TEMP
  1.  ;If there was a custom date due print out that information.
  1.  I $D(^TMP(PXRMPID,$J,PXRMITEM,"zCDUE")) D
  1.  . S TEMP=^TMP(PXRMPID,$J,PXRMITEM,"zCDUE")
  1.  . S TEXT=$$OUTPUT^PXRMCDUE(TEMP,.DEFARR)
  1.  . I DEFARR(31)["AGE" D
  1.  .. S TEMP=$G(^TMP(PXRMPID,$J,PXRMITEM,"zFREQARNG"))
  1.  .. I TEMP'="" S TEXT=TEXT_" Applicable"_$$FMTAGE^PXRMAGE($P(TEMP,U,2),$P(TEMP,U,3))_"."
  1.  . D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
  1.  E  D
  1.  . S TEMP=$G(^TMP(PXRMPID,$J,PXRMITEM,"zFREQARNG"))
  1.  . I TEMP'="" D
  1.  .. S FREQ=$P(TEMP,U,1)
  1.  .. S TEXT=$$FMTFREQ^PXRMAGE(FREQ)
  1.  .. I FREQ=-1 S TEXT=TEXT_" for this patient."
  1.  .. I DEFARR(31)["AGE",FREQ'=-1 S TEXT=TEXT_$$FMTAGE^PXRMAGE($P(TEMP,U,2),$P(TEMP,U,3))_"."
  1.  .. D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
  1.  Q
  1.  ;
  1.  ;================================================
  1.  K HDR
  1.  I FTYPE="RES" D  Q
  1.  . I +RESDATE'=0 D  Q
  1.  .. S HDR(2)="Resolution: Last done - "_$$EDATE^PXRMDATE(RESDATE)
  1.  .. S NHDR=2
  1.  .. S HDR(1)="\\"
  1.  . I '$D(HDR(2)),NLINES>0 D
  1.  .. S HDR(2)="Resolution:"
  1.  .. S NHDR=2
  1.  .. S HDR(1)="\\"
  1.  ;
  1.  I NLINES=0 Q
  1.  I FTYPE="PCL" D  Q
  1.  . S NHDR=2
  1.  . S HDR(1)="\\"
  1.  . S HDR(2)="Cohort:"
  1.  ;
  1.  I FTYPE="AGE" D  Q
  1.  . S NHDR=2
  1.  . S HDR(1)="\\"
  1.  . S HDR(2)="Age/Frequency:"
  1.  ;
  1.  I FTYPE="INFO" D  Q
  1.  . S NHDR=2
  1.  . S HDR(1)="\\"
  1.  . S HDR(2)="Information:"
  1.  Q
  1.  ;