VistA-WorldVistAEHR/r/LAB_SERVICE-LR-LS/LRPXAPPU.m

139 lines
3.5 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
LRPXAPPU ;SLC/STAFF - Test Lab APIs Utilities ;1/29/04 14:35
;;5.2;LAB SERVICE;**295**;Sep 27, 1994
;
; This routine is used along with LRPXAPP for testing Lab APIs.
;
DISPLAY ; from LRPXAPP
; displays results stored in a TMP global
N NUM,NUM1
W ! S NUM=""
F S NUM=$O(^TMP("LRPXAPP",$J,NUM)) Q:NUM="" D
. I $D(^TMP("LRPXAPP",$J,NUM))#2 W !,^(NUM) Q
. S NUM1=""
. F S NUM1=$O(^TMP("LRPXAPP",$J,NUM,NUM1)) Q:NUM1="" W !,NUM,",",NUM1
K ^TMP("LRPXAPP",$J)
Q
;
GETTYPE(TYPE,ERR) ; from LRPXAPP
; asks for type of data (C, M, A), returned as TYPE
N DIR,DIRUT,DTOUT,X,Y K DIR
S ERR=0,TYPE=""
S DIR(0)="SAO^C:CHEMISTRY;M:MICROBIOLOGY;A:ANATOMIC PATHOLOGY"
S DIR("A")="Type of data -- C M A : "
S DIR("B")="C"
D ^DIR K DIR
I Y[U!$D(DTOUT) S ERR=1 Q
S TYPE=Y
W !
Q
;
GETPT(DFN,ERR) ; from LRPXAPP
; asks for a patient, returns DFN
N DIC,X,Y K DIC,Y
S ERR=0
S DIC=2,DIC(0)="AEMOQZ"
D ^DIC I Y<1 S ERR=-1
S DFN=+Y
W !
Q
;
GETCOND(COND,TYPE,ERR) ; from LRPXAPI6,LRPXAPP
; asks for a conditional expression, returned as COND
N DIR,DIRUT,DTOUT,X,Y K DIR
S TYPE=$G(TYPE,"C")
S ERR=0,COND=""
S DIR(0)="FAO^^I '$$CONDOK^LRPXAPIU(X,TYPE) K X"
S DIR("A")="Condition: "
D ^DIR K DIR
I Y[U!$D(DTOUT) S ERR=1 Q
S COND=Y
W !
Q
;
GETDATE(FROM,TO,ERR) ; from LRPXAPP
; asks for a date range
; FROM return as oldest date selection, TO as most recent
N DIR,DIRUT,DTOUT,X,Y K DIR
S (FROM,TO,ERR)=0
S DIR(0)="DAO^2900101:DT:EX"
S DIR("A")="From: "
D ^DIR K DIR
I Y[U!$D(DTOUT) S ERR=1 Q
I '$L(Y) S (FROM,TO)="" Q
S FROM=Y
;
N DIR,X,Y K DIR
S DIR(0)="DAO^2900101:DT:EX"
S DIR("A")="To: "
D ^DIR K DIR
I $D(DIRUT) S FROM=0,ERR=-1 Q
S TO=Y D DATES^LRPXAPIU(.FROM,.TO)
W !
Q
;
GETTEST(TEST,TYPE,ERR) ; from LRPXAPP
; asks for a lab test, returned as TEST
N DIC,X,Y K DIC
S ERR=0
S DIC=60,DIC(0)="AEMOQ"
S TYPE=$G(TYPE,"C") D
. I TYPE="C" S DIC("S")="I $P(^(0),U,4)=""CH"""
. I TYPE="M" S DIC("S")="I $P(^(0),U,4)=""MI"""
. I TYPE="A" S DIC("S")="I ""CYEMSPAU""[$P(^(0),U,4),$L($P(^(0),U,4))"
D ^DIC I Y<1 S ERR=-1
S TEST=+Y
W !
Q
;
GETAP(CODE,ERR) ; from LRPXAPP
; asks for an AP item, returned as CODE
N FILE,DIC,DIR,DIRUT,DTOUT,X,Y K DIC,DIR
S ERR=0,CODE=""
S DIR(0)="SA^S:SPEC;T:TEST;O:ORGAN;D:DISEASE;M:MORPH;E:ETIOLOGY;F:FUNC;P:PROC;I:ICD"
S DIR("A")="Type of code -- S T O D M E F P I: "
D ^DIR K DIR
I Y[U!$D(DTOUT) S ERR=1 Q
S FILE=Y
I FILE="S" D Q ; specimen is free text
. N DIR,DIRUT,DTOUT,X,Y K DIR
. S DIR(0)="FAO^^"
. S DIR("A")="Specimen (free text): "
. D ^DIR K DIR
. I Y[U!$D(DTOUT) S ERR=1 Q
. S CODE="A;S;1."_$$UP^XLFSTR(Y)
D I Y<1!$D(DTOUT) S ERR=1 Q
. S DIC(0)="AEMOQ"
. I FILE="T" D GETTEST(.Y,"A",.ERR) Q
. I FILE="O" S DIC=61 D ^DIC Q
. I FILE="D" S DIC=61.4 D ^DIC Q
. I FILE="M" S DIC=61.1 D ^DIC Q
. I FILE="E" S DIC=61.2 D ^DIC Q
. I FILE="F" S DIC=61.3 D ^DIC Q
. I FILE="P" S DIC=61.5 D ^DIC Q
. I FILE="I" S DIC=80 D ^DIC Q
S CODE="A;"_FILE_";"_+Y
W !
Q
;
GETMICRO(CODE,ERR) ; from LRPXAPP
; asks for a Micro item, returned as CODE
N FILE,DIC,DIR,DIRUT,DTOUT,X,Y K DIC,DIR
S ERR=0,CODE=""
S DIR(0)="SA^S:SPEC;T:TEST;O:ORGANISM;A:ANTIMICROBIAL;M:MYCOBACTERIA DRUG"
S DIR("A")="Type of code -- S T O A M : "
D ^DIR K DIR
I Y[U!$D(DTOUT) S ERR=1 Q
S FILE=Y
S DIC(0)="AEMOQ"
D I Y<1!$D(DTOUT) S ERR=1 Q
. I FILE="T" D GETTEST(.Y,"M",.ERR) Q
. I FILE="S" S DIC=61 D ^DIC Q
. I FILE="O" S DIC=61.2 D ^DIC Q
. I FILE="A" S DIC=62.06 D ^DIC Q
. I FILE="M" D Q
.. S DIC="^DD(63.39," D ^DIC ; dbia 999
.. I '$$TBDN^LRPXAPIU(+Y) S Y=-1 Q
S CODE="M;"_FILE_";"_+Y
W !
Q