PXRMEXAM ;SLC/PKR - Handle examination findings. ;04/15/2022
;;2.0;CLINICAL REMINDERS;**42,65**;Feb 04, 2005;Build 438
;
;=============================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate examination findings.
D EVALFI^PXRMINDX(DFN,.DEFARR,ENODE,.FIEVAL)
Q
;
;=============================================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate examination term findings
;for patient lists.
D EVALPL^PXRMINDL(.FINDPA,ENODE,.TERMARR,PLIST)
Q
;
;=============================================================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate examination terms.
D EVALTERM^PXRMINDX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
Q
;
;=============================================================
GETDATA(DAS,FIEVT) ;Return data, for a specified V Exam entry.
;DBIA #4250.
D VXAM^PXPXRM(DAS,.FIEVT)
Q
;
;=============================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
N CAPTION,EM,EXAM220,FIEN,IND,JND,MAGNITUDE,NAME,NOUT,PNAME,RESULT,TEMP,TEXTOUT
N UCUMIEN,UCUMDISPLAY,UCUMFIELD,UNITS,VDATE
S FIEN=$P(IFIEVAL("FINDING"),";",1)
S PNAME=$P($G(^AUTTEXAM(FIEN,200)),U,1)
I PNAME="" S PNAME=$P(^AUTTEXAM(FIEN,0),U,1)
S NAME=$$INSCHR^PXRMEXLC(INDENT," ")_"Exam: "_PNAME_" = "
S EXAM220=$G(^AUTTEXAM(FIEN,220))
S UCUMIEN=$P(EXAM220,U,4)
I UCUMIEN'="" D
. S UCUMDISPLAY=$P(EXAM220,U,6)
. I UCUMDISPLAY="N" S UNITS="" Q
. S UCUMFIELD=$S(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
. S UNITS=$$UCUMFIELDS^PXRMUCUM(UCUMIEN,UCUMFIELD)
E S UNITS=""
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S RESULT=$G(IFIEVAL(IND,"RESULT"))
. I RESULT'="" S RESULT=$$EXTERNAL^DILFD(9000010.13,.04,"",RESULT,.EM)
. S VDATE=IFIEVAL(IND,"DATE")
. S TEMP=NAME_RESULT_" ("_$$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
.. S MAGNITUDE=$P(IFIEVAL(IND,"MEASUREMENT"),U,1)
.. I MAGNITUDE="" Q
.. S NLINES=NLINES+1
.. S CAPTION=$S(UNITS="":"Magnitude: ",1:"Measurement: ")
.. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_CAPTION_MAGNITUDE
.. I UNITS'="" S TEXT(NLINES)=TEXT(NLINES)_" "_UNITS
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
;=============================================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
;maintenance output.
N CAPTION,EM,EXAM220,FIEN,IND,JND,MAGNITUDE,NOUT,PNAME,RESULT,TEMP,TEXTOUT
N UCUMIEN,UCUMDISPLAY,UCUMFIELD,UNITS,VDATE
S FIEN=$P(IFIEVAL("FINDING"),";",1)
S PNAME=$P($G(^AUTTEXAM(FIEN,200)),U,1)
I PNAME="" S PNAME=$P(^AUTTEXAM(FIEN,0),U,1)
S EXAM220=$G(^AUTTEXAM(FIEN,220))
S UCUMIEN=$P(EXAM220,U,4)
I UCUMIEN'="" D
. S UCUMDISPLAY=$P(EXAM220,U,6)
. I UCUMDISPLAY="N" S UNITS="" Q
. S UCUMFIELD=$S(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
. S UNITS=$$UCUMFIELDS^PXRMUCUM(UCUMIEN,UCUMFIELD)
E S UNITS=""
I INDENT+6+$L(PNAME)<81 D
. S NLINES=NLINES+1
. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Exam: "_PNAME
E D
. N COL1W,COL2W,FMTSTR
. S TEMP="Exam:^"_PNAME
. S COL1W=INDENT+5,COL2W=80-COL1W
. S FMTSTR=COL1W_"R1^"_COL2W_"L"
. D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S VDATE=IFIEVAL(IND,"DATE")
. S TEMP=$$EDATE^PXRMDATE(VDATE)
. S RESULT=$G(IFIEVAL(IND,"RESULT"))
. I RESULT'="" D
.. S TEMP=TEMP_" result - "
.. S TEMP=TEMP_$$EXTERNAL^DILFD(9000010.13,.04,"",RESULT,.EM)
. 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
.. S MAGNITUDE=$P(IFIEVAL(IND,"MEASUREMENT"),U,1)
.. I MAGNITUDE="" Q
.. S NLINES=NLINES+1
.. S CAPTION=$S(UNITS="":"Magnitude: ",1:"Measurement: ")
.. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_CAPTION_MAGNITUDE
.. I UNITS'="" S TEXT(NLINES)=TEXT(NLINES)_" "_UNITS
. 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[HPXRMEXAM 4383 printed Sep 23, 2025@19:20:47 Page 2
PXRMEXAM ;SLC/PKR - Handle examination findings. ;04/15/2022
+1 ;;2.0;CLINICAL REMINDERS;**42,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;=============================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate examination findings.
+1 DO EVALFI^PXRMINDX(DFN,.DEFARR,ENODE,.FIEVAL)
+2 QUIT
+3 ;
+4 ;=============================================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate examination term findings
+1 ;for patient lists.
+2 DO EVALPL^PXRMINDL(.FINDPA,ENODE,.TERMARR,PLIST)
+3 QUIT
+4 ;
+5 ;=============================================================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate examination terms.
+1 DO EVALTERM^PXRMINDX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
+2 QUIT
+3 ;
+4 ;=============================================================
GETDATA(DAS,FIEVT) ;Return data, for a specified V Exam entry.
+1 ;DBIA #4250.
+2 DO VXAM^PXPXRM(DAS,.FIEVT)
+3 QUIT
+4 ;
+5 ;=============================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 NEW CAPTION,EM,EXAM220,FIEN,IND,JND,MAGNITUDE,NAME,NOUT,PNAME,RESULT,TEMP,TEXTOUT
+2 NEW UCUMIEN,UCUMDISPLAY,UCUMFIELD,UNITS,VDATE
+3 SET FIEN=$PIECE(IFIEVAL("FINDING"),";",1)
+4 SET PNAME=$PIECE($GET(^AUTTEXAM(FIEN,200)),U,1)
+5 IF PNAME=""
SET PNAME=$PIECE(^AUTTEXAM(FIEN,0),U,1)
+6 SET NAME=$$INSCHR^PXRMEXLC(INDENT," ")_"Exam: "_PNAME_" = "
+7 SET EXAM220=$GET(^AUTTEXAM(FIEN,220))
+8 SET UCUMIEN=$PIECE(EXAM220,U,4)
+9 IF UCUMIEN'=""
Begin DoDot:1
+10 SET UCUMDISPLAY=$PIECE(EXAM220,U,6)
+11 IF UCUMDISPLAY="N"
SET UNITS=""
QUIT
+12 SET UCUMFIELD=$SELECT(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
+13 SET UNITS=$$UCUMFIELDS^PXRMUCUM(UCUMIEN,UCUMFIELD)
End DoDot:1
+14 IF '$TEST
SET UNITS=""
+15 SET IND=0
+16 FOR
SET IND=+$ORDER(IFIEVAL(IND))
if IND=0
QUIT
Begin DoDot:1
+17 SET RESULT=$GET(IFIEVAL(IND,"RESULT"))
+18 IF RESULT'=""
SET RESULT=$$EXTERNAL^DILFD(9000010.13,.04,"",RESULT,.EM)
+19 SET VDATE=IFIEVAL(IND,"DATE")
+20 SET TEMP=NAME_RESULT_" ("_$$EDATE^PXRMDATE(VDATE)_")"
+21 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+22 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+23 IF IFIEVAL(IND,"MEASUREMENT")'=""
Begin DoDot:2
+24 SET MAGNITUDE=$PIECE(IFIEVAL(IND,"MEASUREMENT"),U,1)
+25 IF MAGNITUDE=""
QUIT
+26 SET NLINES=NLINES+1
+27 SET CAPTION=$SELECT(UNITS="":"Magnitude: ",1:"Measurement: ")
+28 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_CAPTION_MAGNITUDE
+29 IF UNITS'=""
SET TEXT(NLINES)=TEXT(NLINES)_" "_UNITS
End DoDot:2
End DoDot:1
+30 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+31 QUIT
+32 ;
+33 ;=============================================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+1 ;maintenance output.
+2 NEW CAPTION,EM,EXAM220,FIEN,IND,JND,MAGNITUDE,NOUT,PNAME,RESULT,TEMP,TEXTOUT
+3 NEW UCUMIEN,UCUMDISPLAY,UCUMFIELD,UNITS,VDATE
+4 SET FIEN=$PIECE(IFIEVAL("FINDING"),";",1)
+5 SET PNAME=$PIECE($GET(^AUTTEXAM(FIEN,200)),U,1)
+6 IF PNAME=""
SET PNAME=$PIECE(^AUTTEXAM(FIEN,0),U,1)
+7 SET EXAM220=$GET(^AUTTEXAM(FIEN,220))
+8 SET UCUMIEN=$PIECE(EXAM220,U,4)
+9 IF UCUMIEN'=""
Begin DoDot:1
+10 SET UCUMDISPLAY=$PIECE(EXAM220,U,6)
+11 IF UCUMDISPLAY="N"
SET UNITS=""
QUIT
+12 SET UCUMFIELD=$SELECT(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
+13 SET UNITS=$$UCUMFIELDS^PXRMUCUM(UCUMIEN,UCUMFIELD)
End DoDot:1
+14 IF '$TEST
SET UNITS=""
+15 IF INDENT+6+$LENGTH(PNAME)<81
Begin DoDot:1
+16 SET NLINES=NLINES+1
+17 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Exam: "_PNAME
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 NEW COL1W,COL2W,FMTSTR
+20 SET TEMP="Exam:^"_PNAME
+21 SET COL1W=INDENT+5
SET COL2W=80-COL1W
+22 SET FMTSTR=COL1W_"R1^"_COL2W_"L"
+23 DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NOUT,.TEXTOUT)
+24 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:1
+25 SET IND=0
+26 FOR
SET IND=+$ORDER(IFIEVAL(IND))
if IND=0
QUIT
Begin DoDot:1
+27 SET VDATE=IFIEVAL(IND,"DATE")
+28 SET TEMP=$$EDATE^PXRMDATE(VDATE)
+29 SET RESULT=$GET(IFIEVAL(IND,"RESULT"))
+30 IF RESULT'=""
Begin DoDot:2
+31 SET TEMP=TEMP_" result - "
+32 SET TEMP=TEMP_$$EXTERNAL^DILFD(9000010.13,.04,"",RESULT,.EM)
End DoDot:2
+33 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+34 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+35 IF IFIEVAL(IND,"MEASUREMENT")'=""
Begin DoDot:2
+36 SET MAGNITUDE=$PIECE(IFIEVAL(IND,"MEASUREMENT"),U,1)
+37 IF MAGNITUDE=""
QUIT
+38 SET NLINES=NLINES+1
+39 SET CAPTION=$SELECT(UNITS="":"Magnitude: ",1:"Measurement: ")
+40 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_CAPTION_MAGNITUDE
+41 IF UNITS'=""
SET TEXT(NLINES)=TEXT(NLINES)_" "_UNITS
End DoDot:2
+42 IF IFIEVAL(IND,"COMMENTS")'=""
Begin DoDot:2
+43 SET TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
+44 DO FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+45 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:2
End DoDot:1
+46 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+47 QUIT
+48 ;
