Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCF.m

    r613 r623  
    1 PXRMCF  ; SLC/PKR - Handle computed findings. ;07/25/2007
    2         ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
    3         ;
    4         ;=======================================================
    5 EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate computed findings.
    6         N FIEVT,FILENUM,FINDING,FINDPA,ITEM
    7         S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
    8         S ITEM=""
    9         F  S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:+ITEM=0  D
    10         . S FINDING=""
    11         . F  S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0  D
    12         .. K FINDPA
    13         .. M FINDPA=DEFARR(20,FINDING)
    14         .. K FIEVT
    15         .. D FIEVAL(FILENUM,DFN,ITEM,.FINDPA,.FIEVT)
    16         .. M FIEVAL(FINDING)=FIEVT
    17         .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
    18         Q
    19         ;
    20         ;=======================================================
    21 EVALPL(FINDPA,ENODE,TERMARR,PLIST)      ;Patient list evaluator.
    22         ;Return the list in ^TMP($J,PLIST)
    23         N ITEM,FILENUM,PFINDPA
    24         N TEMP,TFINDING,TFINDPA
    25         S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
    26         S ITEM=""
    27         F  S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0  D
    28         . S TFINDING=""
    29         . F  S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0  D
    30         .. K PFINDPA,TFINDPA
    31         .. M TFINDPA=TERMARR(20,TFINDING)
    32         ..;Set the finding parameters.
    33         .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
    34         .. D GPLIST(FILENUM,ITEM,.PFINDPA,PLIST)
    35         Q
    36         ;
    37         ;=======================================================
    38 EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL)      ;General term
    39         ;evaluator.
    40         N FIEVT,FILENUM,ITEM,PFINDPA
    41         N TEMP,TFINDING,TFINDPA
    42         S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
    43         S ITEM=""
    44         F  S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0  D
    45         . S TFINDING=""
    46         . F  S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0  D
    47         .. K FIEVT,PFINDPA,TFINDPA
    48         .. M TFINDPA=TERMARR(20,TFINDING)
    49         ..;Set the finding parameters.
    50         .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
    51         .. D FIEVAL(FILENUM,DFN,ITEM,.PFINDPA,.FIEVT)
    52         .. M TFIEVAL(TFINDING)=FIEVT
    53         .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
    54         Q
    55         ;
    56         ;=======================================================
    57 FIEVAL(FILENUM,DFN,ITEM,PFINDPA,FIEVAL) ;
    58         ;Evaluate regular patient findings.
    59         N BDT,CASESEN,COND,CONVAL,DAS,DATA,DATE,EDT,FLIST,ICOND,IND
    60         N NFOUND,NGET,NOCC,NP,PDATA,ROUTINE
    61         N SAVE,SDIR,STATUSA,TEMP,TEST,TEXT,TYPE,UCIFS,VALUE,VSLIST
    62         ;Set the finding search parameters.
    63         D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
    64         S SDIR=$S(NOCC<0:+1,1:-1)
    65         S TEST=PFINDPA(15)
    66         D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
    67         S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC)
    68         ;Make sure NGET has the same sign as NOCC.
    69         I NGET'=NOCC S NGET=NGET*($$ABS^XLFMTH(NOCC)/NOCC)
    70         S TEMP=^PXRMD(811.4,ITEM,0)
    71         S TYPE=$P(TEMP,U,5)
    72         I TYPE="" S TYPE="S"
    73         I TYPE="S" D
    74         . S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,.TEST,.DATE,.VALUE,.TEXT)"
    75         . D @ROUTINE
    76         .;Make sure that the date is in range.
    77         . I TEST,DATE'<BDT,DATE'>EDT S NFOUND=1
    78         . E  S NFOUND=0
    79         . I NFOUND D
    80         .. S TEST(1)=TEST,DATE(1)=DATE,TEXT(1)=$G(TEXT)
    81         .. S DATA(1,"VALUE")=$G(VALUE)
    82         .. I $D(VALUE)=11 S IND="" F  S IND=$O(VALUE(IND)) Q:IND=""  S DATA(1,IND)=VALUE(IND)
    83         I TYPE="M" D
    84         . S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)"
    85         . D @ROUTINE
    86         I TYPE'="S",TYPE'="M" D
    87         . S NFOUND=0
    88         . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","COMPUTED FINDING","WRONG TYPE")=TYPE_" IS NOT SUITABLE FOR REMINDER EVALUATION"
    89         I NFOUND=0 S FIEVAL=0 Q
    90         S NP=0
    91         F IND=1:1:NFOUND Q:NP=NOCC  D
    92         . I TEST(IND),COND'="" D
    93         .. K PDATA M PDATA=DATA(IND)
    94         .. S CONVAL=$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.PDATA)
    95         . E  S CONVAL=TEST(IND)
    96         . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
    97         . I SAVE D
    98         .. S NP=NP+1
    99         .. S FIEVAL(NP)=CONVAL
    100         .. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
    101         .. S FIEVAL(NP,"DATE")=DATE(IND)
    102         .. S FIEVAL(NP,"TEXT")=$G(TEXT(IND))
    103         .. M FIEVAL(NP)=DATA(IND)
    104         .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=DATA(IND)
    105         ;
    106         ;Save the finding result.
    107         D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
    108         S FIEVAL("FILE NUMBER")=FILENUM
    109         Q
    110         ;
    111         ;=======================================================
    112 GPLIST(FILENUM,CFIEN,PFINDPA,PLIST)     ;Add to the patient list
    113         ;for a regular file.
    114         N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DATA,DFN,FLIST
    115         N ICOND,IND,IPLIST
    116         N NOCC,NOCCABS,NFOUND,NGET,NP,PARAM,ROUTINE
    117         N SAVE,SOURCE,STATUSA,TEMP,TEXT,TGLIST,TPLIST,TYPE
    118         N UCIFS,VALUE,VSLIST
    119         S TEMP=^PXRMD(811.4,CFIEN,0)
    120         S TYPE=$P(TEMP,U,5)
    121         I TYPE'="L" Q
    122         S TGLIST="GPLIST_PXRMCF"
    123         S PARAM=PFINDPA(15)
    124         S SOURCE=FILENUM_";"_CFIEN
    125         ;Set the finding search parameters.
    126         D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
    127         S NOCCABS=$$ABS^XLFMTH(NOCC)
    128         D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
    129         S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCCABS)
    130         K ^TMP($J,TGLIST)
    131         S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(NGET,BDT,EDT,TGLIST,PARAM)"
    132         D @ROUTINE
    133         ;Routine should return:
    134         ;^TMP($J,TGLIST,DFN,N)=DAS_U_DATE_U_FILENUM_U_ITEM_U_VALUE
    135         ;Data values for condition are returned in
    136         ;^TMP($J,TGLIST,DFN,N,SUB)=DATA(SUB)
    137         S DFN=""
    138         F  S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN=""  D
    139         . K TPLIST
    140         . M TPLIST=^TMP($J,TGLIST,DFN)
    141         . S (IND,NFOUND)=0
    142         . K IPLIST
    143         . F  S IND=$O(TPLIST(IND)) Q:(IND="")!(NFOUND=NOCCABS)  D
    144         .. S TEMP=TPLIST(IND)
    145         .. K DATA M DATA=TPLIST(IND)
    146         .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.DATA),1:1)
    147         .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
    148         .. I SAVE D
    149         ... S NFOUND=NFOUND+1
    150         ... S IPLIST(CONVAL,DFN,NFOUND,SOURCE)=TEMP
    151         . M ^TMP($J,PLIST)=IPLIST
    152         K ^TMP($J,TGLIST)
    153         Q
    154         ;
    155         ;=======================================================
    156 MHVOUT(INDENT,IFIEVAL,NLINES,TEXT)      ;Produce the MHV output.
    157         N DATA,DATE,FIEN,IND,JND,NAME,NOUT,PNAME,TEMP,TEXTOUT,VALUE
    158         S FIEN=$P(IFIEVAL("FINDING"),";",1)
    159         S TEMP=^PXRMD(811.4,FIEN,0)
    160         S PNAME=$P(TEMP,U,4)
    161         I PNAME="" S PNAME=$P(TEMP,U,1)
    162         S NAME="Computed Finding: "_PNAME_" = "
    163         S IND=0
    164         F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
    165         . S VALUE=$G(IFIEVAL(IND,"VALUE"))
    166         . S DATE=IFIEVAL(IND,"DATE")
    167         . S TEMP=NAME_VALUE_" ("_$$EDATE^PXRMDATE(DATE)_")"
    168         . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
    169         . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
    170         S NLINES=NLINES+1,TEXT(NLINES)=""
    171         Q
    172         ;
    173         ;=======================================================
    174 OUTPUT(INDENT,IFIEVAL,NLINES,TEXT)      ;Produce the clinical
    175         ;maintenance output.
    176         N DATA,DATE,FIEN,IND,JND,NOUT,PNAME,TEMP,TEXTOUT,VALUE
    177         S FIEN=$P(IFIEVAL("FINDING"),";",1)
    178         S TEMP=^PXRMD(811.4,FIEN,0)
    179         S PNAME=$P(TEMP,U,4)
    180         I PNAME="" S PNAME=$P(TEMP,U,1)
    181         S NLINES=NLINES+1
    182         S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Computed Finding: "_PNAME
    183         S IND=0
    184         F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
    185         . S DATE=IFIEVAL(IND,"DATE")
    186         . S TEMP=$$EDATE^PXRMDATE(DATE)
    187         . S VALUE=$G(IFIEVAL(IND,"VALUE"))
    188         . I VALUE'="" S TEMP=TEMP_" value - "_VALUE
    189         .;If there is text append it.
    190         . I $G(IFIEVAL(IND,"TEXT"))'="" S TEMP=TEMP_"; "_IFIEVAL(IND,"TEXT")
    191         . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
    192         . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
    193         S NLINES=NLINES+1,TEXT(NLINES)=""
    194         Q
    195         ;
     1PXRMCF ; SLC/PKR - Handle computed findings. ;12/15/2004
     2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
     3 ;
     4 ;=======================================================
     5EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate computed findings.
     6 N FIEVT,FILENUM,FINDING,FINDPA,ITEM
     7 S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
     8 S ITEM=""
     9 F  S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:+ITEM=0  D
     10 . S FINDING=""
     11 . F  S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0  D
     12 .. K FINDPA
     13 .. M FINDPA=DEFARR(20,FINDING)
     14 .. K FIEVT
     15 .. D FIEVAL(FILENUM,DFN,ITEM,.FINDPA,.FIEVT)
     16 .. M FIEVAL(FINDING)=FIEVT
     17 .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
     18 Q
     19 ;
     20 ;=======================================================
     21EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Patient list evaluator.
     22 ;Return the list in ^TMP($J,PLIST)
     23 N ITEM,FILENUM,PFINDPA
     24 N TEMP,TFINDING,TFINDPA
     25 S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
     26 S ITEM=""
     27 F  S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0  D
     28 . S TFINDING=""
     29 . F  S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0  D
     30 .. K PFINDPA,TFINDPA
     31 .. M TFINDPA=TERMARR(20,TFINDING)
     32 ..;Set the finding parameters.
     33 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
     34 .. D GPLIST(FILENUM,ITEM,.PFINDPA,PLIST)
     35 Q
     36 ;
     37 ;=======================================================
     38EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;General term
     39 ;evaluator.
     40 N FIEVT,FILENUM,ITEM,PFINDPA
     41 N TEMP,TFINDING,TFINDPA
     42 S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
     43 S ITEM=""
     44 F  S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0  D
     45 . S TFINDING=""
     46 . F  S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0  D
     47 .. K FIEVT,PFINDPA,TFINDPA
     48 .. M TFINDPA=TERMARR(20,TFINDING)
     49 ..;Set the finding parameters.
     50 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
     51 .. D FIEVAL(FILENUM,DFN,ITEM,.PFINDPA,.FIEVT)
     52 .. M TFIEVAL(TFINDING)=FIEVT
     53 .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
     54 Q
     55 ;
     56 ;=======================================================
     57FIEVAL(FILENUM,DFN,ITEM,PFINDPA,FIEVAL) ;
     58 ;Evaluate regular patient findings.
     59 N BDT,CASESEN,COND,CONVAL,DAS,DATA,DATE,EDT,FLIST,ICOND,IND
     60 N NFOUND,NGET,NOCC,NP,PDATA,ROUTINE
     61 N SAVE,SDIR,STATUSA,TEMP,TEST,TEXT,TYPE,UCIFS,VALUE,VSLIST
     62 ;Set the finding search parameters.
     63 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
     64 S SDIR=$S(NOCC<0:+1,1:-1)
     65 S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
     66 S TEST=PFINDPA(15)
     67 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
     68 S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC)
     69 S TEMP=^PXRMD(811.4,ITEM,0)
     70 S TYPE=$P(TEMP,U,5)
     71 I TYPE="" S TYPE="S"
     72 I TYPE="S" D
     73 . S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,.TEST,.DATE,.VALUE,.TEXT)"
     74 . D @ROUTINE
     75 .;Make sure that the date is in range.
     76 . I TEST,DATE'<BDT,DATE'>EDT S NFOUND=1
     77 . E  S NFOUND=0
     78 . I NFOUND D
     79 .. S TEST(1)=TEST,DATE(1)=DATE,TEXT(1)=$G(TEXT)
     80 .. S DATA(1,"VALUE")=$G(VALUE)
     81 .. I $D(VALUE)=11 S IND="" F  S IND=$O(VALUE(IND)) Q:IND=""  S DATA(1,IND)=VALUE(IND)
     82 I TYPE="M" D
     83 . S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)"
     84 . D @ROUTINE
     85 I TYPE'="S",TYPE'="M" D
     86 . S NFOUND=0
     87 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","COMPUTED FINDING","WRONG TYPE")=TYPE_" IS NOT SUITABLE FOR REMINDER EVALUATION"
     88 I NFOUND=0 S FIEVAL=0 Q
     89 S NP=0
     90 F IND=1:1:NFOUND Q:NP=NOCC  D
     91 . I TEST(IND),COND'="" D
     92 .. K PDATA M PDATA=DATA(IND)
     93 .. S CONVAL=$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.PDATA)
     94 . E  S CONVAL=TEST(IND)
     95 . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
     96 . I SAVE D
     97 .. S NP=NP+1
     98 .. S FIEVAL(NP)=CONVAL
     99 .. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
     100 .. S FIEVAL(NP,"DATE")=DATE(IND)
     101 .. S FIEVAL(NP,"TEXT")=$G(TEXT(IND))
     102 .. M FIEVAL(NP)=DATA(IND)
     103 .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=DATA(IND)
     104 ;
     105 ;Save the finding result.
     106 D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
     107 S FIEVAL("FILE NUMBER")=FILENUM
     108 Q
     109 ;
     110 ;=======================================================
     111GPLIST(FILENUM,CFIEN,PFINDPA,PLIST) ;Add to the patient list
     112 ;for a regular file.
     113 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DATA,DFN,FLIST
     114 N ICOND,IND,IPLIST
     115 N NOCC,NOCCABS,NFOUND,NGET,NP,PARAM,ROUTINE
     116 N SAVE,SOURCE,STATUSA,TEMP,TEXT,TGLIST,TPLIST,TYPE
     117 N UCIFS,VALUE,VSLIST
     118 S TEMP=^PXRMD(811.4,CFIEN,0)
     119 S TYPE=$P(TEMP,U,5)
     120 I TYPE'="L" Q
     121 S TGLIST="GPLIST_PXRMCF"
     122 S PARAM=PFINDPA(15)
     123 S SOURCE=FILENUM_";"_CFIEN
     124 ;Set the finding search parameters.
     125 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
     126 S NOCCABS=$$ABS^XLFMTH(NOCC)
     127 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
     128 S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCCABS)
     129 K ^TMP($J,TGLIST)
     130 S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(NGET,BDT,EDT,TGLIST,PARAM)"
     131 D @ROUTINE
     132 ;Routine should return:
     133 ;^TMP($J,TGLIST,DFN,N)=DAS_U_DATE_U_FILENUM_U_ITEM_U_VALUE
     134 ;Data values for condition are returned in
     135 ;^TMP($J,TGLIST,DFN,N,SUB)=DATA(SUB)
     136 S DFN=""
     137 F  S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN=""  D
     138 . K TPLIST
     139 . M TPLIST=^TMP($J,TGLIST,DFN)
     140 . S (IND,NFOUND)=0
     141 . K IPLIST
     142 . F  S IND=$O(TPLIST(IND)) Q:(IND="")!(NFOUND=NOCCABS)  D
     143 .. S TEMP=TPLIST(IND)
     144 .. K DATA M DATA=TPLIST(IND)
     145 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.DATA),1:1)
     146 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
     147 .. I SAVE D
     148 ... S NFOUND=NFOUND+1
     149 ... S IPLIST(CONVAL,DFN,NFOUND,SOURCE)=TEMP
     150 . M ^TMP($J,PLIST)=IPLIST
     151 K ^TMP($J,TGLIST)
     152 Q
     153 ;
     154 ;=======================================================
     155MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
     156 N DATA,DATE,FIEN,IND,JND,NAME,NOUT,PNAME,TEMP,TEXTOUT,VALUE
     157 S FIEN=$P(IFIEVAL("FINDING"),";",1)
     158 S TEMP=^PXRMD(811.4,FIEN,0)
     159 S PNAME=$P(TEMP,U,4)
     160 I PNAME="" S PNAME=$P(TEMP,U,1)
     161 S NAME="Computed Finding: "_PNAME_" = "
     162 S IND=0
     163 F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
     164 . S VALUE=$G(IFIEVAL(IND,"VALUE"))
     165 . S DATE=IFIEVAL(IND,"DATE")
     166 . S TEMP=NAME_VALUE_" ("_$$EDATE^PXRMDATE(DATE)_")"
     167 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
     168 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
     169 S NLINES=NLINES+1,TEXT(NLINES)=""
     170 Q
     171 ;
     172 ;=======================================================
     173OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
     174 ;maintenance output.
     175 N DATA,DATE,FIEN,IND,JND,NOUT,PNAME,TEMP,TEXTOUT,VALUE
     176 S FIEN=$P(IFIEVAL("FINDING"),";",1)
     177 S TEMP=^PXRMD(811.4,FIEN,0)
     178 S PNAME=$P(TEMP,U,4)
     179 I PNAME="" S PNAME=$P(TEMP,U,1)
     180 S NLINES=NLINES+1
     181 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Computed Finding: "_PNAME
     182 S IND=0
     183 F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
     184 . S DATE=IFIEVAL(IND,"DATE")
     185 . S TEMP=$$EDATE^PXRMDATE(DATE)
     186 . S VALUE=$G(IFIEVAL(IND,"VALUE"))
     187 . I VALUE'="" S TEMP=TEMP_" value - "_VALUE
     188 .;If there is text append it.
     189 . I $G(IFIEVAL(IND,"TEXT"))'="" S TEMP=TEMP_"; "_IFIEVAL(IND,"TEXT")
     190 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
     191 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
     192 S NLINES=NLINES+1,TEXT(NLINES)=""
     193 Q
     194 ;
Note: See TracChangeset for help on using the changeset viewer.