[623] | 1 | ORWGAPIU ; 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 | ;
|
---|
| 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^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 | ;
|
---|
| 36 | FILE(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 | ;
|
---|
| 90 | GBLREF(FN) ; $$(file#) -> global reference
|
---|
| 91 | Q $$GBLREF^ORWGAPIX($G(FN))
|
---|
| 92 | ;
|
---|
| 93 | GENERIC(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 | ;
|
---|
| 128 | INISET ; postinit, set initial public graph setting - from ORY215
|
---|
| 129 | D INISET^ORWGAPIP
|
---|
| 130 | Q
|
---|
| 131 | ;
|
---|
| 132 | ITEMPRFX(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 | ;
|
---|
| 155 | OGROUP(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 | ;
|
---|
| 160 | RETURN(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 | ;
|
---|
| 168 | SETUP(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 | ;
|
---|
| 174 | DATETFM(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 | ;
|
---|
| 193 | MTN(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
|
---|