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

PXRMBXTL.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;====================================================
  1. CHECK(TAXIEN,KI) ;Check for expanded taxonomy, build it if it does not
  1.  ;exist.
  1.  N TEMP
  1.  S TEMP=$G(^PXD(811.3,TAXIEN,0))
  1.  I TEMP="" D EXPAND(TAXIEN,KI)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. DELEXTL(TAXIEN) ;Delete an expanded taxonomy.
  1.  I '$$LOCKXTL(TAXIEN) Q
  1.  N DA,DIK
  1.  S DIK="^PXD(811.3,"
  1.  S DA=TAXIEN
  1.  D ^DIK
  1.  D ULOCKXTL(TAXIEN)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. EXPALLO ;Rebuild all taxonomy expansions, used by option
  1.  I '$D(^XUSEC("PXRM MANAGER",DUZ)) D  Q
  1.  . W !,"You must hold the PXRM MANAGER key to use this option."
  1.  D EXPALL^PXRMBXTL
  1.  Q
  1.  ;
  1.  ;====================================================
  1. EXPALL ;Rebuild all taxonomy expansions.
  1.  N IEN,NAME
  1.  D BMES^XPDUTL("Rebuilding all taxonomy expansions.")
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXD(811.2,IEN)) Q:IEN=0  D
  1.  . S NAME=$P(^PXD(811.2,IEN,0),U,1)
  1.  . D MES^XPDUTL("Expanding "_NAME_"  (IEN="_IEN_")")
  1.  . D DELEXTL^PXRMBXTL(IEN)
  1.  . D EXPAND^PXRMBXTL(IEN,"")
  1.  D BMES^XPDUTL("Done rebuilding taxonomy expansions.")
  1.  Q
  1.  ;
  1.  ;====================================================
  1. 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
  1.  ;can be called by cross-references in 811.2.
  1.  I '$$LOCKXTL(TAXIEN) Q
  1.  N CPTDATE,DATEBLT,HIGH,ICD0DATE,ICD9DATE,IND,LOW
  1.  N NICD0,NICD9,NICPT,NRCPT,TEMP,X,X1,X2
  1.  K ^PXD(811.3,TAXIEN)
  1.  S DATEBLT=$$NOW^XLFDT
  1.  S $P(^PXD(811.3,TAXIEN,0),U,1)=TAXIEN
  1.  S $P(^PXD(811.3,TAXIEN,0),U,2)=DATEBLT
  1.  ;
  1.  S (IND,NICD0)=0
  1.  F  S IND=+$O(^PXD(811.2,TAXIEN,80.1,IND)) Q:IND=0  D
  1.  . I KI=IND Q
  1.  . S TEMP=^PXD(811.2,TAXIEN,80.1,IND,0)
  1.  . S LOW=$P(TEMP,U,1)
  1.  . S HIGH=$P(TEMP,U,2)
  1.  . I HIGH="" S HIGH=LOW
  1.  . D ICD0(TAXIEN,LOW,HIGH,.NICD0)
  1.  S ICD0DATE=$$GET1^DID(80.1,"","","PACKAGE REVISION DATA")
  1.  S ICD0DATE=$P(ICD0DATE,U,2)
  1.  S $P(^PXD(811.3,TAXIEN,0),U,3,4)=NICD0_U_ICD0DATE
  1.  ;
  1.  S (IND,NICD9)=0
  1.  F  S IND=+$O(^PXD(811.2,TAXIEN,80,IND)) Q:IND=0  D
  1.  . I KI=IND Q
  1.  . S TEMP=^PXD(811.2,TAXIEN,80,IND,0)
  1.  . S LOW=$P(TEMP,U,1)
  1.  . S HIGH=$P(TEMP,U,2)
  1.  . I HIGH="" S HIGH=LOW
  1.  . D ICD9(TAXIEN,LOW,HIGH,.NICD9)
  1.  S ICD9DATE=$$GET1^DID(80,"","","PACKAGE REVISION DATA")
  1.  S ICD9DATE=$P(ICD9DATE,U,2)
  1.  S $P(^PXD(811.3,TAXIEN,0),U,5,6)=NICD9_U_ICD9DATE
  1.  ;
  1.  S (IND,NICPT,NRCPT)=0
  1.  F  S IND=+$O(^PXD(811.2,TAXIEN,81,IND)) Q:IND=0  D
  1.  . I KI=IND Q
  1.  . S TEMP=^PXD(811.2,TAXIEN,81,IND,0)
  1.  . S LOW=$P(TEMP,U,1)
  1.  . S HIGH=$P(TEMP,U,2)
  1.  . I HIGH="" S HIGH=LOW
  1.  . D ICPT(TAXIEN,LOW,HIGH,.NICPT,.NRCPT)
  1.  S CPTDATE=$$GET1^DID(81,"","","PACKAGE REVISION DATA")
  1.  S CPTDATE=$P(CPTDATE,U,2)
  1.  S $P(^PXD(811.3,TAXIEN,0),U,7,9)=NICPT_U_CPTDATE_U_NRCPT
  1.  ;
  1.  ;Create the patient data source.
  1.  ;S (X1,X2)="TAX"
  1.  ;S X=$P(^PXD(811.2,TAXIEN,0),U,4)
  1.  ;D KPDS^PXRMPDS(X,X1,X2,TAXIEN)
  1.  ;D SPDS^PXRMPDS(X,X1,X2,TAXIEN)
  1.  ;
  1.  D SZN
  1.  D ULOCKXTL(TAXIEN)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. ICD0(TAXIEN,LOW,HIGH,NICD0) ;Build the list of internal entries for ICD0
  1.  ;(File 80.1). Use of ICDAPIU: DBIA #3991
  1.  N CODE,IEN,TEMP
  1.  S CODE=LOW
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  . S TEMP=$$STATCHK^ICDAPIU(CODE,"")
  1.  . S IEN=$P(TEMP,U,2)
  1.  . I IEN'=-1,'$D(^PXD(811.3,TAXIEN,80.1,"ICD0P",IEN)) D
  1.  .. S NICD0=NICD0+1
  1.  .. S ^PXD(811.3,TAXIEN,80.1,NICD0,0)=IEN
  1.  .. S ^PXD(811.3,TAXIEN,80.1,"ICD0P",IEN,NICD0,0)=""
  1.  . S CODE=$$NEXT^ICDAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. ICD9(TAXIEN,LOW,HIGH,NICD9) ;Build the list of internal entries for ICD9
  1.  ;(File 80). Use of ICDAPIU: DBIA #3991
  1.  N CODE,IEN,TEMP
  1.  S CODE=LOW
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  . S TEMP=$$STATCHK^ICDAPIU(CODE,"")
  1.  . S IEN=$P(TEMP,U,2)
  1.  . I IEN'=-1,'$D(^PXD(811.3,TAXIEN,80,"ICD9P",IEN)) D
  1.  .. S NICD9=NICD9+1
  1.  .. S ^PXD(811.3,TAXIEN,80,NICD9,0)=IEN
  1.  .. S ^PXD(811.3,TAXIEN,80,"ICD9P",IEN,NICD9,0)=""
  1.  . S CODE=$$NEXT^ICDAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. ICPT(TAXIEN,LOW,HIGH,NICPT,NRCPT) ;Build the list of internal entries
  1.  ;for ICPT (File 81). Use of ICDAPIU: DBIA #3991
  1.  N CODE,IEN,RADIEN,TEMP,ACT,CNT,CPTIEN
  1.  S CODE=LOW
  1.  ;IHS/MSC/MGH  Patch 1007
  1.  ;Redid this section because VA did not deal with duplicate codes
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  .S CNT=0,CPTIEN=0
  1.  .F  S CPTIEN=$O(^ICPT("B",CODE,CPTIEN)) Q:CPTIEN=""  D
  1.  ..S CNT=CNT+1
  1.  .I CNT=1 D
  1.  ..S TEMP=$$STATCHK^ICPTAPIU(CODE,"")
  1.  .. S IEN=$P(TEMP,U,2)
  1.  .. I IEN'=-1,'$D(^PXD(811.3,TAXIEN,81,"ICPTP",IEN)) D
  1.  ... S NICPT=NICPT+1
  1.  ... S ^PXD(811.3,TAXIEN,81,NICPT,0)=IEN
  1.  ... S ^PXD(811.3,TAXIEN,81,"ICPTP",IEN,NICPT,0)=""
  1.  .I CNT>1 D
  1.  .. S TEMP=$$CPT^ICPTCOD(CODE,$$NOW^XLFDT)
  1.  .. S IEN=$P(TEMP,U,1)
  1.  .. S ACT=$P(TEMP,U,7)
  1.  .. I IEN'=-1,ACT=1,'$D(^PXD(811.3,TAXIEN,81,"ICPTP",IEN)) D
  1.  ... S NICPT=NICPT+1
  1.  ... S ^PXD(811.3,TAXIEN,81,NICPT,0)=IEN
  1.  ... S ^PXD(811.3,TAXIEN,81,"ICPTP",IEN,NICPT,0)=""
  1.  ..;Determine if this is a radiology procedure.
  1.  ..;DBIA #586.
  1.  .. S RADIEN=""
  1.  .. F  S RADIEN=+$O(^RAMIS(71,"D",IEN,RADIEN)) Q:RADIEN=0  D
  1.  ... S NRCPT=NRCPT+1
  1.  ... S ^PXD(811.3,TAXIEN,71,NRCPT,0)=IEN_U_RADIEN
  1.  ... S ^PXD(811.3,TAXIEN,71,"RCPTP",RADIEN,NRCPT,0)=IEN
  1.  . S CODE=$$NEXT^ICPTAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. LOCKXTL(TAXIEN) ;Lock the expanded taxonomy entry. This may be called during
  1.  ;reminder evalution in which case PXRMXTLK will be defined or during
  1.  ;a taxonomy edit in which case PXRMXTLK will be undefined.
  1.  N IND,LC,LOCK
  1.  I $D(PXRMXTLK) S LC=3
  1.  E  S LC=2
  1.  S LOCK=0
  1.  F IND=1:1:LC Q:LOCK  D
  1.  . L +^PXD(811.3,TAXIEN):DILOCKTM
  1.  . S LOCK=$T
  1.  ;If we can't a get a lock take appropriate action.
  1.  I 'LOCK D
  1.  . I $D(PXRMXTLK) S PXRMXTLK=TAXIEN
  1.  . E  D
  1.  .. N TEXT
  1.  .. S TEXT="Could not get lock for expanded taxonomy "_TAXIEN_", try again later."
  1.  .. D EN^DDIOL(TEXT)
  1.  Q LOCK
  1.  ;
  1.  ;====================================================
  1. SELEXP ;Entry point for the option selected taxonomy expansion.
  1.  N TAXIEN
  1.  S TAXIEN=+$$SELECT^PXRMINQ("^PXD(811.2,","Select a taxonomy to expand: ")
  1.  I TAXIEN=-1 Q
  1.  D EXPAND(TAXIEN,"")
  1.  Q
  1.  ;
  1.  ;====================================================
  1. SZN ;Set 0 node.
  1.  N IEN,TOTAL
  1.  S (IEN,TOTAL)=0
  1.  F  S IEN=+$O(^PXD(811.3,IEN)) Q:IEN=0  S TOTAL=TOTAL+1
  1.  ;Third piece is last number entered, fourth piece is the number
  1.  ;of entries.
  1.  S $P(^PXD(811.3,0),U,3,4)="1^"_TOTAL
  1.  Q
  1.  ;
  1.  ;====================================================
  1. ULOCKXTL(TAXIEN) ;Unlock the expanded taxonomy.
  1.  L -^PXD(811.3,TAXIEN)
  1.  Q
  1.  ;