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

    r613 r623  
    1 ORWGAPIU        ; SLC/STAFF - Graph API Utilities ;3/17/08  10:27
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
    3         ;
    4 EVALUE(VAL,FILE,FIELD)  ; $$(internal value,file,field) -> external value or ""
    5         ; from ORWGAPI1, ORWGAPI2, ORWGAPI3, ORWGAPI4, ORWGAPIP, ORWGAPIR
    6         I VAL="" Q ""
    7         S FIELD=$G(FIELD,.01)
    8         I $E(FILE,1,2)=63 Q $$LABNAME^ORWGAPIC(VAL)
    9         I FILE="63AP;I" Q $$ICD9^ORWGAPIA(VAL)
    10         I FILE="45DX" Q $$ICD9^ORWGAPIA(VAL)
    11         I FILE="45OP" Q $$ICD0^ORWGAPIA(VAL)
    12         I FILE="45;ICD9" Q $$ICD9^ORWGAPIA(VAL)
    13         I FILE="45;ICD0" Q $$ICD0^ORWGAPIA(VAL)
    14         I FIELD=.01,'$L(VAL) Q ""
    15         I FILE=9000010.07 Q $$ICD9^ORWGAPIA(VAL)
    16         I FILE=9000010.18 Q $$ICPT^ORWGAPIA(VAL)
    17         I FILE=9000011 Q $$ICD9^ORWGAPIA(VAL)
    18         I FILE=9999911 Q $$ICD9^ORWGAPIA(VAL)
    19         I FILE=130 Q $$ICPT^ORWGAPIA(VAL)
    20         I FILE=120.8 Q $$ALLG^ORWGAPIA(VAL)
    21         I FILE=50.605 Q $$DC^ORWGAPIC(VAL)
    22         I FILE=68 Q $$AA^ORWGAPIC(VAL)
    23         I FILE=811.2 Q $$TAX^ORWGAPIA(VAL)
    24         D
    25         . I FILE=52 S FIELD=6 Q
    26         . I FILE=53.79 S FIELD=.08 Q
    27         . I FILE=55 S FILE=55.07 Q
    28         . I FILE="55NVA" S FILE=55.05 Q
    29         . I FILE=70 S FILE=70.03,FIELD=2 Q
    30         . I FILE=100 S FILE=100.001 Q
    31         . I FILE=120.5 S FIELD=.03 Q
    32         . I FILE=601.2 S FILE=601.21 Q
    33         Q $$EXT^ORWGAPIX(VAL,FILE,FIELD)
    34         ;
    35 FILE(FILE,REF,XREF,SCREEN)      ; from ORWGAPI
    36         S REF="",SCREEN="I 1",XREF="B"
    37         I FILE="" Q
    38         D
    39         . I FILE="45DX" S REF=$$GBLREF(80),XREF="AB" Q
    40         . I FILE="45OP" S REF=$$GBLREF(80.1),XREF="AB" Q
    41         . I FILE=50.605 S REF=$$GBLREF(50.605),XREF="C" Q
    42         . I FILE=52 S REF=$$GBLREF(50) Q
    43         . I FILE=53.79 S REF=$$GBLREF(50.7),SCREEN="I $P(ZERO,U,10)'=1" Q
    44         . I FILE=55 S REF=$$GBLREF(50) Q
    45         . I FILE="55NVA" S REF=$$GBLREF(50.7),SCREEN="I $P(ZERO,U,10)=1" Q
    46         . I FILE=63 S REF=$$GBLREF(60),SCREEN="I $L($P(ZERO,U,5)),""BO""[$P(ZERO,U,3),$P(ZERO,U,4)=""CH""" Q
    47         . I FILE="63AP" S REF=$$GBLREF(60),SCREEN="I 0" Q
    48         . I FILE="63AP;D" S REF=$$GBLREF(61.4) Q
    49         . I FILE="63AP;E" S REF=$$GBLREF(61.2) Q
    50         . I FILE="63AP;F" S REF=$$GBLREF(61.3) Q
    51         . I FILE="63AP;I" S REF=$$GBLREF(80),XREF="AB" Q
    52         . I FILE="63AP;M" S REF=$$GBLREF(61.1) Q
    53         . I FILE="63AP;O" S REF=$$GBLREF(61) Q
    54         . I FILE="63AP;P" S REF=$$GBLREF(61.5) Q
    55         . I FILE="63AP;T" S REF=$$GBLREF(60),SCREEN="I ""BO""[$P(ZERO,U,3),(($P(ZERO,U,4)=""CY"")!($P(ZERO,U,4)=""SP"")!($P(ZERO,U,4)=""EM"")!($P(ZERO,U,4)=""AU""))" Q
    56         . I FILE="63BB" S REF=$$GBLREF(66),SCREEN="I $P(ZERO,U,15)=1" Q
    57         . I FILE="63MI" S REF=$$GBLREF(60),SCREEN="I 0" Q
    58         . I FILE="63MI;A" S REF=$$GBLREF(62.06) Q
    59         . I FILE="63MI;M" S REF=$$GBLREF(60) Q  ; mycobacteria not currently used
    60         . I FILE="63MI;O" S REF=$$GBLREF(61.2),SCREEN="I $L($P(ZERO,U,5)),""BFPMV""[$P(ZERO,U,5)" Q
    61         . I FILE="63MI;S" S REF=$$GBLREF(61) Q
    62         . I FILE="63MI;T" S REF=$$GBLREF(60),SCREEN="I ""BO""[$P(ZERO,U,3),$P(ZERO,U,4)=""MI""" Q
    63         . I FILE=70 S REF=$$GBLREF(71) Q
    64         . I FILE=100 S REF=$$GBLREF(101.43) Q
    65         . I FILE=120.5 S REF=$$GBLREF(120.51),SCREEN="I ""BP^P^T^R^P^HT^WT^CVP^CG^PO2^PN""[$P(ZERO,U,2)" Q
    66         . ;I FILE=120.8 S REF=$$GBLREF(120.83) Q
    67         . I FILE=130 S REF=$$GBLREF(81),SCREEN="I '$P(ZERO,U,4)" Q
    68         . I FILE=405 S REF=$$GBLREF(44),SCREEN="I 0" Q
    69         . I FILE=601.2 S REF=$$GBLREF(601) Q
    70         . I FILE=690 S REF=$$GBLREF(697.2),XREF="BA" Q
    71         . I FILE=811.2 S REF=$$GBLREF(811.2),SCREEN="I $P(ZERO,U,6)'=1" Q
    72         . I FILE=8925 S REF=$$GBLREF(8925.1),SCREEN="I $P(ZERO,U,4)=""DOC""" Q
    73         . I FILE=9000010 S REF=$$GBLREF(44) Q
    74         . I FILE=9000010.07 S REF=$$GBLREF(80),XREF="AB" Q
    75         . I FILE=9000010.11 S REF=$$GBLREF(9999999.14),SCREEN="I $P(ZERO,U,7)'=1" Q
    76         . I FILE=9000010.12 S REF=$$GBLREF(9999999.28),SCREEN="I $P(ZERO,U,3)'=1" Q
    77         . I FILE=9000010.13 S REF=$$GBLREF(9999999.15),SCREEN="I $P(ZERO,U,4)'=1" Q
    78         . I FILE=9000010.16 S REF=$$GBLREF(9999999.09),SCREEN="I $P(ZERO,U,3)'=1" Q
    79         . I FILE=9000010.18 S REF=$$GBLREF(81),XREF="BA",SCREEN="I '$P(ZERO,U,4)" Q
    80         . I FILE=9000010.23 S REF=$$GBLREF(9999999.64),SCREEN="I $P(ZERO,U,10)=""F"",$P(ZERO,U,11)'=1" Q
    81         . I FILE=9000011 S REF=$$GBLREF(80),XREF="AB",SCREEN="I $E(ZERO)'=""E"",'$L($P(ZERO,U,9))" Q
    82         . I FILE=9999911 S REF=$$GBLREF(80),XREF="AB",SCREEN="I $E(ZERO)'=""E"",'$L($P(ZERO,U,9))" Q
    83         I $E(REF)'="^" S REF=""
    84         S REF=REF  ;_""""_XREF_""")"
    85         Q
    86         ;
    87 GBLREF(FN)      ; $$(file#) -> global reference
    88         Q $$GBLREF^ORWGAPIX($G(FN))
    89         ;
    90 INISET  ; postinit, set initial public graph setting  - from ORY215, ORY243
    91         D INISET^ORWGAPIP
    92         D RESOURCE^ORWGTASK
    93         Q
    94         ;
    95 ITEMPRFX(ITEM)  ; $$(item) -> item prefix   - from ORWGAPI1
    96         N ABBREV,PREFIX
    97         S PREFIX=""
    98         S ABBREV=$P(ITEM,";",2)
    99         I $E(ITEM)="A" D  Q PREFIX
    100         . I ABBREV="T" S PREFIX="TEST" Q
    101         . I ABBREV="S" S PREFIX="SPECIMEN" Q
    102         . I ABBREV="O" S PREFIX="ORGAN" Q
    103         . I ABBREV="M" S PREFIX="MORPHOLOGY" Q
    104         . I ABBREV="E" S PREFIX="ETIOLOGY" Q
    105         . I ABBREV="D" S PREFIX="DISEASE" Q
    106         . I ABBREV="P" S PREFIX="PROCEDURE" Q
    107         . I ABBREV="F" S PREFIX="FUNCTION" Q
    108         . I ABBREV="I" S PREFIX="ICD9" Q
    109         I $E(ITEM)="B" Q "BLOOD COMPONENT"
    110         I $E(ITEM)="M" D  Q PREFIX
    111         . I ABBREV="T" S PREFIX="TEST" Q
    112         . I ABBREV="S" S PREFIX="SPECIMEN" Q
    113         . I ABBREV="O" S PREFIX="ORGANISM" Q
    114         . I ABBREV="A" S PREFIX="ANTIBIOTIC" Q
    115         . I ABBREV="M" S PREFIX="TB ANTIBIOTIC" Q
    116         Q PREFIX
    117         ;
     1ORWGAPIU ; SLC/STAFF - Graph API Utilities ;8/19/06  15:20
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260**;Dec 17, 1997;Build 26
     3 ;
     4EVALUE(VAL,FILE,FIELD) ; $$(internal value,file,field) -> external value or ""
     5 ; from ORWGAPI1, ORWGAPI2, ORWGAPI3, ORWGAPI4, ORWGAPIP, ORWGAPIR
     6 I VAL="" Q ""
     7 S FIELD=$G(FIELD,.01)
     8 I $E(FILE,1,2)=63 Q $$LABNAME^ORWGAPIA(VAL)
     9 I FILE="63AP;I" Q $$ICD9^ORWGAPIA(VAL)
     10 I FILE="45DX" Q $$ICD9^ORWGAPIA(VAL)
     11 I FILE="45OP" Q $$ICD0^ORWGAPIA(VAL)
     12 I FILE="45;ICD9" Q $$ICD9^ORWGAPIA(VAL)
     13 I FILE="45;ICD0" Q $$ICD0^ORWGAPIA(VAL)
     14 I FIELD=.01,'$L(VAL) Q ""
     15 I FILE=9000010.07 Q $$ICD9^ORWGAPIA(VAL)
     16 I FILE=9000010.18 Q $$ICPT^ORWGAPIA(VAL)
     17 I FILE=9000011 Q $$ICD9^ORWGAPIA(VAL)
     18 I FILE=9999911 Q $$ICD9^ORWGAPIA(VAL)
     19 I FILE=130 Q $$ICPT^ORWGAPIA(VAL)
     20 I FILE=120.8 Q $$ALLG^ORWGAPIA(VAL)
     21 I FILE=50.605 Q $$DC^ORWGAPIA(VAL)
     22 I FILE=68 Q $$AA^ORWGAPIA(VAL)
     23 I FILE=811.2 Q $$TAX^ORWGAPIA(VAL)
     24 D
     25 . I FILE=52 S FIELD=6 Q
     26 . I FILE=53.79 S FIELD=.08 Q
     27 . I FILE=55 S FILE=55.07 Q
     28 . I FILE="55NVAE" S FILE=55.05 Q
     29 . I FILE="55NVA" S FILE=55.05 Q
     30 . I FILE=70 S FILE=70.03,FIELD=2 Q
     31 . I FILE=100 S FILE=100.001 Q
     32 . I FILE=120.5 S FIELD=.03 Q
     33 . I FILE=601.2 S FILE=601.21 Q
     34 Q $$EXT^ORWGAPIX(VAL,FILE,FIELD)
     35 ;
     36FILE(FILE,REF,XREF,SCREEN) ; from ORWGAPI
     37 S REF="",SCREEN="I 1",XREF="B"
     38 I FILE="" Q
     39 D
     40 . I FILE="45DX" S REF=$$GBLREF(80),XREF="AB" Q
     41 . I FILE="45OP" S REF=$$GBLREF(80.1),XREF="AB" Q
     42 . I FILE=50.605 S REF=$$GBLREF(50.605),XREF="C" Q
     43 . I FILE=52 S REF=$$GBLREF(50) Q
     44 . I FILE=53.79 S REF=$$GBLREF(50.7),SCREEN="I $P(ZERO,U,10)'=1" Q
     45 . I FILE=55 S REF=$$GBLREF(50) Q
     46 . I FILE="55NVAE" S REF=$$GBLREF(50.7),SCREEN="I $P(ZERO,U,10)=1" Q
     47 . I FILE="55NVA" S REF=$$GBLREF(50.7),SCREEN="I $P(ZERO,U,10)=1" Q
     48 . I FILE=63 S REF=$$GBLREF(60),SCREEN="I $L($P(ZERO,U,5)),""BO""[$P(ZERO,U,3),$P(ZERO,U,4)=""CH""" Q
     49 . I FILE="63AP" S REF=$$GBLREF(60),SCREEN="I 0" Q
     50 . I FILE="63AP;D" S REF=$$GBLREF(61.4) Q
     51 . I FILE="63AP;E" S REF=$$GBLREF(61.2) Q
     52 . I FILE="63AP;F" S REF=$$GBLREF(61.3) Q
     53 . I FILE="63AP;I" S REF=$$GBLREF(80),XREF="AB" Q
     54 . I FILE="63AP;M" S REF=$$GBLREF(61.1) Q
     55 . I FILE="63AP;O" S REF=$$GBLREF(61) Q
     56 . I FILE="63AP;P" S REF=$$GBLREF(61.5) Q
     57 . I FILE="63AP;T" S REF=$$GBLREF(60),SCREEN="I ""BO""[$P(ZERO,U,3),(($P(ZERO,U,4)=""CY"")!($P(ZERO,U,4)=""SP"")!($P(ZERO,U,4)=""EM"")!($P(ZERO,U,4)=""AU""))" Q
     58 . I FILE="63BB" S REF=$$GBLREF(66),SCREEN="I $P(ZERO,U,15)=1" Q
     59 . I FILE="63MI" S REF=$$GBLREF(60),SCREEN="I 0" Q
     60 . I FILE="63MI;A" S REF=$$GBLREF(62.06) Q
     61 . I FILE="63MI;M" S REF=$$GBLREF(60) Q  ; mycobacteria not currently used
     62 . I FILE="63MI;O" S REF=$$GBLREF(61.2),SCREEN="I $L($P(ZERO,U,5)),""BFPMV""[$P(ZERO,U,5)" Q
     63 . I FILE="63MI;S" S REF=$$GBLREF(61) Q
     64 . I FILE="63MI;T" S REF=$$GBLREF(60),SCREEN="I ""BO""[$P(ZERO,U,3),$P(ZERO,U,4)=""MI""" Q
     65 . I FILE=70 S REF=$$GBLREF(71) Q
     66 . I FILE=100 S REF=$$GBLREF(101.43) Q
     67 . I FILE=120.5 S REF=$$GBLREF(120.51),SCREEN="I ""BP^P^T^R^P^HT^WT^CVP^CG^PO2^PN""[$P(ZERO,U,2)" Q
     68 . ;I FILE=120.8 S REF=$$GBLREF(120.83) Q
     69 . I FILE=130 S REF=$$GBLREF(81),SCREEN="I '$P(ZERO,U,4)" Q
     70 . I FILE=405 S REF=$$GBLREF(44),SCREEN="I 0" Q
     71 . I FILE=601.2 S REF=$$GBLREF(601) Q
     72 . I FILE=690 S REF=$$GBLREF(697.2),XREF="BA" Q
     73 . I FILE=811.2 S REF=$$GBLREF(811.2),SCREEN="I $P(ZERO,U,6)'=1" Q
     74 . I FILE=8925 S REF=$$GBLREF(8925.1),SCREEN="I $P(ZERO,U,4)=""DOC""" Q
     75 . I FILE=9000010 S REF=$$GBLREF(44) Q
     76 . I FILE=9000010.07 S REF=$$GBLREF(80),XREF="AB" Q
     77 . I FILE=9000010.11 S REF=$$GBLREF(9999999.14),SCREEN="I $P(ZERO,U,7)'=1" Q
     78 . I FILE=9000010.12 S REF=$$GBLREF(9999999.28),SCREEN="I $P(ZERO,U,3)'=1" Q
     79 . I FILE=9000010.13 S REF=$$GBLREF(9999999.15),SCREEN="I $P(ZERO,U,4)'=1" Q
     80 . I FILE=9000010.15 S REF=$$GBLREF(9999999.17),SCREEN="I $P(ZERO,U,4)'=1" Q
     81 . I FILE=9000010.16 S REF=$$GBLREF(9999999.09),SCREEN="I $P(ZERO,U,3)'=1" Q
     82 . I FILE=9000010.18 S REF=$$GBLREF(81),SCREEN="I '$P(ZERO,U,4)" Q
     83 . I FILE=9000010.23 S REF=$$GBLREF(9999999.64),SCREEN="I $P(ZERO,U,10)=""F"",$P(ZERO,U,11)'=1" Q
     84 . I FILE=9000011 S REF=$$GBLREF(80),XREF="AB",SCREEN="I $E(ZERO)'=""E"",'$L($P(ZERO,U,9))" Q
     85 . I FILE=9999911 S REF=$$GBLREF(80),XREF="AB",SCREEN="I $E(ZERO)'=""E"",'$L($P(ZERO,U,9))" Q
     86 I $E(REF)'="^" S REF=""
     87 S REF=REF  ;_""""_XREF_""")"
     88 Q
     89 ;
     90GBLREF(FN) ; $$(file#) -> global reference
     91 Q $$GBLREF^ORWGAPIX($G(FN))
     92 ;
     93GENERIC(VAL,FROM,DIR,FILE,REF,XREF,SCREEN) ; Return a set of entries from xref in REF
     94 ; from ORWGAPI
     95 ; .VAL=returned list, FROM=text to $O from, DIR=$O direction,
     96 N CNT,IEN,NAME,NEXTNAME,NUM,OK,ROOT,ZERO S NUM=0,CNT=44 K VAL
     97 I FILE=405 Q
     98 S ROOT=""
     99 S FROM=$$UP^ORWGAPIX(FROM)
     100 I $E(REF,$L(REF))="," S ROOT=$E(REF,1,$L(REF)-1)_")"
     101 I $E(REF,$L(REF))="(" S ROOT=$P(REF,"(")
     102 I '$L(ROOT) Q
     103 S REF=REF_""""_XREF_""")"
     104 F  Q:NUM'<CNT  S FROM=$O(@REF@(FROM),DIR) Q:FROM=""  D
     105 . S IEN="" F  S IEN=$O(@REF@(FROM,IEN),DIR) Q:'IEN  D
     106 .. I FILE=100,$O(@REF@(FROM,IEN,""))>0 Q
     107 .. S ZERO=$G(@ROOT@(IEN,0)) I '$L(ZERO) Q
     108 .. X SCREEN I '$T Q
     109 .. S NUM=NUM+1
     110 .. I FILE="45DX"!(FILE=9000010.07)!(FILE=9000011)!(FILE="63AP;I") D  Q
     111 ... S VAL(NUM)=FILE_U_IEN_U_$$ICD9^ORWGAPIA(IEN) Q
     112 .. I FILE="45OP" S VAL(NUM)=FILE_U_IEN_U_$$ICD0^ORWGAPIA(IEN) Q
     113 .. I FILE="55NVAE"!(FILE=53.79) S VAL(NUM)=FILE_U_IEN_U_$$POINAME^ORWGAPIA(IEN) Q
     114 .. I FILE="55NVA" S VAL(NUM)=FILE_U_IEN_U_$$POINAME^ORWGAPIA(IEN) Q
     115 .. I FILE=9000010.18 S VAL(NUM)=FILE_U_IEN_U_$$ICPT^ORWGAPIA(IEN) Q
     116 .. I FILE=130 S VAL(NUM)=FILE_U_IEN_U_$$ICPT^ORWGAPIA(IEN) Q
     117 .. S VAL(NUM)=FILE_U_IEN_U_FROM
     118 I FILE=120.5 D
     119 . S (NUM,OK)=0
     120 . F  S NUM=$O(VAL(NUM)) Q:NUM<1  D  Q:OK
     121 .. S NAME=$P(VAL(NUM),U,3)
     122 .. S NEXTNAME=$P($G(VAL(NUM+1)),U,3)
     123 .. I "BODY MASS INDEX"]NAME,NEXTNAME]"BODY MASS INDEX" D
     124 ... S OK=1
     125 ... S VAL(NUM+.5)="120.5^99999^BODY MASS INDEX"
     126 Q
     127 ;
     128INISET ; postinit, set initial public graph setting  - from ORY215
     129 D INISET^ORWGAPIP
     130 Q
     131 ;
     132ITEMPRFX(ITEM) ; $$(item) -> item prefix   - from ORWGAPI1
     133 N ABBREV,PREFIX
     134 S PREFIX=""
     135 S ABBREV=$P(ITEM,";",2)
     136 I $E(ITEM)="A" D  Q PREFIX
     137 . I ABBREV="T" S PREFIX="TEST" Q
     138 . I ABBREV="S" S PREFIX="SPECIMEN" Q
     139 . I ABBREV="O" S PREFIX="ORGAN" Q
     140 . I ABBREV="M" S PREFIX="MORPHOLOGY" Q
     141 . I ABBREV="E" S PREFIX="ETIOLOGY" Q
     142 . I ABBREV="D" S PREFIX="DISEASE" Q
     143 . I ABBREV="P" S PREFIX="PROCEDURE" Q
     144 . I ABBREV="F" S PREFIX="FUNCTION" Q
     145 . I ABBREV="I" S PREFIX="ICD9" Q
     146 I $E(ITEM)="B" Q "BLOOD COMPONENT"
     147 I $E(ITEM)="M" D  Q PREFIX
     148 . I ABBREV="T" S PREFIX="TEST" Q
     149 . I ABBREV="S" S PREFIX="SPECIMEN" Q
     150 . I ABBREV="O" S PREFIX="ORGANISM" Q
     151 . I ABBREV="A" S PREFIX="ANTIBIOTIC" Q
     152 . I ABBREV="M" S PREFIX="TB ANTIBIOTIC" Q
     153 Q PREFIX
     154 ;
     155OGROUP(OITEM) ; $$(orderable item) -> ien display group^display group   - from ORWGAPIR
     156 N IEN
     157 S IEN=+$P($G(^ORD(101.43,+$G(OITEM),0)),U,5)
     158 Q IEN_U_"order - "_$P($G(^ORD(100.98,IEN,0)),U)
     159 ;
     160RETURN(TMP,ITEMS) ; return TMP (0 use local, 1 use ^TMP(ITEMS,$J, where ITEMS is a namespaced string)
     161 ; from ORWGAPI, ORWGAPIP, ORWGAPIX
     162 N NMSP
     163 S NMSP=$G(ITEMS) K ITEMS S ITEMS=""
     164 S TMP=NMSP?1U1UN1.14UNP
     165 I TMP S ITEMS=NMSP
     166 Q
     167 ;
     168SETUP(DATA,RESULT,TMP,CNT) ; from ORWGAPI1, ORWGAPI2, ORWGAPI3, ORWGAPI4, ORWGAPIP, ORWGAPIR, ORWGAPIX
     169 S CNT=CNT+1
     170 I TMP S ^TMP(DATA,$J,CNT)=RESULT
     171 I 'TMP S DATA(CNT)=RESULT
     172 Q
     173 ;
     174DATETFM(DATETIME) ; $$(external date/time) -> fm date/time else 0
     175 N DATE,DAY,FMDT,HOUR,MIN,SEC,TIME,YEAR
     176 S DATE=$P(DATETIME,"@"),TIME=$P(DATETIME,"@",2)
     177 S YEAR=$P(DATE,",",2) I $L(YEAR)'=4 Q 0
     178 S YEAR=YEAR-1700 I YEAR<270 Q 0
     179 S MONTH=$P(DATE," ")
     180 S MONTH=$$MTN(MONTH) I MONTH<1 Q 0
     181 I MONTH<10 S MONTH="0"_MONTH
     182 S DAY=$P(DATE," ",2),DAY=$P(DAY,",")
     183 I DAY<1 Q 0
     184 I DAY<10 S DAY="0"_DAY
     185 S HOUR=$P(TIME,":")
     186 S MIN=$P(TIME,":",2)
     187 S SEC=$P(TIME,":",3)
     188 S TIME=HOUR_MIN_SEC
     189 S FMDT=YEAR_MONTH_DAY
     190 I '$L(TIME) Q FMDT
     191 Q FMDT_"."_TIME
     192 ;
     193MTN(MONTH) ; $$(external month) -> month number
     194 N MONTHS,NUM
     195 I $L(MONTH)'=3 Q 0
     196 S MONTHS="JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"
     197 F NUM=1:1:13 I $P(MONTHS,U,NUM)=MONTH Q
     198 I NUM=13 Q 0
     199 Q NUM
Note: See TracChangeset for help on using the changeset viewer.