PXRMHF ;SLC/PKR - Handle Health Factor findings. ;04/05/2022
;;2.0;CLINICAL REMINDERS;**6,17,18,42,65**;Feb 04, 2005;Build 438
;
;=====================================================
CATSORT(FIEVAL,FIND0,FARR) ;Sort all the true health factor findings
;according to the category criteria. FIND0 will be defined only
;for terms.
N CAT,CATLIST,DATE,IND,FI,HFIEN,LDATE,NTRUE,WCR
S HFIEN=""
F S HFIEN=$O(FARR("E","AUTTHF(",HFIEN)) Q:HFIEN="" D
. S FI=0
. F S FI=$O(FARR("E","AUTTHF(",HFIEN,FI)) Q:FI="" D
.. I 'FIEVAL(FI) Q
..;Get the Within Category Rank
.. S WCR=$P(FARR(20,FI,0),U,10)
.. I WCR="" S WCR=$P(FIND0,U,10)
.. I WCR="" S WCR=9999
..;If Within Category Rank is 0 ignore the category and treat it like
..;regular finding (exclude it from the list).
.. I WCR>0 D
... S CAT=$P(^AUTTHF(HFIEN,0),U,3)
...;If the category is null then send a warning.
... I CAT="" D WARN(^AUTTHF(HFIEN,0)) Q
... S CATLIST(CAT,FIEVAL(FI,"DATE"),WCR,FI)=""
... I $G(PXRMDEBG) S FIEVAL(FI,"CAT^WCR")=CAT_U_WCR
;No health factors to categorize then quit.
I '$D(CATLIST) Q
;Only the most recent HF in a category can be true.
S CAT=""
F S CAT=$O(CATLIST(CAT)) Q:CAT="" D
. S LDATE=$O(CATLIST(CAT,""),-1)
.;For each category set all but the most recent HF false.
. S DATE=""
. F S DATE=$O(CATLIST(CAT,DATE)) Q:DATE=LDATE D
.. S WCR=""
.. F S WCR=$O(CATLIST(CAT,DATE,WCR)) Q:WCR="" D
... S FI=""
... F S FI=$O(CATLIST(CAT,DATE,WCR,FI)) Q:FI="" D
.... S FIEVAL(FI)=0
....;If there are multiple occurrences set them all false.
.... S IND=0
.... F S IND=+$O(FIEVAL(FI,IND)) Q:IND=0 S FIEVAL(FI,IND)=0
.;
.;If there is more than on HF on the most recent date then only the
.;one with the highest WCR can be true. The highest possible WCR is 1.
.;Set all with lower WCRs false.
.;If the most recent health factor has multiple occurrences only
.;the first occurrence can be true.
. S (NTRUE,WCR)=0
. F S WCR=$O(CATLIST(CAT,LDATE,WCR)) Q:WCR="" D
.. S FI=""
.. F S FI=$O(CATLIST(CAT,LDATE,WCR,FI)) Q:FI="" D
... I NTRUE=0 D Q
....;If there are multiple sub-occurrences set them all false.
.... S (IND,NTRUE)=1
.... F S IND=+$O(FIEVAL(FI,IND)) Q:IND=0 S FIEVAL(FI,IND)=0
... S FIEVAL(FI)=0
...;If there are multiple sub-occurrences set them all false.
... S IND=0
... F S IND=+$O(FIEVAL(FI,IND)) Q:IND=0 S FIEVAL(FI,IND)=0
Q
;
;=====================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate health factor findings.
N FIEVT,FILENUM,FINDPA,FINDING,HFIEN,NOINDEX
S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("D",PXRMITEM,FILENUM)
. S NOINDEX=1
E S NOINDEX=0
S HFIEN=""
F S HFIEN=$O(DEFARR("E",ENODE,HFIEN)) Q:+HFIEN=0 D
. S FINDING=""
. F S FINDING=$O(DEFARR("E",ENODE,HFIEN,FINDING)) Q:+FINDING=0 D
.. I NOINDEX S FIEVAL(FINDING)=0 Q
.. K FINDPA
.. M FINDPA=DEFARR(20,FINDING)
.. K FIEVT
.. D FIEVAL^PXRMINDX(FILENUM,"PI",DFN,HFIEN,.FINDPA,.FIEVT)
.. M FIEVAL(FINDING)=FIEVT
.. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
;Sort all the true findings by category.
D CATSORT(.FIEVAL,"",.DEFARR)
Q
;
;=====================================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate health factor term findings
;for patient lists.
D EVALPL^PXRMINDL(.FINDPA,ENODE,.TERMARR,PLIST)
Q
;
;=====================================================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate health factor terms.
N BDT,EDT,FIEVT,HFIEN,NOINDEX,PFINDPA
N TFINDPA,TFINDING
I $G(^PXRMINDX(9000010.23,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),9000010.23)
. S NOINDEX=1
E S NOINDEX=0
S HFIEN=""
F S HFIEN=$O(TERMARR("E",ENODE,HFIEN)) Q:+HFIEN=0 D
. S TFINDING=""
. F S TFINDING=$O(TERMARR("E",ENODE,HFIEN,TFINDING)) Q:+TFINDING=0 D
.. I NOINDEX S TFIEVAL(TFINDING)=0 Q
.. K FIEVT,PFINDPA,TFINDPA
.. M TFINDPA=TERMARR(20,TFINDING)
..;Set the finding parameters.
.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
.. D FIEVAL^PXRMINDX(9000010.23,"PI",DFN,HFIEN,.PFINDPA,.FIEVT)
.. M TFIEVAL(TFINDING)=FIEVT
.. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
;Sort all the true findings by category.
D CATSORT(.TFIEVAL,FINDPA(0),.TERMARR)
Q
;
;=====================================================
GETDATA(DAS,FIEVT) ;Return data for a specified V Health Factor entry.
;DBIA #4250
D VHF^PXPXRM(DAS,.FIEVT)
Q
;
;=====================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
N CAPTION,EM,FIEN,HF220,IND,JND,LVL,MAGNITUDE,NAME,NOUT,PNAME,TEMP,TEXTOUT
N UCUMIEN,UCUMDISPLAY,UCUMFIELD,UNITS,VDATE
S FIEN=$P(IFIEVAL("FINDING"),";",1)
S PNAME=$P($G(^AUTTHF(FIEN,200)),U,1)
I PNAME="" S PNAME=$P(^AUTTHF(FIEN,0),U,1)
S NAME="Health Factor: "_PNAME_" = "
S HF220=$G(^AUTTHF(FIEN,220))
S UCUMIEN=$P(HF220,U,4)
I UCUMIEN'="" D
. S UCUMDISPLAY=$P(HF220,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 LVL=$G(IFIEVAL(IND,"VALUE"))
. I LVL'="" S LVL=$$EXTERNAL^DILFD(9000010.23,.04,"",LVL,.EM)
. S VDATE=IFIEVAL(IND,"DATE")
. S TEMP=NAME_LVL_" ("_$$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,FIEN,HF220,IND,JND,LVL,MAGNITUDE,NOUT,PNAME,TEMP,TEXTOUT
N UCUMIEN,UCUMDISPLAY,UCUMFIELD,UNITS,VDATE
S FIEN=$P(IFIEVAL("FINDING"),";",1)
;DBIA #3083
S PNAME=$P($G(^AUTTHF(FIEN,200)),U,1)
I PNAME="" S PNAME=$P(^AUTTHF(FIEN,0),U,1)
S HF220=$G(^AUTTHF(FIEN,220))
S UCUMIEN=$P(HF220,U,4)
I UCUMIEN'="" D
. S UCUMDISPLAY=$P(HF220,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+15+$L(PNAME)<81 D
. S NLINES=NLINES+1
. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Health Factor: "_PNAME
E D
. N COL1W,COL2W,FMTSTR
. S TEMP="Health Factor:^"_PNAME
. S COL1W=INDENT+14,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 LVL=$G(IFIEVAL(IND,"VALUE"))
. I LVL'="" D
.. S TEMP=TEMP_" level/severity - "
.. S TEMP=TEMP_$$EXTERNAL^DILFD(9000010.23,.04,"",LVL,.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
;
;=====================================================
WARN(HF0) ;Issue a warning if a health factor is missing its category.
N XMSUB
K ^TMP("PXRMXMZ",$J)
S XMSUB="CLINICAL REMINDER DATA PROBLEM, HEALTH FACTOR"
S ^TMP("PXRMXMZ",$J,1,0)="Health Factor "_$P(HF0,U,1)
S ^TMP("PXRMXMZ",$J,2,0)="does not have a category, this is a required field."
S ^TMP("PXRMXMZ",$J,3,0)="This health factor will be ignored for all patients until the problem is fixed."
D SEND^PXRMMSG("PXRMXMZ",XMSUB,"",DUZ)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMHF 8492 printed Apr 09, 2024@20:54:03 Page 2
PXRMHF ;SLC/PKR - Handle Health Factor findings. ;04/05/2022
+1 ;;2.0;CLINICAL REMINDERS;**6,17,18,42,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;=====================================================
CATSORT(FIEVAL,FIND0,FARR) ;Sort all the true health factor findings
+1 ;according to the category criteria. FIND0 will be defined only
+2 ;for terms.
+3 NEW CAT,CATLIST,DATE,IND,FI,HFIEN,LDATE,NTRUE,WCR
+4 SET HFIEN=""
+5 FOR
SET HFIEN=$ORDER(FARR("E","AUTTHF(",HFIEN))
if HFIEN=""
QUIT
Begin DoDot:1
+6 SET FI=0
+7 FOR
SET FI=$ORDER(FARR("E","AUTTHF(",HFIEN,FI))
if FI=""
QUIT
Begin DoDot:2
+8 IF 'FIEVAL(FI)
QUIT
+9 ;Get the Within Category Rank
+10 SET WCR=$PIECE(FARR(20,FI,0),U,10)
+11 IF WCR=""
SET WCR=$PIECE(FIND0,U,10)
+12 IF WCR=""
SET WCR=9999
+13 ;If Within Category Rank is 0 ignore the category and treat it like
+14 ;regular finding (exclude it from the list).
+15 IF WCR>0
Begin DoDot:3
+16 SET CAT=$PIECE(^AUTTHF(HFIEN,0),U,3)
+17 ;If the category is null then send a warning.
+18 IF CAT=""
DO WARN(^AUTTHF(HFIEN,0))
QUIT
+19 SET CATLIST(CAT,FIEVAL(FI,"DATE"),WCR,FI)=""
+20 IF $GET(PXRMDEBG)
SET FIEVAL(FI,"CAT^WCR")=CAT_U_WCR
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;No health factors to categorize then quit.
+22 IF '$DATA(CATLIST)
QUIT
+23 ;Only the most recent HF in a category can be true.
+24 SET CAT=""
+25 FOR
SET CAT=$ORDER(CATLIST(CAT))
if CAT=""
QUIT
Begin DoDot:1
+26 SET LDATE=$ORDER(CATLIST(CAT,""),-1)
+27 ;For each category set all but the most recent HF false.
+28 SET DATE=""
+29 FOR
SET DATE=$ORDER(CATLIST(CAT,DATE))
if DATE=LDATE
QUIT
Begin DoDot:2
+30 SET WCR=""
+31 FOR
SET WCR=$ORDER(CATLIST(CAT,DATE,WCR))
if WCR=""
QUIT
Begin DoDot:3
+32 SET FI=""
+33 FOR
SET FI=$ORDER(CATLIST(CAT,DATE,WCR,FI))
if FI=""
QUIT
Begin DoDot:4
+34 SET FIEVAL(FI)=0
+35 ;If there are multiple occurrences set them all false.
+36 SET IND=0
+37 FOR
SET IND=+$ORDER(FIEVAL(FI,IND))
if IND=0
QUIT
SET FIEVAL(FI,IND)=0
End DoDot:4
End DoDot:3
End DoDot:2
+38 ;
+39 ;If there is more than on HF on the most recent date then only the
+40 ;one with the highest WCR can be true. The highest possible WCR is 1.
+41 ;Set all with lower WCRs false.
+42 ;If the most recent health factor has multiple occurrences only
+43 ;the first occurrence can be true.
+44 SET (NTRUE,WCR)=0
+45 FOR
SET WCR=$ORDER(CATLIST(CAT,LDATE,WCR))
if WCR=""
QUIT
Begin DoDot:2
+46 SET FI=""
+47 FOR
SET FI=$ORDER(CATLIST(CAT,LDATE,WCR,FI))
if FI=""
QUIT
Begin DoDot:3
+48 IF NTRUE=0
Begin DoDot:4
+49 ;If there are multiple sub-occurrences set them all false.
+50 SET (IND,NTRUE)=1
+51 FOR
SET IND=+$ORDER(FIEVAL(FI,IND))
if IND=0
QUIT
SET FIEVAL(FI,IND)=0
End DoDot:4
QUIT
+52 SET FIEVAL(FI)=0
+53 ;If there are multiple sub-occurrences set them all false.
+54 SET IND=0
+55 FOR
SET IND=+$ORDER(FIEVAL(FI,IND))
if IND=0
QUIT
SET FIEVAL(FI,IND)=0
End DoDot:3
End DoDot:2
End DoDot:1
+56 QUIT
+57 ;
+58 ;=====================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate health factor findings.
+1 NEW FIEVT,FILENUM,FINDPA,FINDING,HFIEN,NOINDEX
+2 SET FILENUM=$$GETFNUM^PXRMDATA(ENODE)
+3 IF $GET(^PXRMINDX(FILENUM,"DATE BUILT"))=""
Begin DoDot:1
+4 DO NOINDEX^PXRMERRH("D",PXRMITEM,FILENUM)
+5 SET NOINDEX=1
End DoDot:1
+6 IF '$TEST
SET NOINDEX=0
+7 SET HFIEN=""
+8 FOR
SET HFIEN=$ORDER(DEFARR("E",ENODE,HFIEN))
if +HFIEN=0
QUIT
Begin DoDot:1
+9 SET FINDING=""
+10 FOR
SET FINDING=$ORDER(DEFARR("E",ENODE,HFIEN,FINDING))
if +FINDING=0
QUIT
Begin DoDot:2
+11 IF NOINDEX
SET FIEVAL(FINDING)=0
QUIT
+12 KILL FINDPA
+13 MERGE FINDPA=DEFARR(20,FINDING)
+14 KILL FIEVT
+15 DO FIEVAL^PXRMINDX(FILENUM,"PI",DFN,HFIEN,.FINDPA,.FIEVT)
+16 MERGE FIEVAL(FINDING)=FIEVT
+17 SET FIEVAL(FINDING,"FINDING")=$PIECE(FINDPA(0),U,1)
End DoDot:2
End DoDot:1
+18 ;Sort all the true findings by category.
+19 DO CATSORT(.FIEVAL,"",.DEFARR)
+20 QUIT
+21 ;
+22 ;=====================================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate health factor 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 health factor terms.
+1 NEW BDT,EDT,FIEVT,HFIEN,NOINDEX,PFINDPA
+2 NEW TFINDPA,TFINDING
+3 IF $GET(^PXRMINDX(9000010.23,"DATE BUILT"))=""
Begin DoDot:1
+4 DO NOINDEX^PXRMERRH("TR",TERMARR("IEN"),9000010.23)
+5 SET NOINDEX=1
End DoDot:1
+6 IF '$TEST
SET NOINDEX=0
+7 SET HFIEN=""
+8 FOR
SET HFIEN=$ORDER(TERMARR("E",ENODE,HFIEN))
if +HFIEN=0
QUIT
Begin DoDot:1
+9 SET TFINDING=""
+10 FOR
SET TFINDING=$ORDER(TERMARR("E",ENODE,HFIEN,TFINDING))
if +TFINDING=0
QUIT
Begin DoDot:2
+11 IF NOINDEX
SET TFIEVAL(TFINDING)=0
QUIT
+12 KILL FIEVT,PFINDPA,TFINDPA
+13 MERGE TFINDPA=TERMARR(20,TFINDING)
+14 ;Set the finding parameters.
+15 DO SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+16 DO FIEVAL^PXRMINDX(9000010.23,"PI",DFN,HFIEN,.PFINDPA,.FIEVT)
+17 MERGE TFIEVAL(TFINDING)=FIEVT
+18 SET TFIEVAL(TFINDING,"FINDING")=$PIECE(TFINDPA(0),U,1)
End DoDot:2
End DoDot:1
+19 ;Sort all the true findings by category.
+20 DO CATSORT(.TFIEVAL,FINDPA(0),.TERMARR)
+21 QUIT
+22 ;
+23 ;=====================================================
GETDATA(DAS,FIEVT) ;Return data for a specified V Health Factor entry.
+1 ;DBIA #4250
+2 DO VHF^PXPXRM(DAS,.FIEVT)
+3 QUIT
+4 ;
+5 ;=====================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 NEW CAPTION,EM,FIEN,HF220,IND,JND,LVL,MAGNITUDE,NAME,NOUT,PNAME,TEMP,TEXTOUT
+2 NEW UCUMIEN,UCUMDISPLAY,UCUMFIELD,UNITS,VDATE
+3 SET FIEN=$PIECE(IFIEVAL("FINDING"),";",1)
+4 SET PNAME=$PIECE($GET(^AUTTHF(FIEN,200)),U,1)
+5 IF PNAME=""
SET PNAME=$PIECE(^AUTTHF(FIEN,0),U,1)
+6 SET NAME="Health Factor: "_PNAME_" = "
+7 SET HF220=$GET(^AUTTHF(FIEN,220))
+8 SET UCUMIEN=$PIECE(HF220,U,4)
+9 IF UCUMIEN'=""
Begin DoDot:1
+10 SET UCUMDISPLAY=$PIECE(HF220,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 LVL=$GET(IFIEVAL(IND,"VALUE"))
+18 IF LVL'=""
SET LVL=$$EXTERNAL^DILFD(9000010.23,.04,"",LVL,.EM)
+19 SET VDATE=IFIEVAL(IND,"DATE")
+20 SET TEMP=NAME_LVL_" ("_$$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,FIEN,HF220,IND,JND,LVL,MAGNITUDE,NOUT,PNAME,TEMP,TEXTOUT
+3 NEW UCUMIEN,UCUMDISPLAY,UCUMFIELD,UNITS,VDATE
+4 SET FIEN=$PIECE(IFIEVAL("FINDING"),";",1)
+5 ;DBIA #3083
+6 SET PNAME=$PIECE($GET(^AUTTHF(FIEN,200)),U,1)
+7 IF PNAME=""
SET PNAME=$PIECE(^AUTTHF(FIEN,0),U,1)
+8 SET HF220=$GET(^AUTTHF(FIEN,220))
+9 SET UCUMIEN=$PIECE(HF220,U,4)
+10 IF UCUMIEN'=""
Begin DoDot:1
+11 SET UCUMDISPLAY=$PIECE(HF220,U,6)
+12 IF UCUMDISPLAY="N"
SET UNITS=""
QUIT
+13 SET UCUMFIELD=$SELECT(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
+14 SET UNITS=$$UCUMFIELDS^PXRMUCUM(UCUMIEN,UCUMFIELD)
End DoDot:1
+15 IF '$TEST
SET UNITS=""
+16 IF INDENT+15+$LENGTH(PNAME)<81
Begin DoDot:1
+17 SET NLINES=NLINES+1
+18 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Health Factor: "_PNAME
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 NEW COL1W,COL2W,FMTSTR
+21 SET TEMP="Health Factor:^"_PNAME
+22 SET COL1W=INDENT+14
SET COL2W=80-COL1W
+23 SET FMTSTR=COL1W_"R1^"_COL2W_"L"
+24 DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NOUT,.TEXTOUT)
+25 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:1
+26 SET IND=0
+27 FOR
SET IND=+$ORDER(IFIEVAL(IND))
if IND=0
QUIT
Begin DoDot:1
+28 SET VDATE=IFIEVAL(IND,"DATE")
+29 SET TEMP=$$EDATE^PXRMDATE(VDATE)
+30 SET LVL=$GET(IFIEVAL(IND,"VALUE"))
+31 IF LVL'=""
Begin DoDot:2
+32 SET TEMP=TEMP_" level/severity - "
+33 SET TEMP=TEMP_$$EXTERNAL^DILFD(9000010.23,.04,"",LVL,.EM)
End DoDot:2
+34 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+35 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+36 IF IFIEVAL(IND,"MEASUREMENT")'=""
Begin DoDot:2
+37 SET MAGNITUDE=$PIECE(IFIEVAL(IND,"MEASUREMENT"),U,1)
+38 IF MAGNITUDE=""
QUIT
+39 SET NLINES=NLINES+1
+40 SET CAPTION=$SELECT(UNITS="":"Magnitude: ",1:"Measurement: ")
+41 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT+1," ")_CAPTION_MAGNITUDE
+42 IF UNITS'=""
SET TEXT(NLINES)=TEXT(NLINES)_" "_UNITS
End DoDot:2
+43 IF IFIEVAL(IND,"COMMENTS")'=""
Begin DoDot:2
+44 SET TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
+45 DO FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+46 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:2
End DoDot:1
+47 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+48 QUIT
+49 ;
+50 ;=====================================================
WARN(HF0) ;Issue a warning if a health factor is missing its category.
+1 NEW XMSUB
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 SET XMSUB="CLINICAL REMINDER DATA PROBLEM, HEALTH FACTOR"
+4 SET ^TMP("PXRMXMZ",$JOB,1,0)="Health Factor "_$PIECE(HF0,U,1)
+5 SET ^TMP("PXRMXMZ",$JOB,2,0)="does not have a category, this is a required field."
+6 SET ^TMP("PXRMXMZ",$JOB,3,0)="This health factor will be ignored for all patients until the problem is fixed."
+7 DO SEND^PXRMMSG("PXRMXMZ",XMSUB,"",DUZ)
+8 QUIT
+9 ;
