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

    r613 r623  
    1 ORWGAPIT        ; SLC/STAFF - Graph Item Types ;11/20/06  08:58
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
    3         ;
    4 COMPTYPE(FILE)  ; $$(file) -> hs component abbrv   - from ORWGAPID
    5         N COMP,COMPNAME,COMPS,NUM,OK K COMPS
    6         S COMPNAME=$$COMPNAME(FILE)_"]"
    7         D COMP^ORWRP2(.COMPS)
    8         S COMP=""
    9         S OK=0
    10         S NUM=0
    11         D
    12         . F  S NUM=$O(COMPS(NUM)) Q:NUM<1  D  I OK Q
    13         .. S COMP=COMPS(NUM)
    14         .. I COMP[COMPNAME,COMPNAME=$P($P(COMP,U,2),"[",2) S OK=1
    15         Q COMP
    16         ;
    17 COMPNAME(FILE)  ; $$(file) -> hs component abbrv
    18         I FILE=63 Q "CH"
    19         I FILE=120.5 Q "VSD"
    20         I FILE=120.8 Q "ADR"
    21         I FILE=52 Q "RXOP"
    22         I FILE=55 Q "RXUD"
    23         I FILE=70 Q "II"
    24         I FILE=9000010.11 Q "IM"
    25         I FILE=9000010.12 Q "ST"
    26         I FILE=9000010.13 Q "EXAM"
    27         I FILE=9000010.18 Q "CPT"
    28         I FILE=9000011 Q "PLL"
    29         I FILE=9999911 Q "PLL"
    30         I FILE=9000010.23 Q "HF"
    31         I FILE=9000010.07 Q "OD"
    32         I FILE=9000010.16 Q "ED"
    33         I FILE=601.2 Q "MHPE"
    34         I FILE=100 Q "ORC"
    35         I FILE="45OP" Q "PRC"
    36         I FILE="45DX" Q "DD"
    37         I FILE="63AP" Q "SP"
    38         I FILE="63BB" Q "BT"
    39         I FILE="63MI" Q "MIC"
    40         I FILE=9000010 Q "CVP"
    41         I FILE=405 Q "ADC"
    42         I FILE="55NVA" Q "RXNV"
    43         I FILE=53.79 Q "BCMA"
    44         I FILE=130 Q "SR"
    45         I FILE=8925 Q "CNB"
    46         I FILE=690 Q "MEDF"
    47         Q ""
    48         ;
    49 FILENAME(FILE)  ; $$(file) -> filename   - from ORWGAPIP
    50         I FILE=63 Q "LAB TESTS"
    51         I FILE=120.5 Q "VITALS"
    52         I FILE=120.8 Q "ALLERGIES"
    53         I FILE=52 Q "MEDICATION,OUTPATIENT"
    54         I FILE=55 Q "MEDICATION,INPATIENT"
    55         I FILE=70 Q "RADIOLOGY EXAMS"
    56         I FILE=9000010.11 Q "IMMUNIZATIONS"
    57         I FILE=9000010.12 Q "SKIN TESTS"
    58         I FILE=9000010.13 Q "EXAMS"
    59         I FILE=9000010.18 Q "PROCEDURES"
    60         I FILE=9000011 Q "PROBLEMS"
    61         I FILE=9999911 Q "PROBLEMS-DURATION" ;**************
    62         I FILE=9000010.23 Q "HEALTH FACTORS"
    63         I FILE=9000010.07 Q "PURPOSE OF VISIT"
    64         I FILE=9000010.16 Q "PATIENT EDUCATION"
    65         I FILE=601.2 Q "MENTAL HEALTH"
    66         I FILE=100 Q "ORDERS"
    67         I FILE="45OP" Q "REGISTRATION OP/PROC"
    68         I FILE="45DX" Q "REGISTRATION DX"
    69         I FILE="63AP" Q "ANATOMIC PATHOLOGY"
    70         I FILE="63BB" Q "BLOOD PRODUCTS"
    71         I FILE="63MI" Q "MICROBIOLOGY"
    72         I FILE=9000010 Q "VISITS"
    73         I FILE=405 Q "ADMISSIONS"
    74         I FILE="55NVA" Q "MEDICATION,NON-VA"
    75         I FILE=53.79 Q "MEDICATION,BCMA"
    76         I FILE=50.605 Q "DRUG CLASS"
    77         I FILE=68 Q "LAB ACC AREA"
    78         I FILE=8925.1 Q "NOTE TITLE"
    79         I FILE=100.98 Q "ORDER DISPLAY GROUP"
    80         I FILE=811.2 Q "REMINDER TAXONOMY"
    81         I FILE=130 Q "SURGERY"
    82         I FILE=8925 Q "NOTES"
    83         I FILE=690 Q "MEDICINE"
    84         Q ""
    85         ;
    86 FILECHK(FILES)  ;
    87         ; get parameter string of excluded files
    88         N CHECK,NUM,ORSRV,VAL
    89         S ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
    90         S CHECK=$$XGET^ORWGAPIX("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORWG GRAPH EXCLUDE DATA TYPE",1,"I")
    91         S CHECK=CHECK_";"
    92         S NUM=0
    93         F  S NUM=$O(FILES(NUM)) Q:NUM<1  D
    94         . S VAL=FILES(NUM)
    95         . S VAL=$P(VAL,U)_";"
    96         . I CHECK[VAL K FILES(NUM)
    97         Q
    98         ;
    99 GETFILES(FILES) ;
    100         ; file #^file name^graph type^lookup file^lookup global^lookup index^prefix^abbrev^hint format
    101         ; commenting out a line setting FILES will inactivate that type
    102         S FILES(1)="63^LAB TESTS^1^60^LAB(60,^B^^CH^~  ~units~flag~|"
    103         S FILES(2)="120.5^VITALS^1^120.51^GMRD(120.51,^B^^VSD^~  ~"
    104         S FILES(3)="52^MEDICATION,OUTPATIENT^3^50^PSDRUG(^B^^RXOP^~  ~"
    105         S FILES(4)="55^MEDICATION,INPATIENT^3^50^PSDRUG(^B^^RXUD^~  ~"
    106         S FILES(5)="70^RADIOLOGY EXAMS^2^71^RAMIS(71,^B^rad^II^~  ~"
    107         S FILES(6)="9000010.11^IMMUNIZATIONS^2^9999999.14^AUTTIMM(^B^imm^IM^~  ~"
    108         S FILES(7)="9000010.12^SKIN TESTS^2^9999999.28^AUTTSK(^B^skin^ST^~  ~"
    109         S FILES(8)="9000010.13^EXAMS^2^9999999.15,^AUTTEXAM(^B^exam^EXAM^~  ~"
    110         S FILES(9)="9000010.18^PROCEDURES^2^81^ICPT(^C^proc^CPT^~  ~"
    111         S FILES(10)="9000011^PROBLEMS^2^80^ICD9(^B^prob^PLL^~  ~" ;***
    112         S FILES(11)="9000010.23^HEALTH FACTORS^2^9999999.64^AUTTHF(,^B^hf^HF^~  ~"
    113         S FILES(12)="9000010.07^PURPOSE OF VISIT^2^80^ICD9(^B^pov^OD^"
    114         S FILES(13)="9000010.16^PATIENT EDUCATION^2^9999999.09^AUTTEDT(^B^edu^ED^~  ~"
    115         S FILES(14)="601.2^MENTAL HEALTH^2^601^YTT(601,^B^mh^MHPE^~  ~"
    116         S FILES(15)="100^ORDERS^2^101.43^ORD(101.43,^B^order^ORC^~  ~"
    117         S FILES(16)="45OP^REGISTRATION OP/PROC^2^*^^^op^PRC^~  ~"
    118         S FILES(17)="45DX^REGISTRATION DX^2^*^^^dx^DD^~  ~"
    119         S FILES(18)="63AP^ANATOMIC PATHOLOGY^2^*^^^ap^SP^~  ~"
    120         S FILES(19)="63MI^MICROBIOLOGY^2^*^^^micro^MIC^~  ~"
    121         S FILES(20)="9000010^VISITS^3^44^SC(^B^^CVP^~  ~"
    122         S FILES(21)="405^ADMISSIONS^3^*^^^^ADC^~  ~"
    123         S FILES(23)="53.79^MEDICATION,BCMA^2^50.7^PS(50.7,^B^^BCMA^~  ~"
    124         S FILES(24)="130^SURGERY^2^81^ICPT(^C^surg^SR^~  ~"
    125         S FILES(25)="8925^NOTES^2^*^^^note^CNB^~  ~"
    126         S FILES(27)="120.8^ALLERGIES^2^*^^^allg^ADR^~  ~"
    127         S FILES(28)="63BB^BLOOD BANK^2^66^LAB(66,^B^bb^BT^~  ~"
    128         ;S FILES(29)="9999911^PROBLEMS-DURATION^3^80^ICD9(^B^prob^PLL^~  ~" ;***
    129         S FILES(30)="55NVA^MEDICATION,NON-VA^3^50.7^PS(50.7,^B^^RXNV^~  ~"
    130         S FILES(31)="690^MEDICINE^2^*^^^med^MEDF^~  ~"
    131         S FILES(2000)="811.2^Reminder Taxonomy"
    132         S FILES(3000)="50.605^Drug Class"
    133         Q
    134         ;
    135 TYPES(TYPES,DFN,SUB,TMP)        ; from ORWGAPI
    136         N CNT,FILES,ITEM,MEDARRAY,NUM,OK,SEQ K FILES,MEDARRAY
    137         S TMP=$G(TMP)
    138         D GETFILES(.FILES)
    139         D FILECHK(.FILES)
    140         I SUB D
    141         . I $D(FILES(18)) D
    142         .. S FILES(1801)="63AP;O^AP: Organ"
    143         .. S FILES(1802)="63AP;T^AP: Test"
    144         .. S FILES(1803)="63AP;D^AP: Disease"
    145         .. S FILES(1804)="63AP;I^AP: ICD9"
    146         .. S FILES(1805)="63AP;E^AP: Etiology"
    147         .. S FILES(1806)="63AP;F^AP: Function"
    148         .. S FILES(1807)="63AP;P^AP: Procedure"
    149         .. S FILES(1808)="63AP;M^AP: Morphology"
    150         .. S FILES(1809)="63AP;S^AP: Specimen"
    151         . I $D(FILES(19)) D
    152         .. S FILES(1901)="63MI;A^Microbiology: Antibiotic"
    153         .. S FILES(1902)="63MI;T^Microbiology: Test"
    154         .. S FILES(1903)="63MI;S^Microbiology: Specimen"
    155         .. S FILES(1904)="63MI;O^Microbiology: Organism"
    156         .. ;S FILES(1905)="63MI;M^Microbiology: TB Drug"
    157         I 'SUB D
    158         . K FILES(2000)
    159         . K FILES(3000)
    160         I DFN D
    161         . I '$L($O(^PXRMINDX(63,"PI",DFN,""))) K FILES(1)
    162         . I '$L($O(^PXRMINDX(120.5,"PI",DFN,""))) K FILES(2)
    163         . I '$L($O(^PXRMINDX(52,"PI",DFN,""))) K FILES(3)
    164         . I '$L($O(^PXRMINDX(55,"PI",DFN,""))) K FILES(4)
    165         . I '$L($O(^PXRMINDX(70,"PI",DFN,""))) K FILES(5)
    166         . I '$L($O(^PXRMINDX(9000010.11,"PI",DFN,""))) K FILES(6)
    167         . I '$L($O(^PXRMINDX(9000010.12,"PI",DFN,""))) K FILES(7)
    168         . I '$L($O(^PXRMINDX(9000010.13,"PI",DFN,""))) K FILES(8)
    169         . I '$L($O(^PXRMINDX(9000010.18,"PPI",DFN,""))) K FILES(9)
    170         . I '$L($O(^PXRMINDX(9000011,"PSPI",DFN,""))) K FILES(10),FILES(29)
    171         . I '$L($O(^PXRMINDX(9000010.23,"PI",DFN,""))) K FILES(11)
    172         . I '$L($O(^PXRMINDX(9000010.07,"PPI",DFN,""))) K FILES(12)
    173         . I '$L($O(^PXRMINDX(9000010.16,"PI",DFN,""))) K FILES(13)
    174         . I '$L($O(^PXRMINDX(601.2,"PI",DFN,""))) K FILES(14)
    175         . I '$L($O(^PXRMINDX(100,"PI",DFN,""))) K FILES(15)
    176         . I '$L($O(^PXRMINDX(45,"ICD0","PNI",DFN,0))) K FILES(16)
    177         . I '$L($O(^PXRMINDX(45,"ICD9","PNI",DFN,0))) K FILES(17)
    178         . I $E($O(^PXRMINDX(63,"PI",DFN,"A")))'="A" K FILES(18) D
    179         .. F NUM=1:1:9 K FILES(180+NUM)
    180         . I $E($O(^PXRMINDX(63,"PI",DFN,"M")))'="M" K FILES(19) D
    181         .. F NUM=1:1:5 K FILES(190+NUM)
    182         . I '$$VISITX^ORWGAPIA(DFN) K FILES(20)
    183         . I '$$ADMITX^ORWGAPIA(DFN) K FILES(21)
    184         . I '$$NVAX^ORWGAPIC(DFN) K FILES(22),FILES(30)
    185         . I '$$BCMAX^ORWGAPIC(DFN) K FILES(23)
    186         . I '$$SURGX^ORWGAPIA(DFN) K FILES(24)
    187         . I '$$NOTEX^ORWGAPIA(DFN) K FILES(25)
    188         . I '$$ALLERGYX^ORWGAPIA(DFN) K FILES(27)
    189         . I '$$BBX^ORWGAPIB(DFN) K FILES(28)
    190         . S OK=0
    191         . D MEDICINE^ORWGAPIA(.MEDARRAY,DFN)
    192         . I $O(MEDARRAY(0)) S OK=1
    193         . I 'OK K FILES(31)
    194         S CNT=0,SEQ=0
    195         F  S SEQ=$O(FILES(SEQ)) Q:SEQ<1  D
    196         . S CNT=CNT+1
    197         . I TMP S ^TMP(TYPES,$J,CNT)=FILES(SEQ)
    198         . I 'TMP S TYPES(CNT)=FILES(SEQ)
    199         Q
    200         ;
     1ORWGAPIT ; SLC/STAFF - Graph Item Types ;11/20/06  08:58
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260**;Dec 17, 1997;Build 26
     3 ;
     4COMPTYPE(FILE) ; $$(file) -> hs component abbrv   - from ORWGAPID
     5 N COMP,COMPNAME,COMPS,NUM,OK K COMPS
     6 S COMPNAME=$$COMPNAME(FILE)_"]"
     7 D COMP^ORWRP2(.COMPS)
     8 S COMP=""
     9 S OK=0
     10 S NUM=0
     11 D
     12 . F  S NUM=$O(COMPS(NUM)) Q:NUM<1  D  I OK Q
     13 .. S COMP=COMPS(NUM)
     14 .. I COMP[COMPNAME,COMPNAME=$P($P(COMP,U,2),"[",2) S OK=1
     15 Q COMP
     16 ;
     17COMPNAME(FILE) ; $$(file) -> hs component abbrv
     18 I FILE=63 Q "CH"
     19 I FILE=120.5 Q "VSD"
     20 I FILE=120.8 Q "ADR"
     21 I FILE=52 Q "RXOP"
     22 I FILE=55 Q "RXUD"
     23 I FILE=70 Q "II"
     24 I FILE=9000010.11 Q "IM"
     25 I FILE=9000010.12 Q "ST"
     26 I FILE=9000010.13 Q "EXAM"
     27 I FILE=9000010.18 Q "CPT"
     28 I FILE=9000011 Q "PLL"
     29 I FILE=9999911 Q "PLL"
     30 I FILE=9000010.23 Q "HF"
     31 I FILE=9000010.07 Q "OD"
     32 I FILE=9000010.16 Q "ED"
     33 I FILE=601.2 Q "MHPE"
     34 I FILE=100 Q "ORC"
     35 I FILE="45OP" Q "PRC"
     36 I FILE="45DX" Q "DD"
     37 I FILE="63AP" Q "SP"
     38 I FILE="63BB" Q "BT"
     39 I FILE="63MI" Q "MIC"
     40 I FILE=9000010 Q "CVP"
     41 I FILE=405 Q "ADC"
     42 I FILE="55NVAE" Q "RXNV"
     43 I FILE="55NVA" Q "RXNV"
     44 I FILE=53.79 Q "BCMA"
     45 I FILE=130 Q "SR"
     46 I FILE=8925 Q "CNB"
     47 I FILE=9000010.15 Q "TP"
     48 I FILE=690 Q "MEDF"
     49 Q ""
     50 ;
     51FILENAME(FILE) ; $$(file) -> filename   - from ORWGAPIP
     52 I FILE=63 Q "LAB TESTS"
     53 I FILE=120.5 Q "VITALS"
     54 I FILE=120.8 Q "ALLERGIES"
     55 I FILE=52 Q "MEDICATION,OUTPATIENT"
     56 I FILE=55 Q "MEDICATION,INPATIENT"
     57 I FILE=70 Q "RADIOLOGY EXAMS"
     58 I FILE=9000010.11 Q "IMMUNIZATIONS"
     59 I FILE=9000010.12 Q "SKIN TESTS"
     60 I FILE=9000010.13 Q "EXAMS"
     61 I FILE=9000010.18 Q "PROCEDURES"
     62 I FILE=9000011 Q "PROBLEMS"
     63 I FILE=9999911 Q "PROBLEMS-DURATION" ;**************
     64 I FILE=9000010.23 Q "HEALTH FACTORS"
     65 I FILE=9000010.07 Q "PURPOSE OF VISIT"
     66 I FILE=9000010.16 Q "PATIENT EDUCATION"
     67 I FILE=601.2 Q "MENTAL HEALTH"
     68 I FILE=100 Q "ORDERS"
     69 I FILE="45OP" Q "REGISTRATION OP/PROC"
     70 I FILE="45DX" Q "REGISTRATION DX"
     71 I FILE="63AP" Q "ANATOMIC PATHOLOGY"
     72 I FILE="63BB" Q "BLOOD PRODUCTS"
     73 I FILE="63MI" Q "MICROBIOLOGY"
     74 I FILE=9000010 Q "VISITS"
     75 I FILE=405 Q "ADMISSIONS"
     76 I FILE="55NVAE" Q "MEDICATION,NON-VA-EVENT" ;*****
     77 I FILE="55NVA" Q "MEDICATION,NON-VA"
     78 I FILE=53.79 Q "MEDICATION,BCMA"
     79 I FILE=50.605 Q "DRUG CLASS"
     80 I FILE=68 Q "LAB ACC AREA"
     81 I FILE=8925.1 Q "NOTE TITLE"
     82 I FILE=100.98 Q "ORDER DISPLAY GROUP"
     83 I FILE=811.2 Q "REMINDER TAXONOMY"
     84 I FILE=130 Q "SURGERY"
     85 I FILE=8925 Q "NOTES"
     86 I FILE=9000010.15 Q "TREATMENTS"
     87 I FILE=690 Q "MEDICINE"
     88 Q ""
     89 ;
     90FILECHK(FILES) ;
     91 ; get parameter string of excluded files
     92 N CHECK,NUM,ORSRV,VAL
     93 S ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
     94 S CHECK=$$XGET^ORWGAPIX("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORWG GRAPH EXCLUDE DATA TYPE",1,"I")
     95 S CHECK=CHECK_";"
     96 S NUM=0
     97 F  S NUM=$O(FILES(NUM)) Q:NUM<1  D
     98 . S VAL=FILES(NUM)
     99 . S VAL=$P(VAL,U)_";"
     100 . I CHECK[VAL K FILES(NUM)
     101 Q
     102 ;
     103GETFILES(FILES) ;
     104 ; file #^file name^graph type^lookup file^lookup global^lookup index
     105 ; commenting out a line setting FILES will inactivate that type
     106 S FILES(1)="63^LAB TESTS^1^60^LAB(60,^B^^CH^"
     107 S FILES(2)="120.5^VITALS^1^120.51^GMRD(120.51,^B^^VSD^"
     108 S FILES(3)="52^MEDICATION,OUTPATIENT^3^50^PSDRUG(^B^^RXOP^"
     109 S FILES(4)="55^MEDICATION,INPATIENT^3^50^PSDRUG(^B^^RXUD^"
     110 S FILES(5)="70^RADIOLOGY EXAMS^2^71^RAMIS(71,^B^rad^II^"
     111 S FILES(6)="9000010.11^IMMUNIZATIONS^2^9999999.14^AUTTIMM(^B^imm^IM^"
     112 S FILES(7)="9000010.12^SKIN TESTS^2^9999999.28^AUTTSK(^B^skin^ST^"
     113 S FILES(8)="9000010.13^EXAMS^2^9999999.15,^AUTTEXAM(^B^exam^EXAM^"
     114 S FILES(9)="9000010.18^PROCEDURES^2^81^ICPT(^C^proc^CPT^"
     115 S FILES(10)="9000011^PROBLEMS^2^80^ICD9(^B^prob^PLL^" ;***
     116 S FILES(11)="9000010.23^HEALTH FACTORS^2^9999999.64^AUTTHF(,^B^hf^HF^"
     117 S FILES(12)="9000010.07^PURPOSE OF VISIT^2^80^ICD9(^B^pov^OD^"
     118 S FILES(13)="9000010.16^PATIENT EDUCATION^2^9999999.09^AUTTEDT(^B^edu^ED^"
     119 S FILES(14)="601.2^MENTAL HEALTH^2^601^YTT(601,^B^mh^MHPE^"
     120 S FILES(15)="100^ORDERS^2^101.43^ORD(101.43,^B^order^ORC^"
     121 S FILES(16)="45OP^REGISTRATION OP/PROC^2^*^^^op^PRC^"
     122 S FILES(17)="45DX^REGISTRATION DX^2^*^^^dx^DD^"
     123 S FILES(18)="63AP^ANATOMIC PATHOLOGY^2^*^^^ap^SP^"
     124 S FILES(19)="63MI^MICROBIOLOGY^2^*^^^micro^MIC^"
     125 S FILES(20)="9000010^VISITS^3^44^SC(^B^^CVP^"
     126 S FILES(21)="405^ADMISSIONS^3^*^^^^ADC^"
     127 ;S FILES(22)="55NVAE^MEDICATION,NON-VA-EVENT^2^50.7^PS(50.7,^B^^RXNV^"
     128 S FILES(23)="53.79^MEDICATION,BCMA^2^50.7^PS(50.7,^B^^BCMA^"
     129 S FILES(24)="130^SURGERY^2^81^ICPT(^C^surg^SR^"
     130 S FILES(25)="8925^NOTES^2^*^^^note^CNB^"
     131 ;S FILES(26)="9000010.15^TREATMENTS^2^9999999.17,^AUTTTRT(^B^treat^TP^"
     132 S FILES(27)="120.8^ALLERGIES^2^*^^^allg^ADR^"
     133 S FILES(28)="63BB^BLOOD BANK^2^66^LAB(66,^B^bb^BT^"
     134 ;S FILES(29)="9999911^PROBLEMS-DURATION^3^80^ICD9(^B^prob^PLL^" ;***
     135 S FILES(30)="55NVA^MEDICATION,NON-VA^3^50.7^PS(50.7,^B^^RXNV^"
     136 S FILES(31)="690^MEDICINE^2^*^^^med^MEDF^"
     137 S FILES(2000)="811.2^Reminder Taxonomy"
     138 S FILES(3000)="50.605^Drug Class"
     139 Q
     140 ;
     141TYPES(TYPES,DFN,SUB,TMP) ; from ORWGAPI
     142 N CNT,FILES,ITEM,MEDARRAY,NUM,OK,SEQ K FILES,MEDARRAY
     143 S TMP=$G(TMP)
     144 D GETFILES(.FILES)
     145 D FILECHK(.FILES)
     146 I SUB D
     147 . I $D(FILES(18)) D
     148 .. S FILES(1801)="63AP;O^AP: Organ"
     149 .. S FILES(1802)="63AP;T^AP: Test"
     150 .. S FILES(1803)="63AP;D^AP: Disease"
     151 .. S FILES(1804)="63AP;I^AP: ICD9"
     152 .. S FILES(1805)="63AP;E^AP: Etiology"
     153 .. S FILES(1806)="63AP;F^AP: Function"
     154 .. S FILES(1807)="63AP;P^AP: Procedure"
     155 .. S FILES(1808)="63AP;M^AP: Morphology"
     156 .. S FILES(1809)="63AP;S^AP: Specimen"
     157 . I $D(FILES(19)) D
     158 .. S FILES(1901)="63MI;A^Microbiology: Antibiotic"
     159 .. S FILES(1902)="63MI;T^Microbiology: Test"
     160 .. S FILES(1903)="63MI;S^Microbiology: Specimen"
     161 .. S FILES(1904)="63MI;O^Microbiology: Organism"
     162 .. ;S FILES(1905)="63MI;M^Microbiology: TB Drug"
     163 I 'SUB D
     164 . K FILES(2000)
     165 . K FILES(3000)
     166 I DFN D
     167 . I '$L($O(^PXRMINDX(63,"PI",DFN,""))) K FILES(1)
     168 . I '$L($O(^PXRMINDX(120.5,"PI",DFN,""))) K FILES(2)
     169 . I '$L($O(^PXRMINDX(52,"PI",DFN,""))) K FILES(3)
     170 . I '$L($O(^PXRMINDX(55,"PI",DFN,""))) K FILES(4)
     171 . I '$L($O(^PXRMINDX(70,"PI",DFN,""))) K FILES(5)
     172 . I '$L($O(^PXRMINDX(9000010.11,"PI",DFN,""))) K FILES(6)
     173 . I '$L($O(^PXRMINDX(9000010.12,"PI",DFN,""))) K FILES(7)
     174 . I '$L($O(^PXRMINDX(9000010.13,"PI",DFN,""))) K FILES(8)
     175 . I '$L($O(^PXRMINDX(9000010.18,"PPI",DFN,""))) K FILES(9)
     176 . I '$L($O(^PXRMINDX(9000011,"PSPI",DFN,""))) K FILES(10),FILES(29)
     177 . I '$L($O(^PXRMINDX(9000010.23,"PI",DFN,""))) K FILES(11)
     178 . I '$L($O(^PXRMINDX(9000010.07,"PPI",DFN,""))) K FILES(12)
     179 . I '$L($O(^PXRMINDX(9000010.16,"PI",DFN,""))) K FILES(13)
     180 . I '$L($O(^PXRMINDX(601.2,"PI",DFN,""))) K FILES(14)
     181 . I '$L($O(^PXRMINDX(100,"PI",DFN,""))) K FILES(15)
     182 . I '$L($O(^PXRMINDX(45,"ICD0","PNI",DFN,0))) K FILES(16)
     183 . I '$L($O(^PXRMINDX(45,"ICD9","PNI",DFN,0))) K FILES(17)
     184 . I $E($O(^PXRMINDX(63,"PI",DFN,"A")))'="A" K FILES(18) D
     185 .. F NUM=1:1:9 K FILES(180+NUM)
     186 . I $E($O(^PXRMINDX(63,"PI",DFN,"M")))'="M" K FILES(19) D
     187 .. F NUM=1:1:5 K FILES(190+NUM)
     188 . I '$$VISITX^ORWGAPIA(DFN) K FILES(20)
     189 . I '$$ADMITX^ORWGAPIA(DFN) K FILES(21)
     190 . I '$$NVAX^ORWGAPIA(DFN) K FILES(22),FILES(30)
     191 . I '$$BCMAX^ORWGAPIA(DFN) K FILES(23)
     192 . I '$$SURGX^ORWGAPIA(DFN) K FILES(24)
     193 . I '$$NOTEX^ORWGAPIA(DFN) K FILES(25)
     194 . I '$$TREATX^ORWGAPIA(DFN) K FILES(26)
     195 . I '$$ALLERGYX^ORWGAPIA(DFN) K FILES(27)
     196 . I '$$BBX^ORWGAPIB(DFN) K FILES(28)
     197 . S OK=0
     198 . D MEDICINE^ORWGAPIA(.MEDARRAY,DFN)
     199 . I $O(MEDARRAY(0)) S OK=1
     200 . I 'OK K FILES(31)
     201 S CNT=0,SEQ=0
     202 F  S SEQ=$O(FILES(SEQ)) Q:SEQ<1  D
     203 . S CNT=CNT+1
     204 . I TMP S ^TMP(TYPES,$J,CNT)=FILES(SEQ)
     205 . I 'TMP S TYPES(CNT)=FILES(SEQ)
     206 Q
     207 ;
Note: See TracChangeset for help on using the changeset viewer.