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

PXRMOUTM.m

Go to the documentation of this file. 
  1. PXRMOUTM ; SLC/PKR - MyHealtheVet output. ;04/01/2022
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,17,47,46,42,65**;Feb 04, 2005;Build 438
  1.  ;
  1.  ;================================================
  1. FOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Do output for individual findings 
  1.  ;in the FINDING array.
  1.  I $D(IFIEVAL("TERM")) D MHVOUT^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 MHVOUT^PXRMEDU(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTEXAM(" D MHVOUT^PXRMEXAM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTHF(" D MHVOUT^PXRMHF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTIMM(" D MHVOUT^PXRMIMM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="AUTTSK(" D MHVOUT^PXRMSKIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="GMRD(120.51," D MHVOUT^PXRMVITL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="LAB(60," D MHVOUT^PXRMLAB(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="ORD(101.43," D MHVOUT^PXRMORDR(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PS(50.605," D MHVOUT^PXRMDRCL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PSDRUG(" D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PS(55," D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PS(55NVA," D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PSRX(" D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PSNDF(50.6," D MHVOUT^PXRMDGEN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PXD(811.2," D MHVOUT^PXRMTAX(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PXRMD(802.4," D MHVOUT^PXRMFF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PXRMD(810.9," D MHVOUT^PXRMLOCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="PXRMD(811.4," D MHVOUT^PXRMCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="RAMIS(71," D MHVOUT^PXRMRAD(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  I FTYPE="YTT(601.71," D MHVOUT^PXRMMH(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
  1.  Q
  1.  ;
  1.  ;================================================
  1. MHVC(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,CRSTATUS,FIEVAL) ;Prepare the 
  1.  ;MyHealtheVet combined output.
  1.  N PNAME,RIEN
  1.  S RIEN=DEFARR("IEN")
  1.  S PNAME=$O(^TMP("PXRHM",$J,RIEN,""))
  1.  S ^TMP("PXRMMHVC",$J,RIEN,"FREQ")=$G(^TMP("PXRHM",$J,RIEN,PNAME,"FREQ"))
  1.  S ^TMP("PXRMMHVC",$J,RIEN,"RNAME")=PNAME
  1.  S ^TMP("PXRMMHVC",$J,RIEN,"STATUS")=^TMP("PXRHM",$J,RIEN,PNAME)
  1.  D MHVD(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,CRSTATUS,.FIEVAL,0)
  1.  M ^TMP("PXRMMHVC",$J,RIEN,"DETAIL")=^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
  1.  K ^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
  1.  D MHVS(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,0)
  1.  M ^TMP("PXRMMHVC",$J,RIEN,"SUMMARY")=^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
  1.  K ^TMP("PXRHM",$J,RIEN,PNAME)
  1.  Q
  1.  ;
  1.  ;================================================
  1. MHVD(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,CRSTATUS,FIEVAL,WEB) ;Prepare the 
  1.  ;MyHealtheVet detailed output.
  1.  N IND,JND,FIDATA,FINDING,FLIST,FTYPE
  1.  N HDR,NHDR,IFIEVAL,LIST,NFLINES,NTXT,NUM,NUMLINES
  1.  N TEXT
  1.  S NTXT=0
  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.  M FIDATA=FIEVAL
  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,.FIEVAL,.NTXT)
  1.  . I FTYPE="RES",$P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,FTYPE,"D",.DEFARR,.FIEVAL,.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.  ..;Make sure each finding is processed only once.
  1.  .. I '$D(FIDATA(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.  ..;Output the found/not found text for the finding.
  1.  .. D FINDING^PXRMFNFT(PXRMPDEM("DFN"),FINDING,.FIEVAL,.IFIEVAL,.NFLINES,.TEXT)
  1.  ..;If the finding is true output the finding information.
  1.  .. I IFIEVAL D FOUT(1,.IFIEVAL,.NFLINES,.TEXT)
  1.  ..;Make sure each finding is processed only once.
  1.  .. K FIDATA(FINDING)
  1.  .;
  1.  .;If there was any text for this finding type create a header.
  1.  .;Output the header and the finding text.
  1.  . D COPYTXT^PXRMOUTU(.NTXT,NFLINES,.TEXT)
  1.  ;
  1.  ;If there are any contraindications, precautions, or refusals output them.
  1.  ;Use CRSTATUS and the line counts to determine if the CONTRAINDICATED and
  1.  ;REFUSED true and false text should be output.
  1.  I (CRSTATUS="CONTRA") D
  1.  . S NUMLINES=$P(DEFARR(85),U,1)
  1.  . I NUMLINES>0 D CRLOGIC^PXRMFNFT(PXRMPDEM("DFN"),NUMLINES,83,.NTXT)
  1.  I (CRSTATUS'="CONTRA") D
  1.  . S NUMLINES=$P(DEFARR(85),U,2)
  1.  . I NUMLINES>0 D CRLOGIC^PXRMFNFT(PXRMPDEM("DFN"),NUMLINES,84,.NTXT)
  1.  I (CRSTATUS="REFUSED") D
  1.  . S NUMLINES=$P(DEFARR(95),U,1)
  1.  . I NUMLINES>0 D CRLOGIC^PXRMFNFT(PXRMPDEM("DFN"),NUMLINES,93,.NTXT)
  1.  I (CRSTATUS'="CONTRA"),(CRSTATUS'="REFUSED") D
  1.  . S NUMLINES=$P(DEFARR(95),U,2)
  1.  . I NUMLINES>0 D CRLOGIC^PXRMFNFT(PXRMPDEM("DFN"),NUMLINES,94,.NTXT)
  1.  ;
  1.  I WEB D WEB(DEFARR("IEN"),.NTXT)
  1.  Q
  1.  ;
  1.  ;================================================
  1. MHVS(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the 
  1.  ;MyHealtheVet summary output.
  1.  N NTXT
  1.  S NTXT=0
  1.  D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,"PCL","S",.DEFARR,.NTXT)
  1.  I $P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,"RES","S",.DEFARR,.NTXT)
  1.  I WEB D WEB(DEFARR("IEN"),.NTXT)
  1.  Q
  1.  ;
  1.  ;================================================
  1. WEB(RIEN,NTXT) ;Output the web site information.
  1.  N DES,IEN,IND,NL,TEXT,TITLE,URL
  1.  I '$D(^PXD(811.9,RIEN,50)) Q
  1.  S TEXT="\\ Please check these web sites for more information:\\"
  1.  D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXD(811.9,RIEN,50,IEN)) Q:IEN=0  D
  1.  . S TEXT=$G(^PXD(811.9,RIEN,50,IEN,0))
  1.  . S URL=$P(TEXT,U,1)
  1.  . I URL="" Q
  1.  . S TITLE=$P(TEXT,U,2)
  1.  . S DES=$D(^PXD(811.9,RIEN,50,IEN,1))
  1.  . S TEXT(1)="Web Site: "_TITLE_"\\"
  1.  . S TEXT(2)="URL: "_URL_$S('DES:"\\",1:"")
  1.  . D ADDTXTA^PXRMOUTU(2,PXRMRM,.NTXT,2,.TEXT)
  1.  .;If there is a description output it.
  1.  . I 'DES Q
  1.  . K TEXT
  1.  . S (IND,NL)=0
  1.  .  F  S IND=+$O(^PXD(811.9,RIEN,50,IEN,1,IND)) Q:IND=0  D
  1.  .. S NL=NL+1
  1.  .. S TEXT(NL)=^PXD(811.9,RIEN,50,IEN,1,IND,0)
  1.  . S TEXT(NL)=TEXT(NL)_"\\"
  1.  . D ADDTXTA^PXRMOUTU(3,PXRMRM,.NTXT,NL,.TEXT)
  1.  Q
  1.  ;