LRPXAPPU ;VA/SLC/STAFF - Test Lab APIs Utilities ; 17-Oct-2014 09:22 ; MKK
;;5.2;LAB SERVICE;**1030,1034**;NOV 01, 1997;Build 88
;;5.2;LAB SERVICE;**295**;Sep 27, 1994;Build 5
;
; 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
LRPXAPPU ;VA/SLC/STAFF - Test Lab APIs Utilities ; 17-Oct-2014 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**1030,1034**;NOV 01, 1997;Build 88
+2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994;Build 5
+3 ;
+4 ; This routine is used along with LRPXAPP for testing Lab APIs.
+5 ;
DISPLAY ; from LRPXAPP
+1 ; displays results stored in a TMP global
+2 NEW NUM,NUM1
+3 WRITE !
SET NUM=""
+4 FOR
SET NUM=$ORDER(^TMP("LRPXAPP",$JOB,NUM))
IF NUM=""
QUIT
Begin DoDot:1
+5 IF $DATA(^TMP("LRPXAPP",$JOB,NUM))#2
WRITE !,^(NUM)
QUIT
+6 SET NUM1=""
+7 FOR
SET NUM1=$ORDER(^TMP("LRPXAPP",$JOB,NUM,NUM1))
IF NUM1=""
QUIT
WRITE !,NUM,",",NUM1
End DoDot:1
+8 KILL ^TMP("LRPXAPP",$JOB)
+9 QUIT
+10 ;
GETTYPE(TYPE,ERR) ; from LRPXAPP
+1 ; asks for type of data (C, M, A), returned as TYPE
+2 NEW DIR,DIRUT,DTOUT,X,Y
KILL DIR
+3 SET ERR=0
SET TYPE=""
+4 SET DIR(0)="SAO^C:CHEMISTRY;M:MICROBIOLOGY;A:ANATOMIC PATHOLOGY"
+5 SET DIR("A")="Type of data -- C M A : "
+6 SET DIR("B")="C"
+7 DO ^DIR
KILL DIR
+8 IF Y[U!$DATA(DTOUT)
SET ERR=1
QUIT
+9 SET TYPE=Y
+10 WRITE !
+11 QUIT
+12 ;
GETPT(DFN,ERR) ; from LRPXAPP
+1 ; asks for a patient, returns DFN
+2 NEW DIC,X,Y
KILL DIC,Y
+3 SET ERR=0
+4 SET DIC=2
SET DIC(0)="AEMOQZ"
+5 DO ^DIC
IF Y<1
SET ERR=-1
+6 SET DFN=+Y
+7 WRITE !
+8 QUIT
+9 ;
GETCOND(COND,TYPE,ERR) ; from LRPXAPI6,LRPXAPP
+1 ; asks for a conditional expression, returned as COND
+2 NEW DIR,DIRUT,DTOUT,X,Y
KILL DIR
+3 SET TYPE=$GET(TYPE,"C")
+4 SET ERR=0
SET COND=""
+5 SET DIR(0)="FAO^^I '$$CONDOK^LRPXAPIU(X,TYPE) K X"
+6 SET DIR("A")="Condition: "
+7 DO ^DIR
KILL DIR
+8 IF Y[U!$DATA(DTOUT)
SET ERR=1
QUIT
+9 SET COND=Y
+10 WRITE !
+11 QUIT
+12 ;
GETDATE(FROM,TO,ERR) ; from LRPXAPP
+1 ; asks for a date range
+2 ; FROM return as oldest date selection, TO as most recent
+3 NEW DIR,DIRUT,DTOUT,X,Y
KILL DIR
+4 SET (FROM,TO,ERR)=0
+5 SET DIR(0)="DAO^2900101:DT:EX"
+6 SET DIR("A")="From: "
+7 DO ^DIR
KILL DIR
+8 IF Y[U!$DATA(DTOUT)
SET ERR=1
QUIT
+9 IF '$LENGTH(Y)
SET (FROM,TO)=""
QUIT
+10 SET FROM=Y
+11 ;
+12 NEW DIR,X,Y
KILL DIR
+13 SET DIR(0)="DAO^2900101:DT:EX"
+14 SET DIR("A")="To: "
+15 DO ^DIR
KILL DIR
+16 IF $DATA(DIRUT)
SET FROM=0
SET ERR=-1
QUIT
+17 SET TO=Y
DO DATES^LRPXAPIU(.FROM,.TO)
+18 WRITE !
+19 QUIT
+20 ;
GETTEST(TEST,TYPE,ERR) ; from LRPXAPP
+1 ; asks for a lab test, returned as TEST
+2 NEW DIC,X,Y
KILL DIC
+3 SET ERR=0
+4 SET DIC=60
SET DIC(0)="AEMOQ"
+5 SET TYPE=$GET(TYPE,"C")
Begin DoDot:1
+6 IF TYPE="C"
SET DIC("S")="I $P(^(0),U,4)=""CH"""
+7 IF TYPE="M"
SET DIC("S")="I $P(^(0),U,4)=""MI"""
+8 IF TYPE="A"
SET DIC("S")="I ""CYEMSPAU""[$P(^(0),U,4),$L($P(^(0),U,4))"
End DoDot:1
+9 DO ^DIC
IF Y<1
SET ERR=-1
+10 SET TEST=+Y
+11 WRITE !
+12 QUIT
+13 ;
GETAP(CODE,ERR) ; from LRPXAPP
+1 ; asks for an AP item, returned as CODE
+2 NEW FILE,DIC,DIR,DIRUT,DTOUT,X,Y
KILL DIC,DIR
+3 SET ERR=0
SET CODE=""
+4 SET DIR(0)="SA^S:SPEC;T:TEST;O:ORGAN;D:DISEASE;M:MORPH;E:ETIOLOGY;F:FUNC;P:PROC;I:ICD"
+5 SET DIR("A")="Type of code -- S T O D M E F P I: "
+6 DO ^DIR
KILL DIR
+7 IF Y[U!$DATA(DTOUT)
SET ERR=1
QUIT
+8 SET FILE=Y
+9 ; specimen is free text
IF FILE="S"
Begin DoDot:1
+10 NEW DIR,DIRUT,DTOUT,X,Y
KILL DIR
+11 SET DIR(0)="FAO^^"
+12 SET DIR("A")="Specimen (free text): "
+13 DO ^DIR
KILL DIR
+14 IF Y[U!$DATA(DTOUT)
SET ERR=1
QUIT
+15 SET CODE="A;S;1."_$$UP^XLFSTR(Y)
End DoDot:1
QUIT
+16 Begin DoDot:1
+17 SET DIC(0)="AEMOQ"
+18 IF FILE="T"
DO GETTEST(.Y,"A",.ERR)
QUIT
+19 IF FILE="O"
SET DIC=61
DO ^DIC
QUIT
+20 IF FILE="D"
SET DIC=61.4
DO ^DIC
QUIT
+21 IF FILE="M"
SET DIC=61.1
DO ^DIC
QUIT
+22 IF FILE="E"
SET DIC=61.2
DO ^DIC
QUIT
+23 IF FILE="F"
SET DIC=61.3
DO ^DIC
QUIT
+24 IF FILE="P"
SET DIC=61.5
DO ^DIC
QUIT
+25 IF FILE="I"
SET DIC=80
DO ^DIC
QUIT
End DoDot:1
IF Y<1!$DATA(DTOUT)
SET ERR=1
QUIT
+26 SET CODE="A;"_FILE_";"_+Y
+27 WRITE !
+28 QUIT
+29 ;
GETMICRO(CODE,ERR) ; from LRPXAPP
+1 ; asks for a Micro item, returned as CODE
+2 NEW FILE,DIC,DIR,DIRUT,DTOUT,X,Y
KILL DIC,DIR
+3 SET ERR=0
SET CODE=""
+4 SET DIR(0)="SA^S:SPEC;T:TEST;O:ORGANISM;A:ANTIMICROBIAL;M:MYCOBACTERIA DRUG"
+5 SET DIR("A")="Type of code -- S T O A M : "
+6 DO ^DIR
KILL DIR
+7 IF Y[U!$DATA(DTOUT)
SET ERR=1
QUIT
+8 SET FILE=Y
+9 SET DIC(0)="AEMOQ"
+10 Begin DoDot:1
+11 IF FILE="T"
DO GETTEST(.Y,"M",.ERR)
QUIT
+12 IF FILE="S"
SET DIC=61
DO ^DIC
QUIT
+13 IF FILE="O"
SET DIC=61.2
DO ^DIC
QUIT
+14 IF FILE="A"
SET DIC=62.06
DO ^DIC
QUIT
+15 IF FILE="M"
Begin DoDot:2
+16 ; dbia 999
SET DIC="^DD(63.39,"
DO ^DIC
+17 IF '$$TBDN^LRPXAPIU(+Y)
SET Y=-1
QUIT
End DoDot:2
QUIT
End DoDot:1
IF Y<1!$DATA(DTOUT)
SET ERR=1
QUIT
+18 SET CODE="M;"_FILE_";"_+Y
+19 WRITE !
+20 QUIT
