PXRMTXCS ; SLC/PKR - Taxonomy code search routines. ;05/13/2021
;;2.0;CLINICAL REMINDERS;**26,65**;Feb 04, 2005;Build 438
;
;=====================================================
CSEARCH(CODESYS,CODE,NFOUND,TAXLIST) ; Search all taxonomies to see if they
;contain CODE.
N IEN,NAME
K TAXLIST
S NFOUND=0,NAME=""
F S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME="" D
. S IEN=$O(^PXD(811.2,"B",NAME,""))
. I $D(^PXD(811.2,IEN,20,"AE",CODESYS,CODE)) S NFOUND=NFOUND+1,TAXLIST(NAME)=""
Q
;
;=====================================================
SEARCH ; Let the user input a code then search all taxonomies to determine
;which ones include that code.
N CODE,CODESYS,CODESYSL,CODESYSP,DATA,DIR,DIRUT,DTOUT,DUOUT,NFOUND
N TAX,TAXLIST,RESULT,VALID,Y
D CODESYSL^PXRMLEX(.CODESYSL)
S DIR(0)="FAOU"
S DIR("A")="Input a code to search for: "
GCODE W !
D ^DIR
I $D(DIRUT) Q
S CODE=Y
;See if this is a valid code.
S VALID=$$VCODE^PXRMLEX(CODE)
I 'VALID W !,CODE," is not a valid code, try again." G GCODE
S CODESYS=$$GETCSYS^PXRMLEX(CODE)
;DBIA #5679
S CODESYSP=$P($$CSYS^LEXU(CODESYS),U,4)
W !,"Searching for ",CODESYSP," code ",CODE
D CSEARCH(CODESYS,CODE,.NFOUND,.TAXLIST)
I NFOUND=0 W !,CODE," is not used in any taxonomies." G GCODE
W !,CODESYSP," ",CODE," is used in the following taxonomies:"
S TAX=""
F S TAX=$O(TAXLIST(TAX)) Q:TAX="" W !," ",TAX
G GCODE
Q
;
;=====================================================
UIDSEARCH(CODESYS,CODE,ENCOUNTERDT,CODELIST) ; Find all taxonomies that have this coding
;system code pair marked as UID and return all the active, on the encounter date, UID
;codes from that coding system that are marked as UID in those taxonomies. If the encounter
;date is not passed, the active check is skipped. The list is returned in CODELIST.
;CODELIST(UIDCODE)=Code Description
;CODELIST(UIDCODE,"TAX",TAXONOMY IEN)=""
N ACTDT,ENCDATE,IEN,INACTDT,INACTIVE,NINACTDT,UIDCODE
K CODELIST
S ENCDATE=$P(+$G(ENCOUNTERDT),".",1)
S IEN=0
F S IEN=+$O(^PXD(811.2,IEN)) Q:IEN=0 D
. I $D(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE)) D
.. S UIDCODE=""
.. F S UIDCODE=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,UIDCODE)) Q:UIDCODE="" D
... S ACTDT=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,UIDCODE,""))
... S INACTDT=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,UIDCODE,ACTDT,""))
...;Make sure the code is active on the encounter date. If the
...;encounter date is in the future no codes will be returned.
... S INACTIVE=0
... I ENCDATE>0 D
.... I ENCDATE<ACTDT S INACTIVE=1 Q
.... S NINACTDT=$S(INACTDT="DT":DT,1:INACTDT)
.... I ENCDATE>NINACTDT S INACTIVE=1
... I INACTIVE Q
... S CODELIST(UIDCODE)=^PXD(811.2,IEN,20,"AUID",CODESYS,UIDCODE,ACTDT,INACTDT)
... S CODELIST(UIDCODE,"TAX",IEN)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMTXCS 2808 printed Apr 09, 2024@20:51:16 Page 2
PXRMTXCS ; SLC/PKR - Taxonomy code search routines. ;05/13/2021
+1 ;;2.0;CLINICAL REMINDERS;**26,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;=====================================================
CSEARCH(CODESYS,CODE,NFOUND,TAXLIST) ; Search all taxonomies to see if they
+1 ;contain CODE.
+2 NEW IEN,NAME
+3 KILL TAXLIST
+4 SET NFOUND=0
SET NAME=""
+5 FOR
SET NAME=$ORDER(^PXD(811.2,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+6 SET IEN=$ORDER(^PXD(811.2,"B",NAME,""))
+7 IF $DATA(^PXD(811.2,IEN,20,"AE",CODESYS,CODE))
SET NFOUND=NFOUND+1
SET TAXLIST(NAME)=""
End DoDot:1
+8 QUIT
+9 ;
+10 ;=====================================================
SEARCH ; Let the user input a code then search all taxonomies to determine
+1 ;which ones include that code.
+2 NEW CODE,CODESYS,CODESYSL,CODESYSP,DATA,DIR,DIRUT,DTOUT,DUOUT,NFOUND
+3 NEW TAX,TAXLIST,RESULT,VALID,Y
+4 DO CODESYSL^PXRMLEX(.CODESYSL)
+5 SET DIR(0)="FAOU"
+6 SET DIR("A")="Input a code to search for: "
GCODE WRITE !
+1 DO ^DIR
+2 IF $DATA(DIRUT)
QUIT
+3 SET CODE=Y
+4 ;See if this is a valid code.
+5 SET VALID=$$VCODE^PXRMLEX(CODE)
+6 IF 'VALID
WRITE !,CODE," is not a valid code, try again."
GOTO GCODE
+7 SET CODESYS=$$GETCSYS^PXRMLEX(CODE)
+8 ;DBIA #5679
+9 SET CODESYSP=$PIECE($$CSYS^LEXU(CODESYS),U,4)
+10 WRITE !,"Searching for ",CODESYSP," code ",CODE
+11 DO CSEARCH(CODESYS,CODE,.NFOUND,.TAXLIST)
+12 IF NFOUND=0
WRITE !,CODE," is not used in any taxonomies."
GOTO GCODE
+13 WRITE !,CODESYSP," ",CODE," is used in the following taxonomies:"
+14 SET TAX=""
+15 FOR
SET TAX=$ORDER(TAXLIST(TAX))
if TAX=""
QUIT
WRITE !," ",TAX
+16 GOTO GCODE
+17 QUIT
+18 ;
+19 ;=====================================================
UIDSEARCH(CODESYS,CODE,ENCOUNTERDT,CODELIST) ; Find all taxonomies that have this coding
+1 ;system code pair marked as UID and return all the active, on the encounter date, UID
+2 ;codes from that coding system that are marked as UID in those taxonomies. If the encounter
+3 ;date is not passed, the active check is skipped. The list is returned in CODELIST.
+4 ;CODELIST(UIDCODE)=Code Description
+5 ;CODELIST(UIDCODE,"TAX",TAXONOMY IEN)=""
+6 NEW ACTDT,ENCDATE,IEN,INACTDT,INACTIVE,NINACTDT,UIDCODE
+7 KILL CODELIST
+8 SET ENCDATE=$PIECE(+$GET(ENCOUNTERDT),".",1)
+9 SET IEN=0
+10 FOR
SET IEN=+$ORDER(^PXD(811.2,IEN))
if IEN=0
QUIT
Begin DoDot:1
+11 IF $DATA(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE))
Begin DoDot:2
+12 SET UIDCODE=""
+13 FOR
SET UIDCODE=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS,UIDCODE))
if UIDCODE=""
QUIT
Begin DoDot:3
+14 SET ACTDT=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS,UIDCODE,""))
+15 SET INACTDT=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS,UIDCODE,ACTDT,""))
+16 ;Make sure the code is active on the encounter date. If the
+17 ;encounter date is in the future no codes will be returned.
+18 SET INACTIVE=0
+19 IF ENCDATE>0
Begin DoDot:4
+20 IF ENCDATE<ACTDT
SET INACTIVE=1
QUIT
+21 SET NINACTDT=$SELECT(INACTDT="DT":DT,1:INACTDT)
+22 IF ENCDATE>NINACTDT
SET INACTIVE=1
End DoDot:4
+23 IF INACTIVE
QUIT
+24 SET CODELIST(UIDCODE)=^PXD(811.2,IEN,20,"AUID",CODESYS,UIDCODE,ACTDT,INACTDT)
+25 SET CODELIST(UIDCODE,"TAX",IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
