PXRMMH ; SLC/PKR - Handle mental health findings. ;11/23/2007
;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
;
;=======================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate mental health findings.
D EVALFI^PXRMINDX(DFN,.DEFARR,ENODE,.FIEVAL)
Q
;
;=======================================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate mental health term findings
;for patient lists.
D EVALPL^PXRMINDL(.FINDPA,ENODE,.TERMARR,PLIST)
Q
;
;=======================================================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate mental
;health instrument terms.
D EVALTERM^PXRMINDX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
Q
;
;=======================================================
GETDATA(DASP,FIEVT) ;Return the data for a MH Administrations entry.
;Some tests require the YSP key in order to get a score.
N DAS,DATA,IND,SCALE
S DAS=$P(DASP,"S",1)
S SCALE=+$P(DASP,"S",2)
;DBIA #5043
D ENDAS71^YTQPXRM6(.DATA,DAS)
I $G(DATA(1))="[ERROR]" Q
I SCALE=0 S SCALE=+$O(DATA("SI",""))
S FIEVT("MH TEST")=$P(DATA(2),U,3)
S IND=0
F S IND=$O(DATA("SI",IND)) Q:IND="" S FIEVT("S",IND)=$P(DATA("SI",IND),U,3,4)
S IND=0
F S IND=$O(DATA("R",IND)) Q:IND="" S FIEVT("R",IND)=$P(DATA("R",IND),U,6)
I $D(DATA("SI",SCALE)) S FIEVT("VALUE")=FIEVT("S",SCALE),FIEVT("SCALE NAME")=$P(DATA("SI",SCALE),U,2)
Q
;
;=======================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
N DATE,IND,JND,MHTEST,NOUT,SCALE,SNAME,SCORE,TEXTOUT
S MHTEST="Mental Health Test: "_IFIEVAL("MH TEST")_" = "
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S DATE="("_$$EDATE^PXRMDATE(IFIEVAL(IND,"DATE"))_")"
. S TEMP=MHTEST_DATE
. S SNAME=$G(IFIEVAL(IND,"SCALE NAME"))
. I SNAME'="" S TEMP=TEMP_" scale: "_SNAME_" -"
. S SCORE=$G(IFIEVAL(IND,"VALUE"))
. I SCORE'="" S TEMP=TEMP_" raw score: "_$P(SCORE,U,1)_", transformed score: "_$P(SCORE,U,2)
. D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
;=======================================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
;maintenance output.
N IND,JND,MHTEST,NOUT,SCALE,SNAME,SCORE,TEXTOUT
S MHTEST=IFIEVAL("MH TEST")
S NLINES=NLINES+1
S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Mental Health Test: "_MHTEST
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S TEMP=$$EDATE^PXRMDATE(IFIEVAL(IND,"DATE"))
. S SNAME=$G(IFIEVAL(IND,"SCALE NAME"))
. I SNAME'="" S TEMP=TEMP_" scale: "_SNAME_" -"
. S SCORE=$G(IFIEVAL(IND,"VALUE"))
. I SCORE'="" S TEMP=TEMP_" raw score: "_$P(SCORE,U,1)_", transformed score: "_$P(SCORE,U,2)
. D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
;=======================================================
SCHELP(MHIEN) ;Xecutable help for MH SCALE
N DATA,IND,JND,NUM,SCALE,SNUM
I MHIEN=0 D Q
. S SCALE(1)="This is not a valid Mental Health finding, selecting an MH scale does"
. S SCALE(2)="not make sense"
. D EN^DDIOL(.SCALE)
;DBIA #5053
D SCALES^YTQPXRM5(.DATA,MHIEN)
I DATA(1)="ERROR" D Q
. S SCALE(1)="There are no scales for this test."
. D EN^DDIOL(.SCALE)
S SCALE(1)="Valid scales are:"
S SCALE(2)="SCALE NUMBER SCALE NAME"
S SCALE(3)="------------------------"
S IND=0,JND=3
F S IND=$O(DATA("S",IND)) Q:IND="" D
. S JND=JND+1
. S NUM=6-$L(IND)
. S SCALE(JND)=$$INSCHR^PXRMEXLC(NUM," ")_(IND)_" "_$P(DATA("S",IND),U,1)
D EN^DDIOL(.SCALE)
Q
;
;=======================================================
SCHELPD(DA) ;Xecutable help for MH SCALE in Result Group file 801.41
N MHIEN
S MHIEN=+$P($G(^PXRMD(801.41,DA,50)),U)
D SCHELP^PXRMMH(MHIEN)
Q
;=======================================================
SCHELPF ;Xecutable help for MH SCALE in 811.9 findings.
N FIND0,MHIEN
S FIND0=^PXD(811.9,DA(1),20,DA,0)
I FIND0["YTT(601.71" S MHIEN=$P(FIND0,";",1)
E S MHIEN=0
D SCHELP(MHIEN)
Q
;
;=======================================================
SCHELPT ;Xecutable help for MH SCALE in 811.5 findings.
N MHIEN,TFIND0
S TFIND0=^PXRMD(811.5,DA(1),20,DA,0)
I TFIND0["YTT(601.71" S MHIEN=$P(TFIND0,";",1)
E S MHIEN=0
D SCHELP(MHIEN)
Q
;
;=======================================================
SCNAME(TEST,SCNUM) ;Given the test ien and scale number return the
;scale name.
N DATA,SCNAME
D SCALES^YTQPXRM5(.DATA,TEST)
Q $G(DATA("S",SCNUM))
;
;=======================================================
SEVALFI(DFN,ITEM,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;
N FIEV,FINDING,IND,YS,DATA
S YS("CODE")=ITEM,YS("DFN")=DFN
S YS("BEGIN")=BDT,YS("END")=EDT
;PTTEST^YTQPXRM2 does not understand "*" for a limit so use 99.
I NGET="*" S NGET=99
S YS("LIMIT")=$S(SDIR=-1:NGET,1:-NGET)
;DBIA #5035
D PTTEST^YTQPXRM2(.DATA,.YS)
S NFOUND=$P(DATA(1),U,2)
I NFOUND=0 Q
F IND=1:1:NFOUND S FLIST(IND)=DATA(IND+1)
Q
;
;=======================================================
SEVALPL(ITEM,NOCC,BDT,EDT,PLIST) ;Use MH API to get patient list. Called
;from PXRMINDL.
N YS
;YTAPI10A does not understand "*" for a limit so use 99.
;OCCUR^YTQPXRM1 does not understand "*" for a limit so use 99.
I NOCC="*" S NOCC=99
S YS("CODE")=ITEM,YS("BEGIN")=BDT,YS("END")=EDT,YS("LIMIT")=NOCC
;DBIA #5034
D OCCUR^YTQPXRM1(PLIST,.YS)
Q
;
;=======================================================
VSCALE(X,FIND0) ;Make sure that the mental health scale is valid.
;Either the scale number or the scale name can be used.
N DATA,IND,MHIEN,MHTEST,SCALE,VALID
S MHTEST=$P(FIND0,U,1)
S MHIEN=$P(MHTEST,";",1)
D SCALES^YTQPXRM5(.DATA,MHIEN)
I +X>0 S VALID=$S($D(DATA("S",X)):1,1:0)
E D
. S IND=1,VALID=0
. F S IND=$O(DATA("S",IND)) Q:(VALID)!(IND="") D
.. I X=$P(DATA("S",IND),U,1) S VALID=1 Q
I 'VALID D EN^DDIOL(X_" is not a valid scale for this test!")
I $O(DATA(""),-1)>20 H 1
Q VALID
;
;=======================================================
VSCALED(X,DA) ;Make sure that the mental health scale is valid for a result
;group.
I X="" Q 1
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q 1
;Do not execute as part of exchange.
I $G(PXRMEXCH) Q 1
N MHTEST
S MHTEST=$P($G(^PXRMD(801.41,DA,50)),U)
Q $$VSCALE(X,MHTEST)
;
;=======================================================
VSCALEF(X) ;Make sure that the mental health scale is valid for a finding.
I X="" Q 1
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q 1
;Do not execute as part of exchange.
I $G(PXRMEXCH) Q 1
N FIND0
S FIND0=^PXD(811.9,DA(1),20,DA,0)
Q $$VSCALE(X,FIND0)
;
;=======================================================
VSCALET(X) ;Make sure that the mental health scale is valid for a
;term finding.
I X="" Q 1
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q 1
;Do not execute as part of exchange.
I $G(PXRMEXCH) Q 1
N TFIND0
S TFIND0=^PXRMD(811.5,DA(1),20,DA,0)
Q $$VSCALE(X,TFIND0)
;
;=======================================================
WARN ;Warn the user that they must select a scale if they intend to use
;a condition.
W !,"Remember that the score is returned as raw score^transformed score,"
W !,"so if your Condition uses the raw score use +V or $P(V,U,1) and if"
W !,"it uses the transformed score use $P(V,U,2)."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMMH 7660 printed Sep 23, 2025@19:22:42 Page 2
PXRMMH ; SLC/PKR - Handle mental health findings. ;11/23/2007
+1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+2 ;
+3 ;=======================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate mental health findings.
+1 DO EVALFI^PXRMINDX(DFN,.DEFARR,ENODE,.FIEVAL)
+2 QUIT
+3 ;
+4 ;=======================================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate mental health 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 mental
+1 ;health instrument terms.
+2 DO EVALTERM^PXRMINDX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL)
+3 QUIT
+4 ;
+5 ;=======================================================
GETDATA(DASP,FIEVT) ;Return the data for a MH Administrations entry.
+1 ;Some tests require the YSP key in order to get a score.
+2 NEW DAS,DATA,IND,SCALE
+3 SET DAS=$PIECE(DASP,"S",1)
+4 SET SCALE=+$PIECE(DASP,"S",2)
+5 ;DBIA #5043
+6 DO ENDAS71^YTQPXRM6(.DATA,DAS)
+7 IF $GET(DATA(1))="[ERROR]"
QUIT
+8 IF SCALE=0
SET SCALE=+$ORDER(DATA("SI",""))
+9 SET FIEVT("MH TEST")=$PIECE(DATA(2),U,3)
+10 SET IND=0
+11 FOR
SET IND=$ORDER(DATA("SI",IND))
if IND=""
QUIT
SET FIEVT("S",IND)=$PIECE(DATA("SI",IND),U,3,4)
+12 SET IND=0
+13 FOR
SET IND=$ORDER(DATA("R",IND))
if IND=""
QUIT
SET FIEVT("R",IND)=$PIECE(DATA("R",IND),U,6)
+14 IF $DATA(DATA("SI",SCALE))
SET FIEVT("VALUE")=FIEVT("S",SCALE)
SET FIEVT("SCALE NAME")=$PIECE(DATA("SI",SCALE),U,2)
+15 QUIT
+16 ;
+17 ;=======================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 NEW DATE,IND,JND,MHTEST,NOUT,SCALE,SNAME,SCORE,TEXTOUT
+2 SET MHTEST="Mental Health Test: "_IFIEVAL("MH TEST")_" = "
+3 SET IND=0
+4 FOR
SET IND=+$ORDER(IFIEVAL(IND))
if IND=0
QUIT
Begin DoDot:1
+5 SET DATE="("_$$EDATE^PXRMDATE(IFIEVAL(IND,"DATE"))_")"
+6 SET TEMP=MHTEST_DATE
+7 SET SNAME=$GET(IFIEVAL(IND,"SCALE NAME"))
+8 IF SNAME'=""
SET TEMP=TEMP_" scale: "_SNAME_" -"
+9 SET SCORE=$GET(IFIEVAL(IND,"VALUE"))
+10 IF SCORE'=""
SET TEMP=TEMP_" raw score: "_$PIECE(SCORE,U,1)_", transformed score: "_$PIECE(SCORE,U,2)
+11 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+12 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:1
+13 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+14 QUIT
+15 ;
+16 ;=======================================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+1 ;maintenance output.
+2 NEW IND,JND,MHTEST,NOUT,SCALE,SNAME,SCORE,TEXTOUT
+3 SET MHTEST=IFIEVAL("MH TEST")
+4 SET NLINES=NLINES+1
+5 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Mental Health Test: "_MHTEST
+6 SET IND=0
+7 FOR
SET IND=+$ORDER(IFIEVAL(IND))
if IND=0
QUIT
Begin DoDot:1
+8 SET TEMP=$$EDATE^PXRMDATE(IFIEVAL(IND,"DATE"))
+9 SET SNAME=$GET(IFIEVAL(IND,"SCALE NAME"))
+10 IF SNAME'=""
SET TEMP=TEMP_" scale: "_SNAME_" -"
+11 SET SCORE=$GET(IFIEVAL(IND,"VALUE"))
+12 IF SCORE'=""
SET TEMP=TEMP_" raw score: "_$PIECE(SCORE,U,1)_", transformed score: "_$PIECE(SCORE,U,2)
+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)
End DoDot:1
+15 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+16 QUIT
+17 ;
+18 ;=======================================================
SCHELP(MHIEN) ;Xecutable help for MH SCALE
+1 NEW DATA,IND,JND,NUM,SCALE,SNUM
+2 IF MHIEN=0
Begin DoDot:1
+3 SET SCALE(1)="This is not a valid Mental Health finding, selecting an MH scale does"
+4 SET SCALE(2)="not make sense"
+5 DO EN^DDIOL(.SCALE)
End DoDot:1
QUIT
+6 ;DBIA #5053
+7 DO SCALES^YTQPXRM5(.DATA,MHIEN)
+8 IF DATA(1)="ERROR"
Begin DoDot:1
+9 SET SCALE(1)="There are no scales for this test."
+10 DO EN^DDIOL(.SCALE)
End DoDot:1
QUIT
+11 SET SCALE(1)="Valid scales are:"
+12 SET SCALE(2)="SCALE NUMBER SCALE NAME"
+13 SET SCALE(3)="------------------------"
+14 SET IND=0
SET JND=3
+15 FOR
SET IND=$ORDER(DATA("S",IND))
if IND=""
QUIT
Begin DoDot:1
+16 SET JND=JND+1
+17 SET NUM=6-$LENGTH(IND)
+18 SET SCALE(JND)=$$INSCHR^PXRMEXLC(NUM," ")_(IND)_" "_$PIECE(DATA("S",IND),U,1)
End DoDot:1
+19 DO EN^DDIOL(.SCALE)
+20 QUIT
+21 ;
+22 ;=======================================================
SCHELPD(DA) ;Xecutable help for MH SCALE in Result Group file 801.41
+1 NEW MHIEN
+2 SET MHIEN=+$PIECE($GET(^PXRMD(801.41,DA,50)),U)
+3 DO SCHELP^PXRMMH(MHIEN)
+4 QUIT
+5 ;=======================================================
SCHELPF ;Xecutable help for MH SCALE in 811.9 findings.
+1 NEW FIND0,MHIEN
+2 SET FIND0=^PXD(811.9,DA(1),20,DA,0)
+3 IF FIND0["YTT(601.71"
SET MHIEN=$PIECE(FIND0,";",1)
+4 IF '$TEST
SET MHIEN=0
+5 DO SCHELP(MHIEN)
+6 QUIT
+7 ;
+8 ;=======================================================
SCHELPT ;Xecutable help for MH SCALE in 811.5 findings.
+1 NEW MHIEN,TFIND0
+2 SET TFIND0=^PXRMD(811.5,DA(1),20,DA,0)
+3 IF TFIND0["YTT(601.71"
SET MHIEN=$PIECE(TFIND0,";",1)
+4 IF '$TEST
SET MHIEN=0
+5 DO SCHELP(MHIEN)
+6 QUIT
+7 ;
+8 ;=======================================================
SCNAME(TEST,SCNUM) ;Given the test ien and scale number return the
+1 ;scale name.
+2 NEW DATA,SCNAME
+3 DO SCALES^YTQPXRM5(.DATA,TEST)
+4 QUIT $GET(DATA("S",SCNUM))
+5 ;
+6 ;=======================================================
SEVALFI(DFN,ITEM,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;
+1 NEW FIEV,FINDING,IND,YS,DATA
+2 SET YS("CODE")=ITEM
SET YS("DFN")=DFN
+3 SET YS("BEGIN")=BDT
SET YS("END")=EDT
+4 ;PTTEST^YTQPXRM2 does not understand "*" for a limit so use 99.
+5 IF NGET="*"
SET NGET=99
+6 SET YS("LIMIT")=$SELECT(SDIR=-1:NGET,1:-NGET)
+7 ;DBIA #5035
+8 DO PTTEST^YTQPXRM2(.DATA,.YS)
+9 SET NFOUND=$PIECE(DATA(1),U,2)
+10 IF NFOUND=0
QUIT
+11 FOR IND=1:1:NFOUND
SET FLIST(IND)=DATA(IND+1)
+12 QUIT
+13 ;
+14 ;=======================================================
SEVALPL(ITEM,NOCC,BDT,EDT,PLIST) ;Use MH API to get patient list. Called
+1 ;from PXRMINDL.
+2 NEW YS
+3 ;YTAPI10A does not understand "*" for a limit so use 99.
+4 ;OCCUR^YTQPXRM1 does not understand "*" for a limit so use 99.
+5 IF NOCC="*"
SET NOCC=99
+6 SET YS("CODE")=ITEM
SET YS("BEGIN")=BDT
SET YS("END")=EDT
SET YS("LIMIT")=NOCC
+7 ;DBIA #5034
+8 DO OCCUR^YTQPXRM1(PLIST,.YS)
+9 QUIT
+10 ;
+11 ;=======================================================
VSCALE(X,FIND0) ;Make sure that the mental health scale is valid.
+1 ;Either the scale number or the scale name can be used.
+2 NEW DATA,IND,MHIEN,MHTEST,SCALE,VALID
+3 SET MHTEST=$PIECE(FIND0,U,1)
+4 SET MHIEN=$PIECE(MHTEST,";",1)
+5 DO SCALES^YTQPXRM5(.DATA,MHIEN)
+6 IF +X>0
SET VALID=$SELECT($DATA(DATA("S",X)):1,1:0)
+7 IF '$TEST
Begin DoDot:1
+8 SET IND=1
SET VALID=0
+9 FOR
SET IND=$ORDER(DATA("S",IND))
if (VALID)!(IND="")
QUIT
Begin DoDot:2
+10 IF X=$PIECE(DATA("S",IND),U,1)
SET VALID=1
QUIT
End DoDot:2
End DoDot:1
+11 IF 'VALID
DO EN^DDIOL(X_" is not a valid scale for this test!")
+12 IF $ORDER(DATA(""),-1)>20
HANG 1
+13 QUIT VALID
+14 ;
+15 ;=======================================================
VSCALED(X,DA) ;Make sure that the mental health scale is valid for a result
+1 ;group.
+2 IF X=""
QUIT 1
+3 ;Do not execute as part of a verify fields.
+4 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT 1
+5 ;Do not execute as part of exchange.
+6 IF $GET(PXRMEXCH)
QUIT 1
+7 NEW MHTEST
+8 SET MHTEST=$PIECE($GET(^PXRMD(801.41,DA,50)),U)
+9 QUIT $$VSCALE(X,MHTEST)
+10 ;
+11 ;=======================================================
VSCALEF(X) ;Make sure that the mental health scale is valid for a finding.
+1 IF X=""
QUIT 1
+2 ;Do not execute as part of a verify fields.
+3 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT 1
+4 ;Do not execute as part of exchange.
+5 IF $GET(PXRMEXCH)
QUIT 1
+6 NEW FIND0
+7 SET FIND0=^PXD(811.9,DA(1),20,DA,0)
+8 QUIT $$VSCALE(X,FIND0)
+9 ;
+10 ;=======================================================
VSCALET(X) ;Make sure that the mental health scale is valid for a
+1 ;term finding.
+2 IF X=""
QUIT 1
+3 ;Do not execute as part of a verify fields.
+4 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT 1
+5 ;Do not execute as part of exchange.
+6 IF $GET(PXRMEXCH)
QUIT 1
+7 NEW TFIND0
+8 SET TFIND0=^PXRMD(811.5,DA(1),20,DA,0)
+9 QUIT $$VSCALE(X,TFIND0)
+10 ;
+11 ;=======================================================
WARN ;Warn the user that they must select a scale if they intend to use
+1 ;a condition.
+2 WRITE !,"Remember that the score is returned as raw score^transformed score,"
+3 WRITE !,"so if your Condition uses the raw score use +V or $P(V,U,1) and if"
+4 WRITE !,"it uses the transformed score use $P(V,U,2)."
+5 QUIT
+6 ;
