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

PXRMVSC.m

Go to the documentation of this file.
  1. PXRMVSC ; SLC/PKR - Code to handle V Standard Codes data. ;02/03/2022
  1. ;;2.0;CLINICAL REMINDERS;**42,65**;Feb 04, 2005;Build 438
  1. ;
  1. ;===============================================
  1. FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
  1. N CODESYS,CSYST,DATE,DS,EDTT,IND,NFOUND,NNODES,TLIST
  1. S NNODES=TAXARR("APDS",9000010.71,"NNODES")
  1. I NNODES=0 Q
  1. I $G(^PXRMINDX(9000010.71,"DATE BUILT"))="" D Q
  1. . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.71)
  1. I '$D(^PXRMINDX(9000010.71,"PI",DFN)) Q
  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(^PXRMINDX(9000010.71,"PI",DFN,CODESYS)) Q:CODESYS="" D
  1. . D FPDCSYS(DFN,CODESYS,.TAXARR,NGET,.NFOUND,BDT,EDTT,DS,SDIR,.TLIST)
  1. ;Return up to NGET of the most recent entries.
  1. S DATE="",NFOUND=0
  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,9000010.71)=TLIST(DATE,IND)
  1. Q
  1. ;
  1. ;===============================================
  1. FPDCSYS(DFN,CODESYS,TAXARR,NGET,NFOUND,BDT,EDTT,DS,SDIR,TLIST) ;Find data for
  1. ;a patient in V Standard Codes.
  1. N CODE,DAS,DATE,NODE,TDATE,TIND
  1. S CODE=""
  1. F S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE="" D
  1. . I '$D(^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE)) Q
  1. . S DATE=DS
  1. . F S DATE=+$O(^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE,DATE),SDIR) Q:$S(DATE=0:1,DATE<BDT:1,DATE>EDTT:1,1:0) D
  1. .. S DAS=$O(^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE,DATE,""))
  1. .. S NFOUND=NFOUND+1
  1. .. S TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_CODE
  1. .. I NFOUND>NGET D
  1. ... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
  1. ... K TLIST(TDATE,TIND)
  1. Q
  1. ;
  1. ;===============================================
  1. GETDATA(DAS,FIEVT) ;Return data for a specified V Standard Codes entry.
  1. ;DBIA #4250.
  1. D VSCDATA^PXPXRM(DAS,.FIEVT)
  1. Q
  1. ;
  1. ;===============================================
  1. GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V CPT entries.
  1. N CODE,CODEP,CODESYS,DAS,DATE,DFN,DS,NFOUND,TEMP,TLIST
  1. S NNODES=TAXARR("APDS",9000010.71,"NNODES")
  1. I NNODES=0 Q
  1. I $G(^PXRMINDX(9000010.71,"DATE BUILT"))="" D Q
  1. . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.71)
  1. S TLIST="GPLIST_PXRMVSC"
  1. K ^TMP($J,TLIST)
  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. . S CODE=""
  1. . F S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:(CODE="") D
  1. .. D GPLCSYS(CODESYS,CODE,.TAXARR,BDT,DS,TLIST)
  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 DATE="",NFOUND=0
  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,NFOUND,9000010.71)=DAS_U_DATE_U_TEMP
  1. K ^TMP($J,TLIST)
  1. Q
  1. ;
  1. ;===============================================
  1. GPLCSYS(CODESYS,CODE,TAXARR,BDT,DS,TLIST) ;Build patient list for V
  1. ;Standard Codes.
  1. I '$D(^PXRMINDX(9000010.71,"IP",CODESYS,CODE)) Q
  1. N DAS,DATE,DFN
  1. S DFN=0
  1. F S DFN=$O(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN)) Q:DFN="" D
  1. . S DATE=DS
  1. . F S DATE=+$O(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT) D
  1. .. S DAS=$O(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN,DATE,""))
  1. .. S ^TMP($J,TLIST,DFN,DATE,DAS)=CODESYS_U_CODE
  1. Q
  1. ;
  1. ;===============================================
  1. MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
  1. N CDATA,CODE,CODESYS,IND,JND,NAME,NIN,NOUT
  1. N PN,PP,RESULT,TEMP,TEXTOUT,VDATE
  1. S NAME="Encounter - Additional Terminologies = "
  1. S IND=0
  1. F S IND=$O(OCCLIST(IND)) Q:IND="" D
  1. . S VDATE=IFIEVAL(IND,"DATE")
  1. . S CODE=IFIEVAL(IND,"CODE")
  1. . S CODESYS=IFIEVAL(IND,"CODESYS")
  1. . K CDATA
  1. .;DBIA #5679
  1. . S RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
  1. . S TEMP=NAME_$P(CDATA("LEX",1),U,2)_" ("_$$EDATE^PXRMDATE(VDATE)_")"
  1. . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
  1. . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1. . I IFIEVAL(IND,"MEASUREMENT")'="" D
  1. .. N MAGNITUDE,UCUMIEN
  1. .. S MAGNITUDE=$P(IFIEVAL(IND,"MEASUREMENT"),U,1)
  1. .. I MAGNITUDE="" Q
  1. .. S NLINES=NLINES+1
  1. .. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_"Measurement: "_MAGNITUDE
  1. .. S UCUMIEN=$P(IFIEVAL(IND,"MEASUREMENT"),U,2)
  1. .. I UCUMIEN'="" S TEXT(NLINES)=TEXT(NLINES)_" "_$$UCUMFIELDS^PXRMUCUM(UCUMIEN,"DESCRIPTION")
  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,CODESYSN,D0,HIER,IND,JND,NIN,NOUT
  1. N RESULT,TEXTIN,TEXTOUT,VDATE
  1. S NLINES=NLINES+1
  1. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Encounter - Additional Terminologies:"
  1. ;DBIA #5679
  1. S IND=0
  1. F S IND=$O(OCCLIST(IND)) Q:IND="" D
  1. . S VDATE=IFIEVAL(IND,"DATE")
  1. . S CODE=IFIEVAL(IND,"CODE")
  1. . S CODESYS=IFIEVAL(IND,"CODESYS")
  1. . S CODESYSN=$P($$CSYS^LEXU(CODESYS),U,4)
  1. . K CDATA
  1. .;DBIA #5679
  1. . S RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
  1. . S D0=$G(^AUPNVSC(IFIEVAL(IND,"DAS"),0))
  1. . S TEXTIN(1)=$$EDATE^PXRMDATE(VDATE)_" "_CODE_" - "_CODESYSN
  1. . I CODESYS="SCT" D
  1. .. S HIER=$$SCTHIER^PXRMTXIN(CODE,VDATE)
  1. .. S TEXTIN(1)=TEXTIN(1)_" "_HIER
  1. . S TEXTIN(2)=$P(CDATA("LEX",1),U,2)_"\\"
  1. . D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,2,.TEXTIN,.NOUT,.TEXTOUT)
  1. . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1. . I IFIEVAL(IND,"MEASUREMENT")'="" D
  1. .. N MAGNITUDE,UCUMIEN
  1. .. S MAGNITUDE=$P(IFIEVAL(IND,"MEASUREMENT"),U,1)
  1. .. I MAGNITUDE="" Q
  1. .. S NLINES=NLINES+1
  1. .. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_"Measurement: "_MAGNITUDE
  1. .. S UCUMIEN=$P(IFIEVAL(IND,"MEASUREMENT"),U,2)
  1. .. I UCUMIEN'="" S TEXT(NLINES)=TEXT(NLINES)_" "_$$UCUMFIELDS^PXRMUCUM(UCUMIEN,"DESCRIPTION")
  1. . I IFIEVAL(IND,"COMMENTS")'="" D
  1. .. S TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
  1. .. D FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.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. ;