LRPXAPP ;SLC/STAFF Test Lab APIs ;11/12/03 15:44
;;5.2;LAB SERVICE;**295**;Sep 27, 1994
;
; - This routine shows examples of calling APIs in LRPXAPI.
; - This routine is provided for documentation and testing.
; - The temp global ^TMP("LRPXAPI",$J, is used as an example.
; - You should use a TMP global with your package's namespace.
;
TESTS ; sample application to test TESTS API
; gets the lab tests (without results) on a patient (in date range)
N COND,DFN,ERR,FROM,ITEMS,MORE,TO,TYPE K ITEMS
K ^TMP("LRPXAPP",$J)
D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
F D Q:'MORE
. D TESTS^LRPXAPI(.ITEMS,DFN,TYPE,,.MORE,COND,FROM,TO)
. M ^TMP("LRPXAPP",$J)=ITEMS
D DISPLAY^LRPXAPPU
K ^TMP("LRPXAPP",$J)
Q
;
ARESULTS ; sample application to test RESULTS API for all results
; gets all lab results on a patient (in date range)
N COND,DFN,ERR,FROM,TO,TYPE
K ^TMP("LRPXAPP",$J)
D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
D RESULTS^LRPXAPI("LRPXAPP",DFN,TYPE,1000000,,COND,FROM,TO)
D DISPLAY^LRPXAPPU
K ^TMP("LRPXAPP",$J)
Q
;
RESULTS ; sample application to test RESULTS API
; gets patient's lab test results (in date range)
K ^TMP("LRPXAPP",$J)
N COND,DFN,ERR,FROM,ITEM,MORE,RESULTS,TO,TYPE K RESULTS
D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
I TYPE="C" D GETTEST^LRPXAPPU(.ITEM,TYPE,.ERR) I ERR Q
I TYPE="A" D GETAP^LRPXAPPU(.ITEM,.ERR) I ERR Q
I TYPE="M" D GETMICRO^LRPXAPPU(.ITEM,.ERR) I ERR Q
D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
F D Q:'MORE
. D RESULTS^LRPXAPI(.RESULTS,DFN,ITEM,,.MORE,COND,FROM,TO)
. M ^TMP("LRPXAPP",$J)=RESULTS
D DISPLAY^LRPXAPPU
K ^TMP("LRPXAPP",$J)
Q
;
PATIENTS ; sample application to test PATIENTS API
; gets all patients that have had a specific lab test (in date range)
N ERR,COND,FROM,ITEM,MORE,PATIENTS,SUB,TO,TYPE K PATIENTS
D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
I TYPE="C" D GETTEST^LRPXAPPU(.ITEM,TYPE,.ERR) I ERR Q
I TYPE="A" D GETAP^LRPXAPPU(.ITEM,.ERR) I ERR Q
I TYPE="M" D GETMICRO^LRPXAPPU(.ITEM,.ERR) I ERR Q
D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
F D Q:'MORE
. D PATIENTS^LRPXAPI(.PATIENTS,ITEM,,10,.MORE,COND,FROM,TO)
. S SUB=""
. F S SUB=$O(PATIENTS(SUB)) Q:SUB="" W !,PATIENTS(SUB)
Q
;
DATES ; sample application to test DATES API
; gets the dates of labs (without results) on a patient (in date range)
N DFN,ERR,FROM,ITEMS,MORE,TO,TYPE K ITEMS
K ^TMP("LRPXAPP",$J)
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
F D Q:'MORE
. D DATES^LRPXAPI(.ITEMS,DFN,TYPE,,.MORE,FROM,TO)
. M ^TMP("LRPXAPP",$J)=ITEMS
D DISPLAY^LRPXAPPU
K ^TMP("LRPXAPP",$J)
Q
;
TESTLOOK ; test a lookup that screens for only tests done on patient
N DIC,DFN,ERR,X,Y K DIC
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
S DIC=60,DIC(0)="AEMOQ"
S DIC("S")="I $P(^(0),U,4)=""CH"",$$HASITEM^LRPXAPI(DFN,+Y)"
D ^DIC I Y<1 Q
W !,Y
Q
;
TESTVAL ; test conditions and values for a patient's test
N COL,COND,DFN,ERR,LRDFN,LRDN,LRIDT,RESULT,TEST
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
S LRDFN=$$LRDFN^LRPXAPIU(DFN)
D GETTEST^LRPXAPPU(.TEST,"C",.ERR) I ERR Q
S LRDN=$$LRDN^LRPXAPIU(TEST)
D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
S COL=0
F S COL=$O(^PXRMINDX(63,"IP",TEST,DFN,COL)) Q:COL<1 D
. S LRIDT=$$LRIDT^LRPXAPIU(COL)
. W !!,$$VAL^LRPXAPI(LRDFN,LRIDT,LRDN)
. D VALUE^LRPXAPI(.RESULT,DFN,COL,TEST,COND,.ERR)
. W !,RESULT
. D LRVALUE^LRPXAPI(.RESULT,LRDFN,LRIDT,LRDN,COND,.ERR)
. W !,RESULT
Q
;
VALUES ; test to get patient's values from PXRMINDX index
N COL,DFN,ERR,ITEM,NODE,RESULT,STOP,TYPE
D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
I TYPE="C" S ITEM=0,STOP="@"
I TYPE="A" S ITEM="A",STOP="AZ"
I TYPE="M" S ITEM="M",STOP="MZ"
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" Q:ITEM]STOP D
. S COL=0
. F S COL=$O(^PXRMINDX(63,"PI",DFN,ITEM,COL)) Q:COL<1 D
.. S NODE=""
.. F S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,COL,NODE)) Q:NODE="" D
... D LRPXRM^LRPXAPI(.RESULT,NODE,ITEM)
... W !,ITEM,!,NODE,!,RESULT
Q
;
SPEC ; test of specimen APIs
; displays specimen node, comments, results
; restricted to MAX number of collections
N COL,COLCNT,CNT,DATA,DFN,ERR,ITEM,MAX,RESULTS K COLCNT,RESULTS
S MAX=10,CNT=0
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
S ITEM=0
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM<1 D Q:CNT>MAX
. S COL=0
. F S COL=$O(^PXRMINDX(63,"PI",DFN,ITEM,COL)) Q:COL<1 D Q:CNT>MAX
.. I $D(COLCNT(COL)) Q
.. S COLCNT(COL)="",CNT=CNT+1
.. ; use "A", "C", "S", "V" to test
.. D SPEC^LRPXAPI(.RESULTS,DFN,COL,"A",.ERR)
.. W !
.. W !,$$COMMENT^LRPXAPI($$LRDFN^LRPXAPIU(DFN),$$LRIDT^LRPXAPIU(COL))
.. S DATA="RESULTS(0)"
.. F S DATA=$Q(@DATA) Q:DATA="" D
... W !,DATA_"="_@DATA
.. K RESULTS
Q
;
CHNODE ; test CH data - some not defined
N CNT,ERR,DEF,DFN,LRDFN,LRDN,LRIDT,NODE,RESULTS K RESULTS
D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
S LRDFN=$$LRDFN^LRPXAPIU(DFN)
S CNT=0
S LRIDT=0
F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D Q:CNT>3
. S CNT=CNT+1
. W !!!,LRDFN," ",LRIDT
. S LRDN=1
. F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
.. S NODE=$G(^LR(LRDFN,"CH",LRIDT,LRDN))
.. W !!,LRDN,!,NODE,!
.. D CHNODE^LRPXAPI(.RESULTS,NODE)
.. S DEF=""
.. F S DEF=$O(RESULTS(DEF)) Q:DEF="" D
... W !,DEF," = ",RESULTS(DEF)
Q
;
CONDOK ; sample application to test if condition is valid
N COND,ERR,TYPE
D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
F D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) Q:ERR Q:'$L(COND) D
. I $$CONDOK^LRPXAPIU(COND) W !,COND,!,"condition is ok" Q
. W !,COND,!,"condition is NOT ok" Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPXAPP 6130 printed Dec 13, 2024@02:19:36 Page 2
LRPXAPP ;SLC/STAFF Test Lab APIs ;11/12/03 15:44
+1 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
+2 ;
+3 ; - This routine shows examples of calling APIs in LRPXAPI.
+4 ; - This routine is provided for documentation and testing.
+5 ; - The temp global ^TMP("LRPXAPI",$J, is used as an example.
+6 ; - You should use a TMP global with your package's namespace.
+7 ;
TESTS ; sample application to test TESTS API
+1 ; gets the lab tests (without results) on a patient (in date range)
+2 NEW COND,DFN,ERR,FROM,ITEMS,MORE,TO,TYPE
KILL ITEMS
+3 KILL ^TMP("LRPXAPP",$JOB)
+4 DO GETTYPE^LRPXAPPU(.TYPE,.ERR)
IF ERR
QUIT
+5 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+6 DO GETDATE^LRPXAPPU(.FROM,.TO,.ERR)
IF ERR
QUIT
+7 DO GETCOND^LRPXAPPU(.COND,TYPE,.ERR)
IF ERR
QUIT
+8 FOR
Begin DoDot:1
+9 DO TESTS^LRPXAPI(.ITEMS,DFN,TYPE,,.MORE,COND,FROM,TO)
+10 MERGE ^TMP("LRPXAPP",$JOB)=ITEMS
End DoDot:1
if 'MORE
QUIT
+11 DO DISPLAY^LRPXAPPU
+12 KILL ^TMP("LRPXAPP",$JOB)
+13 QUIT
+14 ;
ARESULTS ; sample application to test RESULTS API for all results
+1 ; gets all lab results on a patient (in date range)
+2 NEW COND,DFN,ERR,FROM,TO,TYPE
+3 KILL ^TMP("LRPXAPP",$JOB)
+4 DO GETTYPE^LRPXAPPU(.TYPE,.ERR)
IF ERR
QUIT
+5 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+6 DO GETDATE^LRPXAPPU(.FROM,.TO,.ERR)
IF ERR
QUIT
+7 DO GETCOND^LRPXAPPU(.COND,TYPE,.ERR)
IF ERR
QUIT
+8 DO RESULTS^LRPXAPI("LRPXAPP",DFN,TYPE,1000000,,COND,FROM,TO)
+9 DO DISPLAY^LRPXAPPU
+10 KILL ^TMP("LRPXAPP",$JOB)
+11 QUIT
+12 ;
RESULTS ; sample application to test RESULTS API
+1 ; gets patient's lab test results (in date range)
+2 KILL ^TMP("LRPXAPP",$JOB)
+3 NEW COND,DFN,ERR,FROM,ITEM,MORE,RESULTS,TO,TYPE
KILL RESULTS
+4 DO GETTYPE^LRPXAPPU(.TYPE,.ERR)
IF ERR
QUIT
+5 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+6 DO GETDATE^LRPXAPPU(.FROM,.TO,.ERR)
IF ERR
QUIT
+7 IF TYPE="C"
DO GETTEST^LRPXAPPU(.ITEM,TYPE,.ERR)
IF ERR
QUIT
+8 IF TYPE="A"
DO GETAP^LRPXAPPU(.ITEM,.ERR)
IF ERR
QUIT
+9 IF TYPE="M"
DO GETMICRO^LRPXAPPU(.ITEM,.ERR)
IF ERR
QUIT
+10 DO GETCOND^LRPXAPPU(.COND,TYPE,.ERR)
IF ERR
QUIT
+11 FOR
Begin DoDot:1
+12 DO RESULTS^LRPXAPI(.RESULTS,DFN,ITEM,,.MORE,COND,FROM,TO)
+13 MERGE ^TMP("LRPXAPP",$JOB)=RESULTS
End DoDot:1
if 'MORE
QUIT
+14 DO DISPLAY^LRPXAPPU
+15 KILL ^TMP("LRPXAPP",$JOB)
+16 QUIT
+17 ;
PATIENTS ; sample application to test PATIENTS API
+1 ; gets all patients that have had a specific lab test (in date range)
+2 NEW ERR,COND,FROM,ITEM,MORE,PATIENTS,SUB,TO,TYPE
KILL PATIENTS
+3 DO GETTYPE^LRPXAPPU(.TYPE,.ERR)
IF ERR
QUIT
+4 IF TYPE="C"
DO GETTEST^LRPXAPPU(.ITEM,TYPE,.ERR)
IF ERR
QUIT
+5 IF TYPE="A"
DO GETAP^LRPXAPPU(.ITEM,.ERR)
IF ERR
QUIT
+6 IF TYPE="M"
DO GETMICRO^LRPXAPPU(.ITEM,.ERR)
IF ERR
QUIT
+7 DO GETCOND^LRPXAPPU(.COND,TYPE,.ERR)
IF ERR
QUIT
+8 DO GETDATE^LRPXAPPU(.FROM,.TO,.ERR)
IF ERR
QUIT
+9 FOR
Begin DoDot:1
+10 DO PATIENTS^LRPXAPI(.PATIENTS,ITEM,,10,.MORE,COND,FROM,TO)
+11 SET SUB=""
+12 FOR
SET SUB=$ORDER(PATIENTS(SUB))
if SUB=""
QUIT
WRITE !,PATIENTS(SUB)
End DoDot:1
if 'MORE
QUIT
+13 QUIT
+14 ;
DATES ; sample application to test DATES API
+1 ; gets the dates of labs (without results) on a patient (in date range)
+2 NEW DFN,ERR,FROM,ITEMS,MORE,TO,TYPE
KILL ITEMS
+3 KILL ^TMP("LRPXAPP",$JOB)
+4 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+5 DO GETTYPE^LRPXAPPU(.TYPE,.ERR)
IF ERR
QUIT
+6 DO GETDATE^LRPXAPPU(.FROM,.TO,.ERR)
IF ERR
QUIT
+7 FOR
Begin DoDot:1
+8 DO DATES^LRPXAPI(.ITEMS,DFN,TYPE,,.MORE,FROM,TO)
+9 MERGE ^TMP("LRPXAPP",$JOB)=ITEMS
End DoDot:1
if 'MORE
QUIT
+10 DO DISPLAY^LRPXAPPU
+11 KILL ^TMP("LRPXAPP",$JOB)
+12 QUIT
+13 ;
TESTLOOK ; test a lookup that screens for only tests done on patient
+1 NEW DIC,DFN,ERR,X,Y
KILL DIC
+2 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+3 SET DIC=60
SET DIC(0)="AEMOQ"
+4 SET DIC("S")="I $P(^(0),U,4)=""CH"",$$HASITEM^LRPXAPI(DFN,+Y)"
+5 DO ^DIC
IF Y<1
QUIT
+6 WRITE !,Y
+7 QUIT
+8 ;
TESTVAL ; test conditions and values for a patient's test
+1 NEW COL,COND,DFN,ERR,LRDFN,LRDN,LRIDT,RESULT,TEST
+2 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+3 SET LRDFN=$$LRDFN^LRPXAPIU(DFN)
+4 DO GETTEST^LRPXAPPU(.TEST,"C",.ERR)
IF ERR
QUIT
+5 SET LRDN=$$LRDN^LRPXAPIU(TEST)
+6 DO GETCOND^LRPXAPPU(.COND,TYPE,.ERR)
IF ERR
QUIT
+7 SET COL=0
+8 FOR
SET COL=$ORDER(^PXRMINDX(63,"IP",TEST,DFN,COL))
if COL<1
QUIT
Begin DoDot:1
+9 SET LRIDT=$$LRIDT^LRPXAPIU(COL)
+10 WRITE !!,$$VAL^LRPXAPI(LRDFN,LRIDT,LRDN)
+11 DO VALUE^LRPXAPI(.RESULT,DFN,COL,TEST,COND,.ERR)
+12 WRITE !,RESULT
+13 DO LRVALUE^LRPXAPI(.RESULT,LRDFN,LRIDT,LRDN,COND,.ERR)
+14 WRITE !,RESULT
End DoDot:1
+15 QUIT
+16 ;
VALUES ; test to get patient's values from PXRMINDX index
+1 NEW COL,DFN,ERR,ITEM,NODE,RESULT,STOP,TYPE
+2 DO GETTYPE^LRPXAPPU(.TYPE,.ERR)
IF ERR
QUIT
+3 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+4 IF TYPE="C"
SET ITEM=0
SET STOP="@"
+5 IF TYPE="A"
SET ITEM="A"
SET STOP="AZ"
+6 IF TYPE="M"
SET ITEM="M"
SET STOP="MZ"
+7 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM=""
QUIT
if ITEM]STOP
QUIT
Begin DoDot:1
+8 SET COL=0
+9 FOR
SET COL=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,COL))
if COL<1
QUIT
Begin DoDot:2
+10 SET NODE=""
+11 FOR
SET NODE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,COL,NODE))
if NODE=""
QUIT
Begin DoDot:3
+12 DO LRPXRM^LRPXAPI(.RESULT,NODE,ITEM)
+13 WRITE !,ITEM,!,NODE,!,RESULT
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
SPEC ; test of specimen APIs
+1 ; displays specimen node, comments, results
+2 ; restricted to MAX number of collections
+3 NEW COL,COLCNT,CNT,DATA,DFN,ERR,ITEM,MAX,RESULTS
KILL COLCNT,RESULTS
+4 SET MAX=10
SET CNT=0
+5 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+6 SET ITEM=0
+7 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM<1
QUIT
Begin DoDot:1
+8 SET COL=0
+9 FOR
SET COL=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,COL))
if COL<1
QUIT
Begin DoDot:2
+10 IF $DATA(COLCNT(COL))
QUIT
+11 SET COLCNT(COL)=""
SET CNT=CNT+1
+12 ; use "A", "C", "S", "V" to test
+13 DO SPEC^LRPXAPI(.RESULTS,DFN,COL,"A",.ERR)
+14 WRITE !
+15 WRITE !,$$COMMENT^LRPXAPI($$LRDFN^LRPXAPIU(DFN),$$LRIDT^LRPXAPIU(COL))
+16 SET DATA="RESULTS(0)"
+17 FOR
SET DATA=$QUERY(@DATA)
if DATA=""
QUIT
Begin DoDot:3
+18 WRITE !,DATA_"="_@DATA
End DoDot:3
+19 KILL RESULTS
End DoDot:2
if CNT>MAX
QUIT
End DoDot:1
if CNT>MAX
QUIT
+20 QUIT
+21 ;
CHNODE ; test CH data - some not defined
+1 NEW CNT,ERR,DEF,DFN,LRDFN,LRDN,LRIDT,NODE,RESULTS
KILL RESULTS
+2 DO GETPT^LRPXAPPU(.DFN,.ERR)
IF ERR
QUIT
+3 SET LRDFN=$$LRDFN^LRPXAPIU(DFN)
+4 SET CNT=0
+5 SET LRIDT=0
+6 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
if LRIDT<1
QUIT
Begin DoDot:1
+7 SET CNT=CNT+1
+8 WRITE !!!,LRDFN," ",LRIDT
+9 SET LRDN=1
+10 FOR
SET LRDN=$ORDER(^LR(LRDFN,"CH",LRIDT,LRDN))
if LRDN<1
QUIT
Begin DoDot:2
+11 SET NODE=$GET(^LR(LRDFN,"CH",LRIDT,LRDN))
+12 WRITE !!,LRDN,!,NODE,!
+13 DO CHNODE^LRPXAPI(.RESULTS,NODE)
+14 SET DEF=""
+15 FOR
SET DEF=$ORDER(RESULTS(DEF))
if DEF=""
QUIT
Begin DoDot:3
+16 WRITE !,DEF," = ",RESULTS(DEF)
End DoDot:3
End DoDot:2
End DoDot:1
if CNT>3
QUIT
+17 QUIT
+18 ;
CONDOK ; sample application to test if condition is valid
+1 NEW COND,ERR,TYPE
+2 DO GETTYPE^LRPXAPPU(.TYPE,.ERR)
IF ERR
QUIT
+3 FOR
DO GETCOND^LRPXAPPU(.COND,TYPE,.ERR)
if ERR
QUIT
if '$LENGTH(COND)
QUIT
Begin DoDot:1
+4 IF $$CONDOK^LRPXAPIU(COND)
WRITE !,COND,!,"condition is ok"
QUIT
+5 WRITE !,COND,!,"condition is NOT ok"
QUIT
End DoDot:1
+6 QUIT
+7 ;
