- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPXAPPU 3732 printed Jan 18, 2025@03:20:19 Page 2
- LRPXAPPU ;SLC/STAFF - Test Lab APIs Utilities ;1/29/04 14:35
- +1 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
- +2 ;
- +3 ; This routine is used along with LRPXAPP for testing Lab APIs.
- +4 ;
- 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