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/ORWGAPI2.m

    r613 r623  
    1 ORWGAPI2        ; SLC/STAFF - Graph API Items ;12/21/05  08:16
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
    3         ;
    4 ADVERSE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP)    ; from ORWGAPIR
    5         N DATE,IEN,ITEM,RESULT
    6         K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
    7         S IEN=0
    8         F  S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:IEN<1  D
    9         . I '$D(^GMR(120.8,IEN,0)) Q
    10         . I $G(^GMR(120.8,IEN,"ER")) Q
    11         . I '$P(^GMR(120.8,IEN,0),U,12) Q
    12         . S DATE=+$P($G(^GMR(120.8,IEN,0)),U,4) I 'DATE Q
    13         . S ITEM=$P(^GMR(120.8,IEN,0),U,2) I '$L(ITEM) Q
    14         . S ^TMP("ORWGRPC SORT",$J,DATE,ITEM)="" ;ADVERSE
    15         I FMT=6 D
    16         . S DATE=OLDEST
    17         . F  S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1  Q:DATE>NEWEST  D
    18         .. S ITEM=""
    19         .. F  S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM=""  D
    20         ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
    21         ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
    22         ... S CNT=CNT+1
    23         ... S RESULT="120.8^"_ITEM
    24         ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
    25         I FMT'=6 D
    26         . S DATE=0
    27         . F  S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1  D
    28         .. S ITEM=""
    29         .. F  S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM=""  D
    30         ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
    31         ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
    32         ... S CNT=CNT+1
    33         ... I FMT=3 S RESULT="120.8^"_ITEM_"^^"_ITEM_"^^"_DATE
    34         ... I FMT=0 S RESULT="120.8^"_ITEM_U_ITEM
    35         ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
    36         K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
    37         Q
    38         ;
    39 PL(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
    40         N DATE,ICD9,OK,PRIORITY,RESULT,STATUS
    41         K ^TMP("ORWGRPC TEMP",$J)
    42         S STATUS=""
    43         F  S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS=""  D
    44         . S PRIORITY=""
    45         . F  S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY=""  D
    46         .. S ICD9=""
    47         .. F  S ICD9=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9)) Q:ICD9=""  D
    48         ... S OK=0
    49         ... I FMT=6 D
    50         .... S DATE=OLDEST
    51         .... F  S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,DATE)) Q:DATE=""  Q:DATE>NEWEST  D  Q:OK
    52         ..... S CNT=CNT+1
    53         ..... S OK=1
    54         ..... S RESULT=9000011_U_ICD9
    55         ... I FMT=3 D
    56         .... S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,""),-1)
    57         .... I DATE S ^TMP("ORWGRPC TEMP",$J,ICD9,DATE)=""
    58         ... I FMT=0 D
    59         .... S CNT=CNT+1
    60         .... S OK=1
    61         .... S RESULT=9000011_U_ICD9_U_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)
    62         ... I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
    63         I FMT=3 D
    64         . S ICD9=""
    65         . F  S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9=""  D
    66         .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,""),-1)
    67         .. I 'DATE Q
    68         .. S CNT=CNT+1
    69         .. S RESULT=9000011_U_ICD9_"^^"_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)_"^^"_DATE
    70         .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
    71         K ^TMP("ORWGRPC TEMP",$J)
    72         Q
    73         ;
    74 PLX(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP)        ; from ORWGAPIR
    75         D PLX2^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
    76         Q
    77         ;
    78 REG(ITEMS,DFN,FILE,FMT,OLDEST,NEWEST,CNT,TMP)   ; from ORWGAPIR
    79         N DATE,ICD,ITEM,NUM,OK,RESULT
    80         K ^TMP("ORWGRPC TEMP",$J)
    81         I $E(FILE,3,4)="DX" S ICD="ICD9"
    82         I $E(FILE,3,4)="OP" S ICD="ICD0"
    83         S NUM=""
    84         F  S NUM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM)) Q:NUM=""  D
    85         . S ITEM=""
    86         . F  S ITEM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM)) Q:ITEM=""  D
    87         .. S OK=0
    88         .. I FMT=6 D
    89         ... S DATE=OLDEST
    90         ... F  S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,DATE)) Q:DATE=""  Q:DATE>NEWEST  D  Q:OK
    91         .... S CNT=CNT+1
    92         .... S OK=1
    93         .... S RESULT=FILE_U_ITEM
    94         .. I FMT=3 D
    95         ... S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,""),-1)
    96         ... I DATE S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=""
    97         .. I FMT=0 D
    98         ... S CNT=CNT+1
    99         ... S OK=1
    100         ... S RESULT=FILE_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)
    101         .. I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
    102         I FMT=3 D
    103         . S ITEM=""
    104         . F  S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM=""  D
    105         .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,""),-1)
    106         .. I 'DATE Q
    107         .. S CNT=CNT+1
    108         .. S RESULT=FILE_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)_"^^"_DATE
    109         .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
    110         K ^TMP("ORWGRPC TEMP",$J)
    111         Q
    112         ;
     1ORWGAPI2 ; SLC/STAFF - Graph API Items ;12/21/05  08:16
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
     3 ;
     4ADMITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
     5 N DATE,DATE2,DISCH,LINE,LST,NUM,OK,RESULT K LST
     6 K ^TMP("ORWGRPC TEMP",$J)
     7 D ADMITLST^ORWPT(.LST,DFN)
     8 S OK=0
     9 S NUM=0
     10 F  S NUM=$O(LST(NUM)) Q:NUM<1  D  Q:OK
     11 . S LINE=LST(NUM)
     12 . S DATE=$P(LINE,U)
     13 . S DISCH=$P(LINE,U,5)
     14 . S DATE2=$$DISCH^ORWGAPIA(DISCH)
     15 . I DATE2="" S DATE2=DATE2\1
     16 . I FMT=6 D  Q
     17 .. I DATE>NEWEST Q
     18 .. I DATE2>0,DATE2<OLDEST Q
     19 .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
     20 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
     21 .. S CNT=CNT+1
     22 .. S OK=1
     23 .. S RESULT="405^ADMIT"
     24 . I FMT=3 D  Q
     25 .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
     26 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
     27 .. S CNT=CNT+1
     28 .. S OK=1
     29 .. S RESULT="405^ADMIT^^ADMIT^^"_DATE
     30 . I FMT=0 D  Q
     31 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
     32 .. S CNT=CNT+1
     33 .. S OK=1
     34 .. S RESULT="405^ADMIT^ADMIT"
     35 I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     36 K ^TMP("ORWGRPC TEMP",$J)
     37 Q
     38 ;
     39ADVERSE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
     40 N DATE,IEN,ITEM,RESULT
     41 K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
     42 S IEN=0
     43 F  S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:IEN<1  D
     44 . I '$D(^GMR(120.8,IEN,0)) Q
     45 . I $G(^GMR(120.8,IEN,"ER")) Q
     46 . I '$P(^GMR(120.8,IEN,0),U,12) Q
     47 . S DATE=+$P($G(^GMR(120.8,IEN,0)),U,4) I 'DATE Q
     48 . S ITEM=$P(^GMR(120.8,IEN,0),U,2) I '$L(ITEM) Q
     49 . S ^TMP("ORWGRPC SORT",$J,DATE,ITEM)="" ;ADVERSE
     50 I FMT=6 D
     51 . S DATE=OLDEST
     52 . F  S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1  Q:DATE>NEWEST  D
     53 .. S ITEM=""
     54 .. F  S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM=""  D
     55 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
     56 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
     57 ... S CNT=CNT+1
     58 ... S RESULT="120.8^"_ITEM
     59 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     60 I FMT'=6 D
     61 . S DATE=0
     62 . F  S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1  D
     63 .. S ITEM=""
     64 .. F  S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM=""  D
     65 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
     66 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
     67 ... S CNT=CNT+1
     68 ... I FMT=3 S RESULT="120.8^"_ITEM_"^^"_ITEM_"^^"_DATE
     69 ... I FMT=0 S RESULT="120.8^"_ITEM_U_ITEM
     70 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     71 K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
     72 Q
     73 ;
     74PL(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
     75 N DATE,ICD9,OK,PRIORITY,RESULT,STATUS
     76 K ^TMP("ORWGRPC TEMP",$J)
     77 S STATUS=""
     78 F  S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS=""  D
     79 . S PRIORITY=""
     80 . F  S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY=""  D
     81 .. S ICD9=""
     82 .. F  S ICD9=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9)) Q:ICD9=""  D
     83 ... S OK=0
     84 ... I FMT=6 D
     85 .... S DATE=OLDEST
     86 .... F  S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,DATE)) Q:DATE=""  Q:DATE>NEWEST  D  Q:OK
     87 ..... S CNT=CNT+1
     88 ..... S OK=1
     89 ..... S RESULT=9000011_U_ICD9
     90 ... I FMT=3 D
     91 .... S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,""),-1)
     92 .... I DATE S ^TMP("ORWGRPC TEMP",$J,ICD9,DATE)=""
     93 ... I FMT=0 D
     94 .... S CNT=CNT+1
     95 .... S OK=1
     96 .... S RESULT=9000011_U_ICD9_U_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)
     97 ... I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     98 I FMT=3 D
     99 . S ICD9=""
     100 . F  S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9=""  D
     101 .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,""),-1)
     102 .. I 'DATE Q
     103 .. S CNT=CNT+1
     104 .. S RESULT=9000011_U_ICD9_"^^"_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)_"^^"_DATE
     105 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     106 K ^TMP("ORWGRPC TEMP",$J)
     107 Q
     108 ;
     109PLX(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
     110 D PLX2^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
     111 Q
     112 ;
     113REG(ITEMS,DFN,FILE,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
     114 N DATE,ICD,ITEM,NUM,OK,RESULT
     115 K ^TMP("ORWGRPC TEMP",$J)
     116 I $E(FILE,3,4)="DX" S ICD="ICD9"
     117 I $E(FILE,3,4)="OP" S ICD="ICD0"
     118 S NUM=""
     119 F  S NUM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM)) Q:NUM=""  D
     120 . S ITEM=""
     121 . F  S ITEM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM)) Q:ITEM=""  D
     122 .. S OK=0
     123 .. I FMT=6 D
     124 ... S DATE=OLDEST
     125 ... F  S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,DATE)) Q:DATE=""  Q:DATE>NEWEST  D  Q:OK
     126 .... S CNT=CNT+1
     127 .... S OK=1
     128 .... S RESULT=FILE_U_ITEM
     129 .. I FMT=3 D
     130 ... S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,""),-1)
     131 ... I DATE S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=""
     132 .. I FMT=0 D
     133 ... S CNT=CNT+1
     134 ... S OK=1
     135 ... S RESULT=FILE_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)
     136 .. I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     137 I FMT=3 D
     138 . S ITEM=""
     139 . F  S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM=""  D
     140 .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,""),-1)
     141 .. I 'DATE Q
     142 .. S CNT=CNT+1
     143 .. S RESULT=FILE_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)_"^^"_DATE
     144 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     145 K ^TMP("ORWGRPC TEMP",$J)
     146 Q
     147 ;
     148SURGERY(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
     149 N CASE,DATE,PROC,RESULT,RESULTS,SURG,SURGPROC K SURG,SURGPROC
     150 D SURG^ORWGAPIA(.SURG,DFN)
     151 K SURG(0),SURG(1)
     152 I FMT=6 D
     153 . S CASE=0
     154 . F  S CASE=$O(SURG(CASE)) Q:CASE<1  D
     155 .. S RESULTS=SURG(CASE)
     156 .. S PROC=$P(RESULTS,U,3)
     157 .. I '$L(PROC) Q
     158 .. S DATE=$P(RESULTS,U,5)
     159 .. I DATE>NEWEST Q
     160 .. I DATE<OLDEST Q
     161 .. I $D(SURGPROC(PROC)) Q
     162 .. S SURGPROC(PROC)=""
     163 .. S CNT=CNT+1
     164 .. S RESULT=130_U_PROC
     165 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     166 I FMT'=6 D
     167 . S CASE=0
     168 . F  S CASE=$O(SURG(CASE)) Q:CASE<1  D
     169 .. S RESULTS=SURG(CASE)
     170 .. S PROC=$P(RESULTS,U,3)
     171 .. I '$L(PROC) Q
     172 .. S SURGPROC(PROC)=RESULTS
     173 . K SURG S PROC=""
     174 . F  S PROC=$O(SURGPROC(PROC)) Q:PROC=""  D
     175 .. S CNT=CNT+1
     176 .. I FMT=3 S RESULT=130_U_PROC_"^^"_PROC_"^^"_$P(SURGPROC(PROC),U,5)
     177 .. I FMT=0 S RESULT=130_U_PROC_U_PROC
     178 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     179 Q
     180 ;
     181TREAT(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR ***** change to inverse dates
     182 N DATE,IEN,ITEM,OLDEST1,RESULT
     183 K ^TMP("ORWGRPC TEMP",$J)
     184 I FMT=6 D
     185 . S OLDEST1=9999999-OLDEST
     186 . S DATE=9999999-NEWEST
     187 . F  S DATE=$O(^AUPNVTRT("AA",DFN,DATE)) Q:DATE<1  Q:DATE>OLDEST1  D
     188 .. S IEN=0
     189 .. F  S IEN=$O(^AUPNVTRT("AA",DFN,DATE,IEN)) Q:IEN<1  D
     190 ... S ITEM=+$G(^AUPNVTRT(IEN,0)) I 'ITEM Q
     191 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
     192 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
     193 ... S CNT=CNT+1
     194 ... S RESULT="9000010.15^"_ITEM
     195 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     196 I FMT'=6 D
     197 . S OLDEST1=9999999-OLDEST
     198 . S DATE=9999999-NEWEST
     199 . F  S DATE=$O(^AUPNVTRT("AA",DFN,DATE)) Q:DATE<1  Q:DATE>OLDEST  D
     200 .. S IEN=0
     201 .. F  S IEN=$O(^AUPNVTRT("AA",DFN,DATE,IEN)) Q:IEN<1  D
     202 ... S ITEM=+$G(^AUPNVTRT(IEN,0)) I 'ITEM Q
     203 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
     204 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
     205 ... S CNT=CNT+1
     206 ... I FMT=3 S RESULT="9000010.15^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010.15)_"^^"_DATE
     207 ... I FMT=0 S RESULT="9000010.15^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010.15)
     208 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     209 K ^TMP("ORWGRPC TEMP",$J)
     210 Q
     211 ;
     212VISITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
     213 N DATE,DATE2,ITEM,NODE,NUM,OK,RESULT
     214 K ^TMP("ORWGRPC TEMP",$J)
     215 I FMT=6 D
     216 . S DATE=0
     217 . F  S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1  Q:DATE>NEWEST  D
     218 .. S ITEM=""
     219 .. F  S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM=""  D
     220 ... S NODE=""
     221 ... F  S NODE=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE)) Q:NODE=""  D
     222 .... S NUM=0
     223 .... F  S NUM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM)) Q:NUM=""  D
     224 ..... S DATE2=+$P($G(^AUPNVSIT(NUM,0)),U,18)
     225 ..... I 'DATE2 S DATE2=DATE+.01
     226 ..... I +$E($P(DATE2,".",2),1,2)>24 S DATE2=(DATE\1)+.2359
     227 ..... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=DATE2
     228 . S ITEM=0
     229 . F  S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM<1  D
     230 .. S OK=0
     231 .. S DATE=0
     232 .. F  S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE<1  Q:DATE>NEWEST  D  Q:OK
     233 ... S DATE2=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE))
     234 ... I DATE2<OLDEST Q
     235 ... S CNT=CNT+1
     236 ... S OK=1
     237 ... S RESULT="9000010^"_ITEM
     238 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     239 I FMT'=6 D
     240 . S DATE=0
     241 . F  S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1  D
     242 .. S ITEM=0
     243 .. F  S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM<1  D
     244 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
     245 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
     246 ... S CNT=CNT+1
     247 ... I FMT=3 S RESULT="9000010^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)_"^^"_DATE
     248 ... I FMT=0 S RESULT="9000010^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)
     249 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
     250 K ^TMP("ORWGRPC TEMP",$J)
     251 Q
     252 ;
Note: See TracChangeset for help on using the changeset viewer.