PXRMBXTL ; SLC/PKR - Build expanded taxonomies. ;03-Mar-2016 12:11;DU
;;2.0;CLINICAL REMINDERS;**1001,12,26,1007**;Feb 04, 2005;Build 12
;
;====================================================
CHECK(TAXIEN,KI) ;Check for expanded taxonomy, build it if it does not
;exist.
N TEMP
S TEMP=$G(^PXD(811.3,TAXIEN,0))
I TEMP="" D EXPAND(TAXIEN,KI)
Q
;
;====================================================
DELEXTL(TAXIEN) ;Delete an expanded taxonomy.
I '$$LOCKXTL(TAXIEN) Q
N DA,DIK
S DIK="^PXD(811.3,"
S DA=TAXIEN
D ^DIK
D ULOCKXTL(TAXIEN)
Q
;
;====================================================
EXPALLO ;Rebuild all taxonomy expansions, used by option
I '$D(^XUSEC("PXRM MANAGER",DUZ)) D Q
. W !,"You must hold the PXRM MANAGER key to use this option."
D EXPALL^PXRMBXTL
Q
;
;====================================================
EXPALL ;Rebuild all taxonomy expansions.
N IEN,NAME
D BMES^XPDUTL("Rebuilding all taxonomy expansions.")
S IEN=0
F S IEN=+$O(^PXD(811.2,IEN)) Q:IEN=0 D
. S NAME=$P(^PXD(811.2,IEN,0),U,1)
. D MES^XPDUTL("Expanding "_NAME_" (IEN="_IEN_")")
. D DELEXTL^PXRMBXTL(IEN)
. D EXPAND^PXRMBXTL(IEN,"")
D BMES^XPDUTL("Done rebuilding taxonomy expansions.")
Q
;
;====================================================
EXPAND(TAXIEN,KI) ;Build an expanded taxonomy. If KI is defined then
;entry KI is being deleted so skip it. KI is checked because this
;can be called by cross-references in 811.2.
I '$$LOCKXTL(TAXIEN) Q
N CPTDATE,DATEBLT,HIGH,ICD0DATE,ICD9DATE,IND,LOW
N NICD0,NICD9,NICPT,NRCPT,TEMP,X,X1,X2
K ^PXD(811.3,TAXIEN)
S DATEBLT=$$NOW^XLFDT
S $P(^PXD(811.3,TAXIEN,0),U,1)=TAXIEN
S $P(^PXD(811.3,TAXIEN,0),U,2)=DATEBLT
;
S (IND,NICD0)=0
F S IND=+$O(^PXD(811.2,TAXIEN,80.1,IND)) Q:IND=0 D
. I KI=IND Q
. S TEMP=^PXD(811.2,TAXIEN,80.1,IND,0)
. S LOW=$P(TEMP,U,1)
. S HIGH=$P(TEMP,U,2)
. I HIGH="" S HIGH=LOW
. D ICD0(TAXIEN,LOW,HIGH,.NICD0)
S ICD0DATE=$$GET1^DID(80.1,"","","PACKAGE REVISION DATA")
S ICD0DATE=$P(ICD0DATE,U,2)
S $P(^PXD(811.3,TAXIEN,0),U,3,4)=NICD0_U_ICD0DATE
;
S (IND,NICD9)=0
F S IND=+$O(^PXD(811.2,TAXIEN,80,IND)) Q:IND=0 D
. I KI=IND Q
. S TEMP=^PXD(811.2,TAXIEN,80,IND,0)
. S LOW=$P(TEMP,U,1)
. S HIGH=$P(TEMP,U,2)
. I HIGH="" S HIGH=LOW
. D ICD9(TAXIEN,LOW,HIGH,.NICD9)
S ICD9DATE=$$GET1^DID(80,"","","PACKAGE REVISION DATA")
S ICD9DATE=$P(ICD9DATE,U,2)
S $P(^PXD(811.3,TAXIEN,0),U,5,6)=NICD9_U_ICD9DATE
;
S (IND,NICPT,NRCPT)=0
F S IND=+$O(^PXD(811.2,TAXIEN,81,IND)) Q:IND=0 D
. I KI=IND Q
. S TEMP=^PXD(811.2,TAXIEN,81,IND,0)
. S LOW=$P(TEMP,U,1)
. S HIGH=$P(TEMP,U,2)
. I HIGH="" S HIGH=LOW
. D ICPT(TAXIEN,LOW,HIGH,.NICPT,.NRCPT)
S CPTDATE=$$GET1^DID(81,"","","PACKAGE REVISION DATA")
S CPTDATE=$P(CPTDATE,U,2)
S $P(^PXD(811.3,TAXIEN,0),U,7,9)=NICPT_U_CPTDATE_U_NRCPT
;
;Create the patient data source.
;S (X1,X2)="TAX"
;S X=$P(^PXD(811.2,TAXIEN,0),U,4)
;D KPDS^PXRMPDS(X,X1,X2,TAXIEN)
;D SPDS^PXRMPDS(X,X1,X2,TAXIEN)
;
D SZN
D ULOCKXTL(TAXIEN)
Q
;
;====================================================
ICD0(TAXIEN,LOW,HIGH,NICD0) ;Build the list of internal entries for ICD0
;(File 80.1). Use of ICDAPIU: DBIA #3991
N CODE,IEN,TEMP
S CODE=LOW
F Q:(CODE]HIGH)!(CODE="") D
. S TEMP=$$STATCHK^ICDAPIU(CODE,"")
. S IEN=$P(TEMP,U,2)
. I IEN'=-1,'$D(^PXD(811.3,TAXIEN,80.1,"ICD0P",IEN)) D
.. S NICD0=NICD0+1
.. S ^PXD(811.3,TAXIEN,80.1,NICD0,0)=IEN
.. S ^PXD(811.3,TAXIEN,80.1,"ICD0P",IEN,NICD0,0)=""
. S CODE=$$NEXT^ICDAPIU(CODE)
Q
;
;====================================================
ICD9(TAXIEN,LOW,HIGH,NICD9) ;Build the list of internal entries for ICD9
;(File 80). Use of ICDAPIU: DBIA #3991
N CODE,IEN,TEMP
S CODE=LOW
F Q:(CODE]HIGH)!(CODE="") D
. S TEMP=$$STATCHK^ICDAPIU(CODE,"")
. S IEN=$P(TEMP,U,2)
. I IEN'=-1,'$D(^PXD(811.3,TAXIEN,80,"ICD9P",IEN)) D
.. S NICD9=NICD9+1
.. S ^PXD(811.3,TAXIEN,80,NICD9,0)=IEN
.. S ^PXD(811.3,TAXIEN,80,"ICD9P",IEN,NICD9,0)=""
. S CODE=$$NEXT^ICDAPIU(CODE)
Q
;
;====================================================
ICPT(TAXIEN,LOW,HIGH,NICPT,NRCPT) ;Build the list of internal entries
;for ICPT (File 81). Use of ICDAPIU: DBIA #3991
N CODE,IEN,RADIEN,TEMP,ACT,CNT,CPTIEN
S CODE=LOW
;IHS/MSC/MGH Patch 1007
;Redid this section because VA did not deal with duplicate codes
F Q:(CODE]HIGH)!(CODE="") D
.S CNT=0,CPTIEN=0
.F S CPTIEN=$O(^ICPT("B",CODE,CPTIEN)) Q:CPTIEN="" D
..S CNT=CNT+1
.I CNT=1 D
..S TEMP=$$STATCHK^ICPTAPIU(CODE,"")
.. S IEN=$P(TEMP,U,2)
.. I IEN'=-1,'$D(^PXD(811.3,TAXIEN,81,"ICPTP",IEN)) D
... S NICPT=NICPT+1
... S ^PXD(811.3,TAXIEN,81,NICPT,0)=IEN
... S ^PXD(811.3,TAXIEN,81,"ICPTP",IEN,NICPT,0)=""
.I CNT>1 D
.. S TEMP=$$CPT^ICPTCOD(CODE,$$NOW^XLFDT)
.. S IEN=$P(TEMP,U,1)
.. S ACT=$P(TEMP,U,7)
.. I IEN'=-1,ACT=1,'$D(^PXD(811.3,TAXIEN,81,"ICPTP",IEN)) D
... S NICPT=NICPT+1
... S ^PXD(811.3,TAXIEN,81,NICPT,0)=IEN
... S ^PXD(811.3,TAXIEN,81,"ICPTP",IEN,NICPT,0)=""
..;Determine if this is a radiology procedure.
..;DBIA #586.
.. S RADIEN=""
.. F S RADIEN=+$O(^RAMIS(71,"D",IEN,RADIEN)) Q:RADIEN=0 D
... S NRCPT=NRCPT+1
... S ^PXD(811.3,TAXIEN,71,NRCPT,0)=IEN_U_RADIEN
... S ^PXD(811.3,TAXIEN,71,"RCPTP",RADIEN,NRCPT,0)=IEN
. S CODE=$$NEXT^ICPTAPIU(CODE)
Q
;
;====================================================
LOCKXTL(TAXIEN) ;Lock the expanded taxonomy entry. This may be called during
;reminder evalution in which case PXRMXTLK will be defined or during
;a taxonomy edit in which case PXRMXTLK will be undefined.
N IND,LC,LOCK
I $D(PXRMXTLK) S LC=3
E S LC=2
S LOCK=0
F IND=1:1:LC Q:LOCK D
. L +^PXD(811.3,TAXIEN):DILOCKTM
. S LOCK=$T
;If we can't a get a lock take appropriate action.
I 'LOCK D
. I $D(PXRMXTLK) S PXRMXTLK=TAXIEN
. E D
.. N TEXT
.. S TEXT="Could not get lock for expanded taxonomy "_TAXIEN_", try again later."
.. D EN^DDIOL(TEXT)
Q LOCK
;
;====================================================
SELEXP ;Entry point for the option selected taxonomy expansion.
N TAXIEN
S TAXIEN=+$$SELECT^PXRMINQ("^PXD(811.2,","Select a taxonomy to expand: ")
I TAXIEN=-1 Q
D EXPAND(TAXIEN,"")
Q
;
;====================================================
SZN ;Set 0 node.
N IEN,TOTAL
S (IEN,TOTAL)=0
F S IEN=+$O(^PXD(811.3,IEN)) Q:IEN=0 S TOTAL=TOTAL+1
;Third piece is last number entered, fourth piece is the number
;of entries.
S $P(^PXD(811.3,0),U,3,4)="1^"_TOTAL
Q
;
;====================================================
ULOCKXTL(TAXIEN) ;Unlock the expanded taxonomy.
L -^PXD(811.3,TAXIEN)
Q
;
PXRMBXTL ; SLC/PKR - Build expanded taxonomies. ;03-Mar-2016 12:11;DU
+1 ;;2.0;CLINICAL REMINDERS;**1001,12,26,1007**;Feb 04, 2005;Build 12
+2 ;
+3 ;====================================================
CHECK(TAXIEN,KI) ;Check for expanded taxonomy, build it if it does not
+1 ;exist.
+2 NEW TEMP
+3 SET TEMP=$GET(^PXD(811.3,TAXIEN,0))
+4 IF TEMP=""
DO EXPAND(TAXIEN,KI)
+5 QUIT
+6 ;
+7 ;====================================================
DELEXTL(TAXIEN) ;Delete an expanded taxonomy.
+1 IF '$$LOCKXTL(TAXIEN)
QUIT
+2 NEW DA,DIK
+3 SET DIK="^PXD(811.3,"
+4 SET DA=TAXIEN
+5 DO ^DIK
+6 DO ULOCKXTL(TAXIEN)
+7 QUIT
+8 ;
+9 ;====================================================
EXPALLO ;Rebuild all taxonomy expansions, used by option
+1 IF '$DATA(^XUSEC("PXRM MANAGER",DUZ))
Begin DoDot:1
+2 WRITE !,"You must hold the PXRM MANAGER key to use this option."
End DoDot:1
QUIT
+3 DO EXPALL^PXRMBXTL
+4 QUIT
+5 ;
+6 ;====================================================
EXPALL ;Rebuild all taxonomy expansions.
+1 NEW IEN,NAME
+2 DO BMES^XPDUTL("Rebuilding all taxonomy expansions.")
+3 SET IEN=0
+4 FOR
SET IEN=+$ORDER(^PXD(811.2,IEN))
IF IEN=0
QUIT
Begin DoDot:1
+5 SET NAME=$PIECE(^PXD(811.2,IEN,0),U,1)
+6 DO MES^XPDUTL("Expanding "_NAME_" (IEN="_IEN_")")
+7 DO DELEXTL^PXRMBXTL(IEN)
+8 DO EXPAND^PXRMBXTL(IEN,"")
End DoDot:1
+9 DO BMES^XPDUTL("Done rebuilding taxonomy expansions.")
+10 QUIT
+11 ;
+12 ;====================================================
EXPAND(TAXIEN,KI) ;Build an expanded taxonomy. If KI is defined then
+1 ;entry KI is being deleted so skip it. KI is checked because this
+2 ;can be called by cross-references in 811.2.
+3 IF '$$LOCKXTL(TAXIEN)
QUIT
+4 NEW CPTDATE,DATEBLT,HIGH,ICD0DATE,ICD9DATE,IND,LOW
+5 NEW NICD0,NICD9,NICPT,NRCPT,TEMP,X,X1,X2
+6 KILL ^PXD(811.3,TAXIEN)
+7 SET DATEBLT=$$NOW^XLFDT
+8 SET $PIECE(^PXD(811.3,TAXIEN,0),U,1)=TAXIEN
+9 SET $PIECE(^PXD(811.3,TAXIEN,0),U,2)=DATEBLT
+10 ;
+11 SET (IND,NICD0)=0
+12 FOR
SET IND=+$ORDER(^PXD(811.2,TAXIEN,80.1,IND))
IF IND=0
QUIT
Begin DoDot:1
+13 IF KI=IND
QUIT
+14 SET TEMP=^PXD(811.2,TAXIEN,80.1,IND,0)
+15 SET LOW=$PIECE(TEMP,U,1)
+16 SET HIGH=$PIECE(TEMP,U,2)
+17 IF HIGH=""
SET HIGH=LOW
+18 DO ICD0(TAXIEN,LOW,HIGH,.NICD0)
End DoDot:1
+19 SET ICD0DATE=$$GET1^DID(80.1,"","","PACKAGE REVISION DATA")
+20 SET ICD0DATE=$PIECE(ICD0DATE,U,2)
+21 SET $PIECE(^PXD(811.3,TAXIEN,0),U,3,4)=NICD0_U_ICD0DATE
+22 ;
+23 SET (IND,NICD9)=0
+24 FOR
SET IND=+$ORDER(^PXD(811.2,TAXIEN,80,IND))
IF IND=0
QUIT
Begin DoDot:1
+25 IF KI=IND
QUIT
+26 SET TEMP=^PXD(811.2,TAXIEN,80,IND,0)
+27 SET LOW=$PIECE(TEMP,U,1)
+28 SET HIGH=$PIECE(TEMP,U,2)
+29 IF HIGH=""
SET HIGH=LOW
+30 DO ICD9(TAXIEN,LOW,HIGH,.NICD9)
End DoDot:1
+31 SET ICD9DATE=$$GET1^DID(80,"","","PACKAGE REVISION DATA")
+32 SET ICD9DATE=$PIECE(ICD9DATE,U,2)
+33 SET $PIECE(^PXD(811.3,TAXIEN,0),U,5,6)=NICD9_U_ICD9DATE
+34 ;
+35 SET (IND,NICPT,NRCPT)=0
+36 FOR
SET IND=+$ORDER(^PXD(811.2,TAXIEN,81,IND))
IF IND=0
QUIT
Begin DoDot:1
+37 IF KI=IND
QUIT
+38 SET TEMP=^PXD(811.2,TAXIEN,81,IND,0)
+39 SET LOW=$PIECE(TEMP,U,1)
+40 SET HIGH=$PIECE(TEMP,U,2)
+41 IF HIGH=""
SET HIGH=LOW
+42 DO ICPT(TAXIEN,LOW,HIGH,.NICPT,.NRCPT)
End DoDot:1
+43 SET CPTDATE=$$GET1^DID(81,"","","PACKAGE REVISION DATA")
+44 SET CPTDATE=$PIECE(CPTDATE,U,2)
+45 SET $PIECE(^PXD(811.3,TAXIEN,0),U,7,9)=NICPT_U_CPTDATE_U_NRCPT
+46 ;
+47 ;Create the patient data source.
+48 ;S (X1,X2)="TAX"
+49 ;S X=$P(^PXD(811.2,TAXIEN,0),U,4)
+50 ;D KPDS^PXRMPDS(X,X1,X2,TAXIEN)
+51 ;D SPDS^PXRMPDS(X,X1,X2,TAXIEN)
+52 ;
+53 DO SZN
+54 DO ULOCKXTL(TAXIEN)
+55 QUIT
+56 ;
+57 ;====================================================
ICD0(TAXIEN,LOW,HIGH,NICD0) ;Build the list of internal entries for ICD0
+1 ;(File 80.1). Use of ICDAPIU: DBIA #3991
+2 NEW CODE,IEN,TEMP
+3 SET CODE=LOW
+4 FOR
IF (CODE]HIGH)!(CODE="")
QUIT
Begin DoDot:1
+5 SET TEMP=$$STATCHK^ICDAPIU(CODE,"")
+6 SET IEN=$PIECE(TEMP,U,2)
+7 IF IEN'=-1
IF '$DATA(^PXD(811.3,TAXIEN,80.1,"ICD0P",IEN))
Begin DoDot:2
+8 SET NICD0=NICD0+1
+9 SET ^PXD(811.3,TAXIEN,80.1,NICD0,0)=IEN
+10 SET ^PXD(811.3,TAXIEN,80.1,"ICD0P",IEN,NICD0,0)=""
End DoDot:2
+11 SET CODE=$$NEXT^ICDAPIU(CODE)
End DoDot:1
+12 QUIT
+13 ;
+14 ;====================================================
ICD9(TAXIEN,LOW,HIGH,NICD9) ;Build the list of internal entries for ICD9
+1 ;(File 80). Use of ICDAPIU: DBIA #3991
+2 NEW CODE,IEN,TEMP
+3 SET CODE=LOW
+4 FOR
IF (CODE]HIGH)!(CODE="")
QUIT
Begin DoDot:1
+5 SET TEMP=$$STATCHK^ICDAPIU(CODE,"")
+6 SET IEN=$PIECE(TEMP,U,2)
+7 IF IEN'=-1
IF '$DATA(^PXD(811.3,TAXIEN,80,"ICD9P",IEN))
Begin DoDot:2
+8 SET NICD9=NICD9+1
+9 SET ^PXD(811.3,TAXIEN,80,NICD9,0)=IEN
+10 SET ^PXD(811.3,TAXIEN,80,"ICD9P",IEN,NICD9,0)=""
End DoDot:2
+11 SET CODE=$$NEXT^ICDAPIU(CODE)
End DoDot:1
+12 QUIT
+13 ;
+14 ;====================================================
ICPT(TAXIEN,LOW,HIGH,NICPT,NRCPT) ;Build the list of internal entries
+1 ;for ICPT (File 81). Use of ICDAPIU: DBIA #3991
+2 NEW CODE,IEN,RADIEN,TEMP,ACT,CNT,CPTIEN
+3 SET CODE=LOW
+4 ;IHS/MSC/MGH Patch 1007
+5 ;Redid this section because VA did not deal with duplicate codes
+6 FOR
IF (CODE]HIGH)!(CODE="")
QUIT
Begin DoDot:1
+7 SET CNT=0
SET CPTIEN=0
+8 FOR
SET CPTIEN=$ORDER(^ICPT("B",CODE,CPTIEN))
IF CPTIEN=""
QUIT
Begin DoDot:2
+9 SET CNT=CNT+1
End DoDot:2
+10 IF CNT=1
Begin DoDot:2
+11 SET TEMP=$$STATCHK^ICPTAPIU(CODE,"")
+12 SET IEN=$PIECE(TEMP,U,2)
+13 IF IEN'=-1
IF '$DATA(^PXD(811.3,TAXIEN,81,"ICPTP",IEN))
Begin DoDot:3
+14 SET NICPT=NICPT+1
+15 SET ^PXD(811.3,TAXIEN,81,NICPT,0)=IEN
+16 SET ^PXD(811.3,TAXIEN,81,"ICPTP",IEN,NICPT,0)=""
End DoDot:3
End DoDot:2
+17 IF CNT>1
Begin DoDot:2
+18 SET TEMP=$$CPT^ICPTCOD(CODE,$$NOW^XLFDT)
+19 SET IEN=$PIECE(TEMP,U,1)
+20 SET ACT=$PIECE(TEMP,U,7)
+21 IF IEN'=-1
IF ACT=1
IF '$DATA(^PXD(811.3,TAXIEN,81,"ICPTP",IEN))
Begin DoDot:3
+22 SET NICPT=NICPT+1
+23 SET ^PXD(811.3,TAXIEN,81,NICPT,0)=IEN
+24 SET ^PXD(811.3,TAXIEN,81,"ICPTP",IEN,NICPT,0)=""
End DoDot:3
+25 ;Determine if this is a radiology procedure.
+26 ;DBIA #586.
+27 SET RADIEN=""
+28 FOR
SET RADIEN=+$ORDER(^RAMIS(71,"D",IEN,RADIEN))
IF RADIEN=0
QUIT
Begin DoDot:3
+29 SET NRCPT=NRCPT+1
+30 SET ^PXD(811.3,TAXIEN,71,NRCPT,0)=IEN_U_RADIEN
+31 SET ^PXD(811.3,TAXIEN,71,"RCPTP",RADIEN,NRCPT,0)=IEN
End DoDot:3
End DoDot:2
+32 SET CODE=$$NEXT^ICPTAPIU(CODE)
End DoDot:1
+33 QUIT
+34 ;
+35 ;====================================================
LOCKXTL(TAXIEN) ;Lock the expanded taxonomy entry. This may be called during
+1 ;reminder evalution in which case PXRMXTLK will be defined or during
+2 ;a taxonomy edit in which case PXRMXTLK will be undefined.
+3 NEW IND,LC,LOCK
+4 IF $DATA(PXRMXTLK)
SET LC=3
+5 IF '$TEST
SET LC=2
+6 SET LOCK=0
+7 FOR IND=1:1:LC
IF LOCK
QUIT
Begin DoDot:1
+8 LOCK +^PXD(811.3,TAXIEN):DILOCKTM
+9 SET LOCK=$TEST
End DoDot:1
+10 ;If we can't a get a lock take appropriate action.
+11 IF 'LOCK
Begin DoDot:1
+12 IF $DATA(PXRMXTLK)
SET PXRMXTLK=TAXIEN
+13 IF '$TEST
Begin DoDot:2
+14 NEW TEXT
+15 SET TEXT="Could not get lock for expanded taxonomy "_TAXIEN_", try again later."
+16 DO EN^DDIOL(TEXT)
End DoDot:2
End DoDot:1
+17 QUIT LOCK
+18 ;
+19 ;====================================================
SELEXP ;Entry point for the option selected taxonomy expansion.
+1 NEW TAXIEN
+2 SET TAXIEN=+$$SELECT^PXRMINQ("^PXD(811.2,","Select a taxonomy to expand: ")
+3 IF TAXIEN=-1
QUIT
+4 DO EXPAND(TAXIEN,"")
+5 QUIT
+6 ;
+7 ;====================================================
SZN ;Set 0 node.
+1 NEW IEN,TOTAL
+2 SET (IEN,TOTAL)=0
+3 FOR
SET IEN=+$ORDER(^PXD(811.3,IEN))
IF IEN=0
QUIT
SET TOTAL=TOTAL+1
+4 ;Third piece is last number entered, fourth piece is the number
+5 ;of entries.
+6 SET $PIECE(^PXD(811.3,0),U,3,4)="1^"_TOTAL
+7 QUIT
+8 ;
+9 ;====================================================
ULOCKXTL(TAXIEN) ;Unlock the expanded taxonomy.
+1 LOCK -^PXD(811.3,TAXIEN)
+2 QUIT
+3 ;
