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

PXRMDGPT.m

Go to the documentation of this file. 
  1. PXRMDGPT ; SLC/PKR - Code to handle DGPT (Patient Treatment File) data. ;10/11/2012
  1.  ;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404
  1.  ;
  1.  ;============================================
  1. FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
  1.  N CODE,CODESYS,DA,DAS,DATE,DNODE,DS,EDTT,IND
  1.  N NFOUND,NODE,NODEAT,NNODES,TDATE,TIND,TLIST
  1.  S NNODES=TAXARR("APDS",45,"NNODES")
  1.  I NNODES=0 Q
  1.  I $G(^PXRMINDX(45,"DATE BUILT"))="" D  Q
  1.  . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),45)
  1.  S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1.  S DS=$S(SDIR=+1:BDT-.000001,1:EDTT)
  1.  S CODESYS="",NFOUND=0
  1.  F  S CODESYS=$O(TAXARR("AE",CODESYS)) Q:CODESYS=""  D
  1.  . I '$D(^PXRMINDX(45,CODESYS,"PNI",DFN)) Q
  1.  . F IND=1:1:NNODES D
  1.  .. S NODE=TAXARR("APDS",45,IND)
  1.  .. I '$D(^PXRMINDX(45,CODESYS,"PNI",DFN,NODE)) Q
  1.  .. S CODE=""
  1.  .. F  S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE=""  D 
  1.  ... I '$D(^PXRMINDX(45,CODESYS,"PNI",DFN,NODE,CODE)) Q
  1.  ... S DATE=DS
  1.  ... F  S DATE=+$O(^PXRMINDX(45,CODESYS,"PNI",DFN,NODE,CODE,DATE),SDIR) Q:$S(DATE=0:1,DATE<BDT:1,DATE>EDTT:1,1:0)  D
  1.  .... S DAS=""
  1.  .... F  S DAS=$O(^PXRMINDX(45,CODESYS,"PNI",DFN,NODE,CODE,DATE,DAS)) Q:DAS=""  D
  1.  ..... S NFOUND=NFOUND+1
  1.  ..... S TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_CODE_U_NODE
  1.  ..... I NFOUND>NGET D
  1.  ...... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
  1.  ...... K TLIST(TDATE,TIND)
  1.  ;
  1.  ;Return up to NGET of the most recent entries.
  1.  S NFOUND=0
  1.  S DATE=""
  1.  F  S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NGET)  D
  1.  . S IND=0
  1.  . F  S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NGET)  D
  1.  .. S NFOUND=NFOUND+1
  1.  .. S FLIST(DATE,NFOUND,45)=TLIST(DATE,IND)
  1.  Q
  1.  ;
  1.  ;============================================
  1. GETDATA(DAS,FIEVT) ;Return data for a specificed PTF entry.
  1.  ;DBIA #4457
  1.  D PTF^DGPTPXRM(DAS,.FIEVT)
  1.  Q
  1.  ;
  1.  ;============================================
  1. GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Get data for a patient.
  1.  N CODE,CODESYS,DA,DA1,DAS,DATE,DFN,DNODE,DS
  1.  N NFOUND,NODE,NNODES,TEMP,TLIST
  1.  I $G(^PXRMINDX(45,"DATE BUILT"))="" D  Q
  1.  . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),45)
  1.  S TLIST="GPLIST_PXRMDGPT"
  1.  K ^TMP($J,TLIST)
  1.  S NNODES=TAXARR("APDS",45,"NNODES")
  1.  I NNODES=0 Q
  1.  S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1.  S CODESYS=""
  1.  F  S CODESYS=$O(TAXARR("AE",CODESYS)) Q:CODESYS=""  D
  1.  . I '$D(^PXRMINDX(45,CODESYS,"INP")) Q
  1.  . S CODE=""
  1.  . F  S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE=""  D
  1.  .. I '$D(^PXRMINDX(45,CODESYS,"INP",CODE)) Q
  1.  .. F IND=1:1:NNODES D
  1.  ... S NODE=TAXARR("APDS",45,IND)
  1.  ... I '$D(^PXRMINDX(45,CODESYS,"INP",CODE,NODE)) Q
  1.  ... S DFN=0
  1.  ... F  S DFN=$O(^PXRMINDX(45,CODESYS,"INP",CODE,NODE,DFN)) Q:DFN=""  D
  1.  .... S DATE=DS
  1.  .... F  S DATE=+$O(^PXRMINDX(45,CODESYS,"INP",CODE,NODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)  D
  1.  ..... S DAS=$O(^PXRMINDX(45,CODESYS,"INP",CODE,NODE,DFN,DATE,""))
  1.  ..... S ^TMP($J,TLIST,DFN,DATE,DAS)=CODE_U_CODESYS_U_NODE
  1.  ;Return up to NOCC of the most recent entries for each patient.
  1.  S DFN=0
  1.  F  S DFN=$O(^TMP($J,TLIST,DFN)) Q:DFN=""  D
  1.  . S NFOUND=0
  1.  . S DATE=""
  1.  . F  S DATE=$O(^TMP($J,TLIST,DFN,DATE),-1) Q:(DATE="")!(NFOUND=NOCC)  D
  1.  .. S DAS=""
  1.  .. F  S DAS=$O(^TMP($J,TLIST,DFN,DATE,DAS)) Q:DAS=""  D
  1.  ... S NFOUND=NFOUND+1
  1.  ... S TEMP=^TMP($J,TLIST,DFN,DATE,DAS)
  1.  ... S ^TMP($J,PLIST,1,DFN,DATE,45)=DAS_U_DATE_U_TEMP
  1.  K ^TMP($J,TLIST)
  1.  Q
  1.  ;
  1.  ;============================================
  1. MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
  1.  N CDATA,CODE,CODESYS,CODESYSA,CODESYSL,CODESYSN,DATE,IND,JND,NAME,NOUT
  1.  N RESULT,TEMP,TEXTIN,TEXTOUT
  1.  ;Since the results may contain both diagnosis and procedures group
  1.  ;them for display.
  1.  S IND=0
  1.  F  S IND=$O(OCCLIST(IND)) Q:IND=""  S CODESYSL(IFIEVAL(IND,"CODESYS"),IND)=""
  1.  S CODESYS=""
  1.  F  S CODESYS=$O(CODESYSL(CODESYS)) Q:CODESYS=""  D
  1.  .;DBIA #5679
  1.  . S TEMP=$$CSYS^LEXU(CODESYS)
  1.  . S CODESYSA=$P(TEMP,U,4)
  1.  . S CODESYSN=$$UP^XLFSTR($P(TEMP,U,5))
  1.  . S TEMP=$S(CODESYSN["PROCEDURE":"Procedure",CODESYSN["DIAGNOSIS":"Diagnosis",1:"Unknown")
  1.  . S NAME="Hospitalization "_TEMP
  1.  . S IND=""
  1.  . F  S IND=$O(CODESYSL(CODESYS,IND)) Q:IND=""  D
  1.  .. S CODE=IFIEVAL(IND,"CODE")
  1.  .. S DATE=IFIEVAL(IND,"DATE")
  1.  .. K CDATA
  1.  .. ;DBIA #5679
  1.  .. S RESULT=$$CSDATA^LEXU(CODE,CODESYS,DATE,.CDATA)
  1.  .. S TEXTIN(1)=NAME
  1.  .. S TEXTIN(2)=$P(CDATA("LEX",1),U,2)
  1.  .. S TEXTIN(3)=" ("_$$EDATE^PXRMDATE(DATE)_")"
  1.  .. D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,3,.TEXTIN,.NOUT,.TEXTOUT)
  1.  .. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1.  S NLINES=NLINES+1,TEXT(NLINES)=""
  1.  Q
  1.  ;
  1.  ;============================================
  1. OUTPUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
  1.  ;maintenance output.
  1.  N CDATA,CODE,CODESYS,CODESYSA,CODESYSL,CODESYSN,DATE,IND
  1.  N JND,NODE,NOUT,RESULT,TEMP,TEXTIN,TEXTOUT
  1.  ;Since the results may contain both diagnosis and procedures group
  1.  ;them for display.
  1.  S IND=0
  1.  F  S IND=$O(OCCLIST(IND)) Q:IND=""  S CODESYSL(IFIEVAL(IND,"CODESYS"),IND)=""
  1.  S CODESYS=""
  1.  F  S CODESYS=$O(CODESYSL(CODESYS)) Q:CODESYS=""  D
  1.  .;DBIA #5679
  1.  . S TEMP=$$CSYS^LEXU(CODESYS)
  1.  . S CODESYSA=$P(TEMP,U,4)
  1.  . S CODESYSN=$$UP^XLFSTR($P(TEMP,U,5))
  1.  . S TEMP=$S(CODESYSN["PROCEDURE":"Procedure",CODESYSN["DIAGNOSIS":"Diagnosis",1:"Unknown")
  1.  . S NLINES=NLINES+1
  1.  . S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Hospitalization "_TEMP
  1.  . S IND=""
  1.  . F  S IND=$O(CODESYSL(CODESYS,IND)) Q:IND=""  D
  1.  .. S CODE=IFIEVAL(IND,"CODE")
  1.  .. S DATE=IFIEVAL(IND,"DATE")
  1.  .. S NODE=IFIEVAL(IND,"NODE")
  1.  .. K CDATA
  1.  .. ;DBIA #5679
  1.  .. S RESULT=$$CSDATA^LEXU(CODE,CODESYS,DATE,.CDATA)
  1.  .. S TEXTIN(1)=$$EDATE^PXRMDATE(DATE)_" "_CODE_" ("_CODESYSA_")"
  1.  .. S TEXTIN(2)=$P(CDATA("LEX",1),U,2)_";"
  1.  .. S TEXTIN(3)="data node: "_NODE
  1.  .. I $G(IFIEVAL(IND,"FEE BASIS")) S TEXTIN(3)=TEXTIN(3)_"; (Fee)"
  1.  .. D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,3,.TEXTIN,.NOUT,.TEXTOUT)
  1.  .. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1.  S NLINES=NLINES+1,TEXT(NLINES)=""
  1.  Q
  1.  ;