PXRMVSC ; SLC/PKR - Code to handle V Standard Codes data. ;02/03/2022
;;2.0;CLINICAL REMINDERS;**42,65**;Feb 04, 2005;Build 438
;
;===============================================
FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
N CODESYS,CSYST,DATE,DS,EDTT,IND,NFOUND,NNODES,TLIST
S NNODES=TAXARR("APDS",9000010.71,"NNODES")
I NNODES=0 Q
I $G(^PXRMINDX(9000010.71,"DATE BUILT"))="" D Q
. D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.71)
I '$D(^PXRMINDX(9000010.71,"PI",DFN)) Q
S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
S DS=$S(SDIR=+1:BDT-.000001,1:EDTT)
S CODESYS="",NFOUND=0
F S CODESYS=$O(^PXRMINDX(9000010.71,"PI",DFN,CODESYS)) Q:CODESYS="" D
. D FPDCSYS(DFN,CODESYS,.TAXARR,NGET,.NFOUND,BDT,EDTT,DS,SDIR,.TLIST)
;Return up to NGET of the most recent entries.
S DATE="",NFOUND=0
F S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NGET) D
. S IND=0
. F S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NGET) D
.. S NFOUND=NFOUND+1
.. S FLIST(DATE,NFOUND,9000010.71)=TLIST(DATE,IND)
Q
;
;===============================================
FPDCSYS(DFN,CODESYS,TAXARR,NGET,NFOUND,BDT,EDTT,DS,SDIR,TLIST) ;Find data for
;a patient in V Standard Codes.
N CODE,DAS,DATE,NODE,TDATE,TIND
S CODE=""
F S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE="" D
. I '$D(^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE)) Q
. S DATE=DS
. 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
.. S DAS=$O(^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE,DATE,""))
.. S NFOUND=NFOUND+1
.. S TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_CODE
.. I NFOUND>NGET D
... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
... K TLIST(TDATE,TIND)
Q
;
;===============================================
GETDATA(DAS,FIEVT) ;Return data for a specified V Standard Codes entry.
;DBIA #4250.
D VSCDATA^PXPXRM(DAS,.FIEVT)
Q
;
;===============================================
GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V CPT entries.
N CODE,CODEP,CODESYS,DAS,DATE,DFN,DS,NFOUND,TEMP,TLIST
S NNODES=TAXARR("APDS",9000010.71,"NNODES")
I NNODES=0 Q
I $G(^PXRMINDX(9000010.71,"DATE BUILT"))="" D Q
. D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.71)
S TLIST="GPLIST_PXRMVSC"
K ^TMP($J,TLIST)
S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
S CODESYS=""
F S CODESYS=$O(TAXARR("AE",CODESYS)) Q:CODESYS="" D
. S CODE=""
. F S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:(CODE="") D
.. D GPLCSYS(CODESYS,CODE,.TAXARR,BDT,DS,TLIST)
;Return up to NOCC of the most recent entries for each patient.
S DFN=0
F S DFN=$O(^TMP($J,TLIST,DFN)) Q:DFN="" D
. S DATE="",NFOUND=0
. F S DATE=$O(^TMP($J,TLIST,DFN,DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D
.. S DAS=""
.. F S DAS=$O(^TMP($J,TLIST,DFN,DATE,DAS)) Q:DAS="" D
... S NFOUND=NFOUND+1
... S TEMP=^TMP($J,TLIST,DFN,DATE,DAS)
... S ^TMP($J,PLIST,1,DFN,NFOUND,9000010.71)=DAS_U_DATE_U_TEMP
K ^TMP($J,TLIST)
Q
;
;===============================================
GPLCSYS(CODESYS,CODE,TAXARR,BDT,DS,TLIST) ;Build patient list for V
;Standard Codes.
I '$D(^PXRMINDX(9000010.71,"IP",CODESYS,CODE)) Q
N DAS,DATE,DFN
S DFN=0
F S DFN=$O(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN)) Q:DFN="" D
. S DATE=DS
. F S DATE=+$O(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT) D
.. S DAS=$O(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN,DATE,""))
.. S ^TMP($J,TLIST,DFN,DATE,DAS)=CODESYS_U_CODE
Q
;
;===============================================
MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
N CDATA,CODE,CODESYS,IND,JND,NAME,NIN,NOUT
N PN,PP,RESULT,TEMP,TEXTOUT,VDATE
S NAME="Encounter - Additional Terminologies = "
S IND=0
F S IND=$O(OCCLIST(IND)) Q:IND="" D
. S VDATE=IFIEVAL(IND,"DATE")
. S CODE=IFIEVAL(IND,"CODE")
. S CODESYS=IFIEVAL(IND,"CODESYS")
. K CDATA
.;DBIA #5679
. S RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
. S TEMP=NAME_$P(CDATA("LEX",1),U,2)_" ("_$$EDATE^PXRMDATE(VDATE)_")"
. D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
. I IFIEVAL(IND,"MEASUREMENT")'="" D
.. N MAGNITUDE,UCUMIEN
.. S MAGNITUDE=$P(IFIEVAL(IND,"MEASUREMENT"),U,1)
.. I MAGNITUDE="" Q
.. S NLINES=NLINES+1
.. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_"Measurement: "_MAGNITUDE
.. S UCUMIEN=$P(IFIEVAL(IND,"MEASUREMENT"),U,2)
.. I UCUMIEN'="" S TEXT(NLINES)=TEXT(NLINES)_" "_$$UCUMFIELDS^PXRMUCUM(UCUMIEN,"DESCRIPTION")
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
;===============================================
OUTPUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
;maintenance output.
N CDATA,CODE,CODESYS,CODESYSN,D0,HIER,IND,JND,NIN,NOUT
N RESULT,TEXTIN,TEXTOUT,VDATE
S NLINES=NLINES+1
S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Encounter - Additional Terminologies:"
;DBIA #5679
S IND=0
F S IND=$O(OCCLIST(IND)) Q:IND="" D
. S VDATE=IFIEVAL(IND,"DATE")
. S CODE=IFIEVAL(IND,"CODE")
. S CODESYS=IFIEVAL(IND,"CODESYS")
. S CODESYSN=$P($$CSYS^LEXU(CODESYS),U,4)
. K CDATA
.;DBIA #5679
. S RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
. S D0=$G(^AUPNVSC(IFIEVAL(IND,"DAS"),0))
. S TEXTIN(1)=$$EDATE^PXRMDATE(VDATE)_" "_CODE_" - "_CODESYSN
. I CODESYS="SCT" D
.. S HIER=$$SCTHIER^PXRMTXIN(CODE,VDATE)
.. S TEXTIN(1)=TEXTIN(1)_" "_HIER
. S TEXTIN(2)=$P(CDATA("LEX",1),U,2)_"\\"
. D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,2,.TEXTIN,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
. I IFIEVAL(IND,"MEASUREMENT")'="" D
.. N MAGNITUDE,UCUMIEN
.. S MAGNITUDE=$P(IFIEVAL(IND,"MEASUREMENT"),U,1)
.. I MAGNITUDE="" Q
.. S NLINES=NLINES+1
.. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_"Measurement: "_MAGNITUDE
.. S UCUMIEN=$P(IFIEVAL(IND,"MEASUREMENT"),U,2)
.. I UCUMIEN'="" S TEXT(NLINES)=TEXT(NLINES)_" "_$$UCUMFIELDS^PXRMUCUM(UCUMIEN,"DESCRIPTION")
. I IFIEVAL(IND,"COMMENTS")'="" D
.. S TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
.. D FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT)
.. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMVSC 6310 printed Sep 23, 2025@19:25:58 Page 2
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
+2 ;
+3 ;===============================================
FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
+1 NEW CODESYS,CSYST,DATE,DS,EDTT,IND,NFOUND,NNODES,TLIST
+2 SET NNODES=TAXARR("APDS",9000010.71,"NNODES")
+3 IF NNODES=0
QUIT
+4 IF $GET(^PXRMINDX(9000010.71,"DATE BUILT"))=""
Begin DoDot:1
+5 DO NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.71)
End DoDot:1
QUIT
+6 IF '$DATA(^PXRMINDX(9000010.71,"PI",DFN))
QUIT
+7 SET EDTT=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+8 SET DS=$SELECT(SDIR=+1:BDT-.000001,1:EDTT)
+9 SET CODESYS=""
SET NFOUND=0
+10 FOR
SET CODESYS=$ORDER(^PXRMINDX(9000010.71,"PI",DFN,CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+11 DO FPDCSYS(DFN,CODESYS,.TAXARR,NGET,.NFOUND,BDT,EDTT,DS,SDIR,.TLIST)
End DoDot:1
+12 ;Return up to NGET of the most recent entries.
+13 SET DATE=""
SET NFOUND=0
+14 FOR
SET DATE=$ORDER(TLIST(DATE),SDIR)
if (DATE="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+15 SET IND=0
+16 FOR
SET IND=$ORDER(TLIST(DATE,IND))
if (IND="")!(NFOUND=NGET)
QUIT
Begin DoDot:2
+17 SET NFOUND=NFOUND+1
+18 SET FLIST(DATE,NFOUND,9000010.71)=TLIST(DATE,IND)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;===============================================
FPDCSYS(DFN,CODESYS,TAXARR,NGET,NFOUND,BDT,EDTT,DS,SDIR,TLIST) ;Find data for
+1 ;a patient in V Standard Codes.
+2 NEW CODE,DAS,DATE,NODE,TDATE,TIND
+3 SET CODE=""
+4 FOR
SET CODE=$ORDER(TAXARR("AE",CODESYS,CODE))
if CODE=""
QUIT
Begin DoDot:1
+5 IF '$DATA(^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE))
QUIT
+6 SET DATE=DS
+7 FOR
SET DATE=+$ORDER(^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE,DATE),SDIR)
if $SELECT(DATE=0
QUIT
Begin DoDot:2
+8 SET DAS=$ORDER(^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE,DATE,""))
+9 SET NFOUND=NFOUND+1
+10 SET TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_CODE
+11 IF NFOUND>NGET
Begin DoDot:3
+12 SET TDATE=$ORDER(TLIST(""),-SDIR)
SET TIND=$ORDER(TLIST(TDATE,""))
+13 KILL TLIST(TDATE,TIND)
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
+16 ;===============================================
GETDATA(DAS,FIEVT) ;Return data for a specified V Standard Codes entry.
+1 ;DBIA #4250.
+2 DO VSCDATA^PXPXRM(DAS,.FIEVT)
+3 QUIT
+4 ;
+5 ;===============================================
GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V CPT entries.
+1 NEW CODE,CODEP,CODESYS,DAS,DATE,DFN,DS,NFOUND,TEMP,TLIST
+2 SET NNODES=TAXARR("APDS",9000010.71,"NNODES")
+3 IF NNODES=0
QUIT
+4 IF $GET(^PXRMINDX(9000010.71,"DATE BUILT"))=""
Begin DoDot:1
+5 DO NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.71)
End DoDot:1
QUIT
+6 SET TLIST="GPLIST_PXRMVSC"
+7 KILL ^TMP($JOB,TLIST)
+8 SET DS=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+9 SET CODESYS=""
+10 FOR
SET CODESYS=$ORDER(TAXARR("AE",CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+11 SET CODE=""
+12 FOR
SET CODE=$ORDER(TAXARR("AE",CODESYS,CODE))
if (CODE="")
QUIT
Begin DoDot:2
+13 DO GPLCSYS(CODESYS,CODE,.TAXARR,BDT,DS,TLIST)
End DoDot:2
End DoDot:1
+14 ;Return up to NOCC of the most recent entries for each patient.
+15 SET DFN=0
+16 FOR
SET DFN=$ORDER(^TMP($JOB,TLIST,DFN))
if DFN=""
QUIT
Begin DoDot:1
+17 SET DATE=""
SET NFOUND=0
+18 FOR
SET DATE=$ORDER(^TMP($JOB,TLIST,DFN,DATE),-1)
if (DATE="")!(NFOUND=NOCC)
QUIT
Begin DoDot:2
+19 SET DAS=""
+20 FOR
SET DAS=$ORDER(^TMP($JOB,TLIST,DFN,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:3
+21 SET NFOUND=NFOUND+1
+22 SET TEMP=^TMP($JOB,TLIST,DFN,DATE,DAS)
+23 SET ^TMP($JOB,PLIST,1,DFN,NFOUND,9000010.71)=DAS_U_DATE_U_TEMP
End DoDot:3
End DoDot:2
End DoDot:1
+24 KILL ^TMP($JOB,TLIST)
+25 QUIT
+26 ;
+27 ;===============================================
GPLCSYS(CODESYS,CODE,TAXARR,BDT,DS,TLIST) ;Build patient list for V
+1 ;Standard Codes.
+2 IF '$DATA(^PXRMINDX(9000010.71,"IP",CODESYS,CODE))
QUIT
+3 NEW DAS,DATE,DFN
+4 SET DFN=0
+5 FOR
SET DFN=$ORDER(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN))
if DFN=""
QUIT
Begin DoDot:1
+6 SET DATE=DS
+7 FOR
SET DATE=+$ORDER(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN,DATE),-1)
if (DATE=0)!(DATE<BDT)
QUIT
Begin DoDot:2
+8 SET DAS=$ORDER(^PXRMINDX(9000010.71,"IP",CODESYS,CODE,DFN,DATE,""))
+9 SET ^TMP($JOB,TLIST,DFN,DATE,DAS)=CODESYS_U_CODE
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
+12 ;===============================================
MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 NEW CDATA,CODE,CODESYS,IND,JND,NAME,NIN,NOUT
+2 NEW PN,PP,RESULT,TEMP,TEXTOUT,VDATE
+3 SET NAME="Encounter - Additional Terminologies = "
+4 SET IND=0
+5 FOR
SET IND=$ORDER(OCCLIST(IND))
if IND=""
QUIT
Begin DoDot:1
+6 SET VDATE=IFIEVAL(IND,"DATE")
+7 SET CODE=IFIEVAL(IND,"CODE")
+8 SET CODESYS=IFIEVAL(IND,"CODESYS")
+9 KILL CDATA
+10 ;DBIA #5679
+11 SET RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
+12 SET TEMP=NAME_$PIECE(CDATA("LEX",1),U,2)_" ("_$$EDATE^PXRMDATE(VDATE)_")"
+13 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+14 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+15 IF IFIEVAL(IND,"MEASUREMENT")'=""
Begin DoDot:2
+16 NEW MAGNITUDE,UCUMIEN
+17 SET MAGNITUDE=$PIECE(IFIEVAL(IND,"MEASUREMENT"),U,1)
+18 IF MAGNITUDE=""
QUIT
+19 SET NLINES=NLINES+1
+20 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_"Measurement: "_MAGNITUDE
+21 SET UCUMIEN=$PIECE(IFIEVAL(IND,"MEASUREMENT"),U,2)
+22 IF UCUMIEN'=""
SET TEXT(NLINES)=TEXT(NLINES)_" "_$$UCUMFIELDS^PXRMUCUM(UCUMIEN,"DESCRIPTION")
End DoDot:2
End DoDot:1
+23 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+24 QUIT
+25 ;
+26 ;===============================================
OUTPUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+1 ;maintenance output.
+2 NEW CDATA,CODE,CODESYS,CODESYSN,D0,HIER,IND,JND,NIN,NOUT
+3 NEW RESULT,TEXTIN,TEXTOUT,VDATE
+4 SET NLINES=NLINES+1
+5 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Encounter - Additional Terminologies:"
+6 ;DBIA #5679
+7 SET IND=0
+8 FOR
SET IND=$ORDER(OCCLIST(IND))
if IND=""
QUIT
Begin DoDot:1
+9 SET VDATE=IFIEVAL(IND,"DATE")
+10 SET CODE=IFIEVAL(IND,"CODE")
+11 SET CODESYS=IFIEVAL(IND,"CODESYS")
+12 SET CODESYSN=$PIECE($$CSYS^LEXU(CODESYS),U,4)
+13 KILL CDATA
+14 ;DBIA #5679
+15 SET RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
+16 SET D0=$GET(^AUPNVSC(IFIEVAL(IND,"DAS"),0))
+17 SET TEXTIN(1)=$$EDATE^PXRMDATE(VDATE)_" "_CODE_" - "_CODESYSN
+18 IF CODESYS="SCT"
Begin DoDot:2
+19 SET HIER=$$SCTHIER^PXRMTXIN(CODE,VDATE)
+20 SET TEXTIN(1)=TEXTIN(1)_" "_HIER
End DoDot:2
+21 SET TEXTIN(2)=$PIECE(CDATA("LEX",1),U,2)_"\\"
+22 DO FORMAT^PXRMTEXT(INDENT+2,PXRMRM,2,.TEXTIN,.NOUT,.TEXTOUT)
+23 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+24 IF IFIEVAL(IND,"MEASUREMENT")'=""
Begin DoDot:2
+25 NEW MAGNITUDE,UCUMIEN
+26 SET MAGNITUDE=$PIECE(IFIEVAL(IND,"MEASUREMENT"),U,1)
+27 IF MAGNITUDE=""
QUIT
+28 SET NLINES=NLINES+1
+29 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_"Measurement: "_MAGNITUDE
+30 SET UCUMIEN=$PIECE(IFIEVAL(IND,"MEASUREMENT"),U,2)
+31 IF UCUMIEN'=""
SET TEXT(NLINES)=TEXT(NLINES)_" "_$$UCUMFIELDS^PXRMUCUM(UCUMIEN,"DESCRIPTION")
End DoDot:2
+32 IF IFIEVAL(IND,"COMMENTS")'=""
Begin DoDot:2
+33 SET TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
+34 DO FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+35 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:2
End DoDot:1
+36 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+37 QUIT
+38 ;
