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/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI4.m

    r613 r623  
    1 ORWGAPI4        ; SLC/STAFF - Graph Data, indexed ;8/21/06  07:52
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
    3         ;
    4 EDU(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
    5         N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
    6         S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    7         F  S DATE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
    8         . I DATE>START Q
    9         . I DATE<BACKTO Q
    10         . S NODE=""
    11         . F  S NODE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
    12         .. D EDU^ORWGAPIA(NODE,.VALUE,.VALUES)
    13         .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)_U_VALUES ;*****************************
    14         .. S RESULT=9000010.16_U_ITEM_U_DATE_"^^" ;_VALUE
    15         .. S RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
    16         .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    17         Q
    18         ;
    19 EXAM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)        ; from ORWGAPIR
    20         N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
    21         S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    22         F  S DATE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
    23         . I DATE>START Q
    24         . I DATE<BACKTO Q
    25         . S NODE=""
    26         . F  S NODE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
    27         .. D EXAM^ORWGAPIA(NODE,.VALUE,.VALUES)
    28         .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)_U_VALUES ;*****************************
    29         .. S RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
    30         .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    31         Q
    32         ;
    33 HF(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)  ; from ORWGAPIR
    34         N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
    35         S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    36         F  S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
    37         . I DATE>START Q
    38         . I DATE<BACKTO Q
    39         . S NODE=""
    40         . F  S NODE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
    41         .. D HF^ORWGAPIA(NODE,.VALUE,.VALUES)
    42         .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)_U_VALUES ;*****************************
    43         .. S RESULT=9000010.23_U_ITEM_U_DATE_U_DATE2_U_VALUE
    44         .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    45         Q
    46         ;
    47 IMM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
    48         N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
    49         S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    50         F  S DATE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
    51         . I DATE>START Q
    52         . I DATE<BACKTO Q
    53         . S NODE=""
    54         . F  S NODE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
    55         .. D IMM^ORWGAPIA(NODE,.VALUE,.VALUES)
    56         .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)_U_VALUES ;*****************************
    57         .. S CNT=CNT+1
    58         .. S RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
    59         .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    60         Q
    61         ;
    62 MH(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)  ; from ORWGAPIR
    63         N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
    64         S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    65         F  S DATE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
    66         . I DATE>START Q
    67         . I DATE<BACKTO Q
    68         . S NODE=""
    69         . F  S NODE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
    70         .. D MH^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(2)),U,2,3)_U_VALUES ;*****************************
    71         .. S RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
    72         .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    73         Q
    74         ;
    75 OP(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)  ; from ORWGAPIR
    76         N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
    77         S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO),VALUES=""
    78         S NUM=""
    79         F  S NUM=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM)) Q:NUM=""  D
    80         . S DATE=""
    81         . F  S DATE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE)) Q:DATE=""  D
    82         .. I DATE>START Q
    83         .. I DATE<BACKTO Q
    84         .. S NODE=""
    85         .. F  S NODE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE=""  D
    86         ... I '$L($G(^DGPT(+NODE,0))) Q  ; ****** remove this when PTF patch is released **********
    87         ... D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("DISCHARGE STATUS"))_U_VALUES ;*****************************
    88         ... S RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
    89         ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    90         Q
    91         ;
    92 POV(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
    93         N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
    94         S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    95         S TYPE=""
    96         F  S TYPE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE)) Q:TYPE=""  D
    97         . S DATE=""
    98         . F  S DATE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE=""  D
    99         .. I DATE>START Q
    100         .. I DATE<BACKTO Q
    101         .. S NODE=""
    102         .. F  S NODE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE=""  D
    103         ... D POV^ORWGAPIA(NODE,.VALUE,.VALUES)
    104         ... S VALUE=VALUE("CLINICAL TERM"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)_U_VALUES ;*****************************
    105         ... S CNT=CNT+1
    106         ... S RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
    107         ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    108         Q
    109         ;
    110 PROB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)        ; from ORWGAPIR
    111         N DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
    112         K ^TMP("ORWGRPC TEMP",$J)
    113         S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    114         S STATUS=""
    115         F  S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS=""  D
    116         . S PRIORITY=""
    117         . F  S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY=""  D
    118         .. S DATE=""
    119         .. F  S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE=""  D
    120         ... I DATE>START Q
    121         ... I DATE<BACKTO Q
    122         ... S NODE=""
    123         ... F  S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE=""  D
    124         .... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE,NODE)=""
    125         S ICD9=""
    126         F  S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9=""  D
    127         . S DATE=""
    128         . F  S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE)) Q:DATE=""  D
    129         .. S NODE=""
    130         .. F  S NODE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE,NODE)) Q:NODE=""  D
    131         ... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
    132         ... S RESULT=9000011_U_ITEM_U_DTONSET_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
    133         ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    134         K ^TMP("ORWGRPC TEMP",$J)
    135         Q
    136         ;
    137 PROBX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)       ; from ORWGAPIR
    138         D PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
    139         Q
    140         ;
    141 PROC(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)        ; from ORWGAPIR
    142         N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
    143         S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    144         S TYPE=""
    145         F  S TYPE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE)) Q:TYPE=""  D
    146         . S DATE=""
    147         . F  S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE=""  D
    148         .. I DATE>START Q
    149         .. I DATE<BACKTO Q
    150         .. S NODE=""
    151         .. F  S NODE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE=""  D
    152         ... D CPT^ORWGAPIA(NODE,.VALUE,.VALUES)
    153         ... S VALUE=VALUE("PRINCIPAL PROCEDURE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)_U_VALUES ;*****************************
    154         ... S RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
    155         ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    156         Q
    157         ;
    158 SKIN(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)        ; from ORWGAPIR
    159         N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
    160         S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    161         F  S DATE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
    162         . I DATE>START Q
    163         . I DATE<BACKTO Q
    164         . S NODE=""
    165         . F  S NODE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
    166         .. D SKIN^ORWGAPIA(NODE,.VALUE,.VALUES)
    167         .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)_U_VALUES ;*****************************
    168         .. S CNT=CNT+1
    169         .. S RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
    170         .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    171         Q
    172         ;
    173 VITAL(DATA,ITEM,START,DFN,CNT,TMP,BACKTO)       ; from ORWGAPIR
    174         I ITEM=99999 D BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
    175         N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
    176         S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
    177         F  S DATE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
    178         . I DATE>START Q
    179         . I DATE<BACKTO Q
    180         . S NODE=""
    181         . F  S NODE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
    182         .. D VITAL^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(7)),U)
    183         .. I $P($G(VALUE(3)),U,2)="PAIN",VALUE=99 S VALUE="(99)"
    184         .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES ;*****************************
    185         .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
    186         Q
    187         ;
     1ORWGAPI4 ; SLC/STAFF - Graph Data ;8/21/06  07:52
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260**;Dec 17, 1997;Build 26
     3 ;
     4ADMIT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     5 N DATE,DATE2,DISCH,LINE,LST,NUM,RESULT,VALUE K LST
     6 S ITEM=$G(ITEM,"ADMIT")
     7 D ADMITLST^ORWPT(.LST,DFN)
     8 S NUM=0
     9 F  S NUM=$O(LST(NUM)) Q:NUM<1  D
     10 . S LINE=LST(NUM)
     11 . S DATE=$P(LINE,U)
     12 . I DATE>START Q
     13 . S DISCH=$P(LINE,U,5)
     14 . S DATE2=$$DISCH^ORWGAPIA(DISCH)
     15 . I DATE2="" D
     16 .. S DATE2=$$FMADD^ORWGAPIX(DATE,$$LOS^ORWGAPIA(DISCH)+1)
     17 .. I DATE2=-1 S DATE2=$$FMADD^ORWGAPIX(DT,1) ; just make it today + 1
     18 .. S DATE2=DATE2\1
     19 . S VALUE=$P(LINE,U,3)_"  "_$P(LINE,U,4)_U_$P(LINE,U,5,6)
     20 . S CNT=CNT+1
     21 . S RESULT=405_U_ITEM_U_DATE_U_DATE2_U_VALUE
     22 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     23 Q
     24 ;
     25EDU(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     26 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
     27 S DATE="",DATE2="",CNT=$G(CNT)
     28 F  S DATE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
     29 . I DATE>START Q
     30 . S NODE=""
     31 . F  S NODE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
     32 .. D EDU^ORWGAPIA(NODE,.VALUE)
     33 .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)
     34 .. S RESULT=9000010.16_U_ITEM_U_DATE_"^^" ;_VALUE
     35 .. S RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
     36 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     37 Q
     38 ;
     39EXAM(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     40 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
     41 S DATE="",DATE2="",CNT=$G(CNT)
     42 F  S DATE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
     43 . I DATE>START Q
     44 . S NODE=""
     45 . F  S NODE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
     46 .. D EXAM^ORWGAPIA(NODE,.VALUE)
     47 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)
     48 .. S RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
     49 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     50 Q
     51 ;
     52HF(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     53 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
     54 S DATE="",DATE2="",CNT=$G(CNT)
     55 F  S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
     56 . I DATE>START Q
     57 . S NODE=""
     58 . F  S NODE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
     59 .. D HF^ORWGAPIA(NODE,.VALUE)
     60 .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)
     61 .. S RESULT=9000010.23_U_ITEM_U_DATE_U_DATE2_U_VALUE
     62 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     63 Q
     64 ;
     65IMM(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     66 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
     67 S DATE="",DATE2="",CNT=$G(CNT)
     68 F  S DATE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
     69 . I DATE>START Q
     70 . S NODE=""
     71 . F  S NODE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
     72 .. D IMM^ORWGAPIA(NODE,.VALUE)
     73 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)
     74 .. S CNT=CNT+1
     75 .. S RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
     76 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     77 Q
     78 ;
     79MH(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     80 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
     81 S DATE="",DATE2="",CNT=$G(CNT)
     82 F  S DATE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
     83 . I DATE>START Q
     84 . S NODE=""
     85 . F  S NODE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
     86 .. D MH^ORWGAPIA(.VALUE,NODE) S VALUE=$P($G(VALUE(2)),U,2,3)
     87 .. S RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
     88 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     89 Q
     90 ;
     91OP(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     92 N DATE,DATE2,NODE,NUM,RESULT,VALUE K VALUE
     93 S DATE2="",CNT=$G(CNT)
     94 S NUM=""
     95 F  S NUM=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM)) Q:NUM=""  D
     96 . S DATE=""
     97 . F  S DATE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE)) Q:DATE=""  D
     98 .. I DATE>START Q
     99 .. S NODE=""
     100 .. F  S NODE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE=""  D
     101 ... D PTF^ORWGAPIA(NODE,.VALUE) S VALUE=$G(VALUE("DISCHARGE STATUS"))
     102 ... S RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
     103 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     104 Q
     105 ;
     106POV(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     107 N DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
     108 S DATE2="",CNT=$G(CNT)
     109 S TYPE=""
     110 F  S TYPE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE)) Q:TYPE=""  D
     111 . S DATE=""
     112 . F  S DATE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE=""  D
     113 .. I DATE>START Q
     114 .. S NODE=""
     115 .. F  S NODE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE=""  D
     116 ... D POV^ORWGAPIA(NODE,.VALUE)
     117 ... S VALUE=VALUE("CLINICAL TERM"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)
     118 ... S CNT=CNT+1
     119 ... S RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
     120 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     121 Q
     122 ;
     123PROB(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     124 N DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
     125 K ^TMP("ORWGRPC TEMP",$J)
     126 S DATE2="",CNT=$G(CNT)
     127 S STATUS=""
     128 F  S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS=""  D
     129 . S PRIORITY=""
     130 . F  S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY=""  D
     131 .. S DATE=""
     132 .. F  S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE=""  D
     133 ... I DATE>START Q
     134 ... S NODE=""
     135 ... F  S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE=""  D
     136 .... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE,NODE)=""
     137 S ICD9=""
     138 F  S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9=""  D
     139 . S DATE=""
     140 . F  S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE)) Q:DATE=""  D
     141 .. S NODE=""
     142 .. F  S NODE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE,NODE)) Q:NODE=""  D
     143 ... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
     144 ... S RESULT=9000011_U_ITEM_U_DTONSET_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
     145 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     146 K ^TMP("ORWGRPC TEMP",$J)
     147 Q
     148 ;
     149PROBX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     150 D PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
     151 Q
     152 ;
     153PROC(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     154 N DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
     155 S DATE2="",CNT=$G(CNT)
     156 S TYPE=""
     157 F  S TYPE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE)) Q:TYPE=""  D
     158 . S DATE=""
     159 . F  S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE=""  D
     160 .. I DATE>START Q
     161 .. S NODE=""
     162 .. F  S NODE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE=""  D
     163 ... D CPT^ORWGAPIA(NODE,.VALUE)
     164 ... S VALUE=VALUE("PRINCIPAL PROCEDURE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)
     165 ... S RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
     166 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     167 Q
     168 ;
     169SKIN(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     170 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
     171 S DATE="",DATE2="",CNT=$G(CNT)
     172 F  S DATE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
     173 . I DATE>START Q
     174 . S NODE=""
     175 . F  S NODE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
     176 .. D SKIN^ORWGAPIA(NODE,.VALUE)
     177 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)
     178 .. S CNT=CNT+1
     179 .. S RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
     180 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     181 Q
     182 ;
     183SURG(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     184 N CASE,DATE,DATE2,NUM,PROC,RESULT,RESULTS,SURG,SURGPROC,VALUE K SURG,SURGPROC
     185 S DATE2="",CNT=$G(CNT)
     186 D SURG^ORWGAPIA(.SURG,DFN)
     187 K SURG(0),SURG(1)
     188 S ITEM=$$UP^ORWGAPIX(ITEM)
     189 S NUM=0
     190 S CASE=0
     191 F  S CASE=$O(SURG(CASE)) Q:CASE<1  D
     192 . S RESULTS=SURG(CASE)
     193 . S PROC=$P(RESULTS,U,3)
     194 . I '$L(PROC) Q
     195 . S PROC=$$UP^ORWGAPIX(PROC)
     196 . I PROC'=ITEM Q
     197 . S NUM=NUM+1
     198 . S SURGPROC(PROC,NUM)=RESULTS
     199 K SURG
     200 S PROC=""
     201 F  S PROC=$O(SURGPROC(PROC)) Q:PROC=""  D
     202 . S NUM=0
     203 . F  S NUM=$O(SURGPROC(PROC,NUM)) Q:NUM<1  D
     204 .. S RESULTS=SURGPROC(PROC,NUM)
     205 .. S DATE=$P(RESULTS,U,5)
     206 .. I DATE>START Q
     207 .. S VALUE=""
     208 .. S RESULT=130_U_PROC_U_DATE_U_DATE2_U_VALUE
     209 .. S CNT=CNT+1
     210 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     211 Q
     212 ;
     213TREAT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     214 N DATE,DATE2,NODE,RESULT,VALUE
     215 S DATE="",DATE2="",CNT=$G(CNT)
     216 S NODE=""
     217 F  S NODE=$O(^AUPNVTRT("C",DFN,NODE)) Q:NODE=""  D
     218 . I '$D(^AUPNVTRT("B",ITEM,NODE)) Q
     219 . S DATE=+$G(^AUPNVSIT(+$P($G(^AUPNVTRT(NODE,0)),U,3),0)) I 'DATE Q
     220 . I DATE>START Q
     221 . S VALUE=+$P($G(^AUPNVTRT(NODE,0)),U,4)
     222 . S CNT=CNT+1
     223 . S RESULT=9000010.15_U_ITEM_U_DATE_U_DATE2_U_VALUE
     224 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     225 Q
     226 ;
     227VISIT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     228 N DATE,DATE2,NODE,NUM,RESULT,VALUE
     229 S DATE="",DATE2="",CNT=$G(CNT)
     230 F  S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE=""  D
     231 . I DATE>START Q
     232 . S NODE=""
     233 . F  S NODE=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE)) Q:NODE=""  D
     234 .. S NUM=0
     235 .. F  S NUM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM)) Q:NUM=""  D
     236 ... S DATE2=+$P($G(^AUPNVSIT(NUM,0)),U,18)
     237 ... I 'DATE2 S DATE2=DATE+.01
     238 ... I +$E($P(DATE2,".",2),1,2)>24 S DATE2=(DATE\1)+.2359
     239 ... S VALUE=""
     240 ... S CNT=CNT+1
     241 ... S RESULT=9000010_U_ITEM_U_DATE_U_DATE2_U_VALUE
     242 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     243 Q
     244 ;
     245VITAL(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
     246 I ITEM=99999 D BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
     247 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
     248 S DATE="",DATE2="",CNT=$G(CNT)
     249 F  S DATE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
     250 . I DATE>START Q
     251 . S NODE=""
     252 . F  S NODE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
     253 .. D VITAL^ORWGAPIA(.VALUE,NODE) S VALUE=$P($G(VALUE(7)),U)
     254 .. I $P($G(VALUE(3)),U,2)="PAIN",VALUE=99 S VALUE="(99)"
     255 .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE
     256 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
     257 Q
     258 ;
Note: See TracChangeset for help on using the changeset viewer.