Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRPXAPPU

LRPXAPPU.m

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