Ignore:
Timestamp:
Dec 4, 2009, 8:26:01 PM (14 years ago)
Author:
George Lilly
Message:

WorldVistAEHR overlayed on FOIAVistA

Location:
FOIAVistA/tag/r
Files:
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMMH.m

    r628 r636  
    1 PXRMMH ; SLC/PKR - Handle mental health findings. ;11/23/2007
    2  ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
     1PXRMMH ; SLC/PKR - Handle mental health findings. ;04/05/2005
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
    33 ;
    44 ;=======================================================
     
    1212 D EVALPL^PXRMINDL(.FINDPA,ENODE,.TERMARR,PLIST)
    1313 Q
    14  ;
    1514 ;=======================================================
    1615EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate mental
     
    2019 ;
    2120 ;=======================================================
    22 GETDATA(DASP,FIEVT) ;Return the data for a MH Administrations entry.
     21GETDATA(DAS,FIEVT) ;Return the data for a Psych Instrument Patient entry.
    2322 ;Some tests require the YSP key in order to get a score.
    24  N DAS,DATA,IND,SCALE
    25  S DAS=$P(DASP,"S",1)
    26  S SCALE=+$P(DASP,"S",2)
    27  ;DBIA #5043
    28  D ENDAS71^YTQPXRM6(.DATA,DAS)
    29  I $G(DATA(1))="[ERROR]" Q
    30  I SCALE=0 S SCALE=+$O(DATA("SI",""))
    31  S FIEVT("MH TEST")=$P(DATA(2),U,3)
    32  S IND=0
    33  F  S IND=$O(DATA("SI",IND)) Q:IND=""  S FIEVT("S",IND)=$P(DATA("SI",IND),U,3,4)
    34  S IND=0
    35  F  S IND=$O(DATA("R",IND)) Q:IND=""  S FIEVT("R",IND)=$P(DATA("R",IND),U,6)
    36  I $D(DATA("SI",SCALE)) S FIEVT("VALUE")=FIEVT("S",SCALE),FIEVT("SCALE NAME")=$P(DATA("SI",SCALE),U,2)
     23 N DASP,IND,SCALE,YSDATA
     24 ;DBIA #4442
     25 S DASP=$P(DAS,"S",1)
     26 S SCALE=$P(DAS,"S",2)
     27 D ENDAS^YTAPI10(.YSDATA,DASP)
     28 I $G(YSDATA(0))="[ERROR]" Q
     29 S FIEVT("MH TEST")=$P(YSDATA(2),U,3)
     30 I FIEVT("MH TEST")["GAF" S FIEVT("RATING")=$P(YSDATA(3),U,2) Q
     31 ;If no scale is specified use the first set of results.
     32 S IND=$S(SCALE="":6,1:SCALE+5)
     33 S FIEVT("YSDATA")=$G(YSDATA(IND))
     34 S FIEVT("SCALE NAME")=$P(FIEVT("YSDATA"),U,2)
     35 S (FIEVT("RAW SCORE"),FIEVT("VALUE"))=$P(FIEVT("YSDATA"),U,3)
     36 S FIEVT("TRANSFORMED SCORE")=$P(FIEVT("YSDATA"),U,4)
    3737 Q
    3838 ;
    3939 ;=======================================================
    4040MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
    41  N DATE,IND,JND,MHTEST,NOUT,SCALE,SNAME,SCORE,TEXTOUT
    42  S MHTEST="Mental Health Test: "_IFIEVAL("MH TEST")_" = "
     41 N DATE,IND,JND,MHTEST,NAME,NOUT,RATING,RSCORE,SCORE,TEXTOUT,TSCORE
     42 S MHTEST=IFIEVAL("MH TEST")
     43 ;Remove the dashes surrounding the name.
     44 S MHTEST=$TR(MHTEST,"-","")
     45 S NAME="Mental Health Test: "_MHTEST_" = "
    4346 S IND=0
    4447 F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
    45  . S DATE="("_$$EDATE^PXRMDATE(IFIEVAL(IND,"DATE"))_")"
    46  . S TEMP=MHTEST_DATE
    47  . S SNAME=$G(IFIEVAL(IND,"SCALE NAME"))
    48  . I SNAME'="" S TEMP=TEMP_" scale: "_SNAME_" -"
    49  . S SCORE=$G(IFIEVAL(IND,"VALUE"))
    50  . I SCORE'="" S TEMP=TEMP_"  raw score: "_$P(SCORE,U,1)_", transformed score: "_$P(SCORE,U,2)
     48 . S DATE=IFIEVAL(IND,"DATE")
     49 . S RSCORE=$G(IFIEVAL(IND,"RAW SCORE"))
     50 . S TSCORE=$G(IFIEVAL(IND,"TRANSFORMED SCORE"))
     51 . S RATING=$G(IFIEVAL(IND,"RATING"))
     52 . S SCORE=$S(RATING'="":RATING,TSCORE'="":TSCORE,RSCORE'="":RSCORE,1:"")
     53 . S TEMP=NAME_SCORE_" ("_$$EDATE^PXRMDATE(IFIEVAL(IND,"DATE"))_")"
    5154 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
    5255 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
     
    5760OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
    5861 ;maintenance output.
    59  N IND,JND,MHTEST,NOUT,SCALE,SNAME,SCORE,TEXTOUT
     62 N DATE,IND,JND,MHTEST,NOUT,RATING,RSCORE,TEXTOUT,TSCORE
    6063 S MHTEST=IFIEVAL("MH TEST")
     64 ;Remove the dashes surrounding the name.
     65 S MHTEST=$TR(MHTEST,"-","")
    6166 S NLINES=NLINES+1
    6267 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Mental Health Test: "_MHTEST
    6368 S IND=0
    6469 F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
     70 . S DATE=IFIEVAL(IND,"DATE")
    6571 . S TEMP=$$EDATE^PXRMDATE(IFIEVAL(IND,"DATE"))
    66  . S SNAME=$G(IFIEVAL(IND,"SCALE NAME"))
    67  . I SNAME'="" S TEMP=TEMP_" scale: "_SNAME_" -"
    68  . S SCORE=$G(IFIEVAL(IND,"VALUE"))
    69  . I SCORE'="" S TEMP=TEMP_"  raw score: "_$P(SCORE,U,1)_", transformed score: "_$P(SCORE,U,2)
     72 . S RSCORE=$G(IFIEVAL(IND,"RAW SCORE"))
     73 . I RSCORE'="" S TEMP=TEMP_" raw score - "_RSCORE
     74 . S TSCORE=$G(IFIEVAL(IND,"TRANSFORMED SCORE"))
     75 . I TSCORE'="" S TEMP=TEMP_"; transformed score - "_TSCORE
     76 . S RATING=$G(IFIEVAL(IND,"RATING"))
     77 . I RATING'="" S TEMP=TEMP_" Rating: "_RATING
    7078 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
    7179 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
     
    7583 ;=======================================================
    7684SCHELP(MHIEN) ;Xecutable help for MH SCALE
    77  N DATA,IND,JND,NUM,SCALE,SNUM
     85 N IND,JND,NUM,SCALE,TEMP,TEMP1
    7886 I MHIEN=0 D  Q
    7987 . S SCALE(1)="This is not a valid Mental Health finding, selecting an MH scale does"
    8088 . S SCALE(2)="not make sense"
    8189 . D EN^DDIOL(.SCALE)
    82  ;DBIA #5053
    83  D SCALES^YTQPXRM5(.DATA,MHIEN)
    84  I DATA(1)="ERROR" D  Q
    85  . S SCALE(1)="There are no scales for this test."
    86  . D EN^DDIOL(.SCALE)
    87  S SCALE(1)="Valid scales are:"
    88  S SCALE(2)="SCALE NUMBER  SCALE NAME"
    89  S SCALE(3)="------------------------"
    90  S IND=0,JND=3
    91  F  S IND=$O(DATA("S",IND)) Q:IND=""  D
     90 S SCALE(1)="SCALE NUMBER  SCALE NAME"
     91 S SCALE(2)="------------------------"
     92 S IND=0
     93 S JND=2
     94 F  S IND=$O(^YTT(601,MHIEN,"S",IND)) Q:+IND=0  D
     95 . S TEMP=^YTT(601,MHIEN,"S",IND,0)
    9296 . S JND=JND+1
    93  . S NUM=6-$L(IND)
    94  . S SCALE(JND)=$$INSCHR^PXRMEXLC(NUM," ")_(IND)_"        "_$P(DATA("S",IND),U,1)
     97 . S TEMP1=$P(TEMP,U,1)
     98 . S NUM=6-$L(TEMP1)
     99 . S SCALE(JND)=$$INSCHR^PXRMEXLC(NUM," ")_TEMP1_"        "_$P(TEMP,U,2)
    95100 D EN^DDIOL(.SCALE)
    96101 Q
    97102 ;
    98103 ;=======================================================
    99 SCHELPD(DA) ;Xecutable help for MH SCALE in Result Group file 801.41
    100  N MHIEN
    101  S MHIEN=+$P($G(^PXRMD(801.41,DA,50)),U)
    102  D SCHELP^PXRMMH(MHIEN)
    103  Q
    104  ;=======================================================
    105104SCHELPF ;Xecutable help for MH SCALE in 811.9 findings.
    106105 N FIND0,MHIEN
    107106 S FIND0=^PXD(811.9,DA(1),20,DA,0)
    108  I FIND0["YTT(601.71" S MHIEN=$P(FIND0,";",1)
     107 I FIND0["YTT(601" S MHIEN=$P(FIND0,";",1)
    109108 E  S MHIEN=0
    110109 D SCHELP(MHIEN)
     
    115114 N MHIEN,TFIND0
    116115 S TFIND0=^PXRMD(811.5,DA(1),20,DA,0)
    117  I TFIND0["YTT(601.71" S MHIEN=$P(TFIND0,";",1)
     116 I TFIND0["YTT(601" S MHIEN=$P(TFIND0,";",1)
    118117 E  S MHIEN=0
    119118 D SCHELP(MHIEN)
     
    121120 ;
    122121 ;=======================================================
    123 SCNAME(TEST,SCNUM) ;Given the test ien and scale number return the
    124  ;scale name.
    125  N DATA,SCNAME
    126  D SCALES^YTQPXRM5(.DATA,TEST)
    127  Q $G(DATA("S",SCNUM))
    128  ;
    129  ;=======================================================
    130122SEVALFI(DFN,ITEM,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;
    131  N FIEV,FINDING,IND,YS,DATA
     123 N FIEV,FINDING,IND,YS,YSDATA
    132124 S YS("CODE")=ITEM,YS("DFN")=DFN
    133125 S YS("BEGIN")=BDT,YS("END")=EDT
    134  ;PTTEST^YTQPXRM2 does not understand "*" for a limit so use 99.
     126 ;YTAPI10A does not understand "*" for a limit so use 99.
    135127 I NGET="*" S NGET=99
    136128 S YS("LIMIT")=$S(SDIR=-1:NGET,1:-NGET)
    137  ;DBIA #5035
    138  D PTTEST^YTQPXRM2(.DATA,.YS)
    139  S NFOUND=$P(DATA(1),U,2)
     129 ;DBIA #4458
     130 D PTTEST^YTAPI10A(.YSDATA,.YS)
     131 S NFOUND=$P(YSDATA(1),U,2)
    140132 I NFOUND=0 Q
    141  F IND=1:1:NFOUND S FLIST(IND)=DATA(IND+1)
     133 F IND=1:1:NFOUND S FLIST(IND)=YSDATA(IND+1)
    142134 Q
    143135 ;
     
    147139 N YS
    148140 ;YTAPI10A does not understand "*" for a limit so use 99.
    149  ;OCCUR^YTQPXRM1 does not understand "*" for a limit so use 99.
    150141 I NOCC="*" S NOCC=99
    151142 S YS("CODE")=ITEM,YS("BEGIN")=BDT,YS("END")=EDT,YS("LIMIT")=NOCC
    152  ;DBIA #5034
    153  D OCCUR^YTQPXRM1(PLIST,.YS)
     143 ;DBIA #4458
     144 D OCCUR^YTAPI10A(PLIST,.YS)
    154145 Q
    155146 ;
     
    157148VSCALE(X,FIND0) ;Make sure that the mental health scale is valid.
    158149 ;Either the scale number or the scale name can be used.
    159  N DATA,IND,MHIEN,MHTEST,SCALE,VALID
     150 N MHIEN,MHTEST,SCALE,VALID
    160151 S MHTEST=$P(FIND0,U,1)
    161152 S MHIEN=$P(MHTEST,";",1)
    162  D SCALES^YTQPXRM5(.DATA,MHIEN)
    163  I +X>0 S VALID=$S($D(DATA("S",X)):1,1:0)
     153 I +X>0 D  Q VALID
     154 . S VALID=$S($D(^YTT(601,MHIEN,"S",X)):1,1:0)
    164155 E  D
    165  . S IND=1,VALID=0
    166  . F  S IND=$O(DATA("S",IND)) Q:(VALID)!(IND="")  D
    167  .. I X=$P(DATA("S",IND),U,1) S VALID=1 Q
    168  I 'VALID D EN^DDIOL(X_" is not a valid scale for this test!")
    169  I $O(DATA(""),-1)>20 H 1
     156 . S SCALE=$O(^YTT(601,MHIEN,"S","C",X,""))
     157 . S VALID=$S(SCALE="":0,1:1)
    170158 Q VALID
    171  ;
    172  ;=======================================================
    173 VSCALED(X,DA) ;Make sure that the mental health scale is valid for a result
    174  ;group.
    175  I X="" Q 1
    176  ;Do not execute as part of a verify fields.
    177  I $G(DIUTIL)="VERIFY FIELDS" Q 1
    178  ;Do not execute as part of exchange.
    179  I $G(PXRMEXCH) Q 1
    180  N MHTEST
    181  S MHTEST=$P($G(^PXRMD(801.41,DA,50)),U)
    182  Q $$VSCALE(X,MHTEST)
    183159 ;
    184160 ;=======================================================
     
    205181 Q $$VSCALE(X,TFIND0)
    206182 ;
    207  ;=======================================================
    208 WARN ;Warn the user that they must select a scale if they intend to use
    209  ;a condition.
    210  W !,"Remember that the score is returned as raw score^transformed score,"
    211  W !,"so if your Condition uses the raw score use +V or $P(V,U,1) and if"
    212  W !,"it uses the transformed score use $P(V,U,2)."
    213  Q
    214  ;
Note: See TracChangeset for help on using the changeset viewer.