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

ATXGUA.m

Go to the documentation of this file. 
  1. ATXGUA ;cmi/anch/maw - ATX Gui Taxonomy Utilities (con't)
  1.  ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
  1.  ;
  1.  ;generic Taxonomy GUI calls
  1.  ;
  1.  Q
  1. DEBUG(RETVAL,BGPSTR) ;run the debugger
  1.  D DEBUG^%Serenji("TAX^ATXGU(.RETVAL,.BGPSTR)")
  1.  Q
  1.  ;
  1. TAX(ATXRET,ATXSTR) ;
  1.  S X="MERR^ATXGU",@^%ZOSF("TRAP")
  1.  N P,ATXRFL,ATXI,ATXERR,ATXIEN,ATXTAXE,ATXTAX,ATXDA,ATXNONC,ATXXRF
  1.  N ATXGL,ATXGRF,ATXP
  1.  S P="|"
  1.  I $P(ATXSTR,P)="Lab" D LABTAX^ATXGE(.ATXRET,.ATXSTR) Q
  1.  I $P(ATXSTR,P)="LAB" D LTAX^ATXGE(.ATXRET) Q
  1.  K ^ATXTMP($J)
  1.  S ATXRET="^ATXTMP("_$J_")"
  1.  S ATXI=0
  1.  S ATXERR=""
  1.  S ^ATXTMP($J,ATXI)="T00080TAXONOMY"_$C(30)
  1.  I $P(ATXSTR,P)="MED" D MEDBLD^ATXGE
  1.  F ATXP=3:1 S ATXTAXE=$P(ATXSTR,P,ATXP) Q:$G(ATXTAXE)=""  D
  1.  . Q:$G(ATXTAXE)=""
  1.  . S ATXTAX=$O(^ATXAX("B",ATXTAXE,0))
  1.  . Q:'$G(ATXTAX)
  1.  . S ATXNONC=$P($G(^ATXAX(ATXTAX,0)),U,13)
  1.  . S ATXXRF=$P($G(^ATXAX(ATXTAX,0)),U,14)
  1.  . S ATXFL=$P($G(^ATXAX(ATXTAX,0)),U,15)
  1.  . I ATXFL=80 S ATXXRF="BA"  ;icd dX x ref
  1.  . I ATXFL=80.1 S ATXXRF="BA"  ;icd op and proc xref
  1.  . I ATXFL=81 S ATXXRF="BA"
  1.  . I ATXFL]"" S ATXGL=$G(^DIC(ATXFL,0,"GL"))
  1.  . S ATXDA=0 F  S ATXDA=$O(^ATXAX(ATXTAX,21,ATXDA)) Q:'ATXDA  D
  1.  .. N ATXL,ATXH
  1.  .. S ATXI=ATXI+1
  1.  .. S ATXL=$P($G(^ATXAX(ATXTAX,21,ATXDA,0)),U)
  1.  .. S ATXH=$P($G(^ATXAX(ATXTAX,21,ATXDA,0)),U,2)
  1.  .. I (ATXL=ATXH)!($G(ATXH)="") D  Q
  1.  ... I $G(ATXXRF)="",$G(ATXGL)]"" D  Q
  1.  .... S ATXGRF=ATXGL_""""_ATXL_""""_")"
  1.  .... S ^ATXTMP($J,ATXI)=$P($G(@ATXGRF@(0)),U)_$C(30)
  1.  .... I $G(ATXFL)=95.3 S ^ATXTMP($J,ATXI)=$P($G(@ATXGRF@(0)),U)_"/"_$G(^LAB(95.3,$P(ATXL,"-"),80))_$C(30) Q
  1.  .... ;I $G(ATXFL)=81 S ^ATXTMP($J,ATXI)=$P($G(@ATXGRF@(0)),U)_"-"_$P($G(^ICPT($TR(ATXL," "),0)),U,2)_$C(30) Q
  1.  .... ;I $G(ATXFL)=80 S ^ATXTMP($J,ATXI)=$P($G(@ATXGRF@(0)),U)_"-"_$P($G(^ICD9($O(^ICD9(ATXXRF,ATXL,0)),0)),U,3)_$C(30) Q
  1.  .... ;I $G(ATXFL)=80.1 S ^ATXTMP($J,ATXI)=$P($G(@ATXGRF@(0)),U)_"-"_$P($G(^ICD0($O(^ICD0(ATXXRF,ATXL,0)),0)),U,4)_$C(30) Q
  1.  .... I $G(ATXFL)=81 S ^ATXTMP($J,ATXI)=$P($G(@ATXGRF@(0)),U)_"-"_$P($$CPT^ICPTCOD($TR(ATXL," ")),U,3)_$C(30) Q
  1.  .... I $G(ATXFL)=80 S ^ATXTMP($J,ATXI)=$P($G(@ATXGRF@(0)),U)_"-"_$P($$ICDDX^ICDEX(ATXL),U,4)_$C(30) Q
  1.  .... I $G(ATXFL)=80.1 S ^ATXTMP($J,ATXI)=$P($G(@ATXGRF@(0)),U)_"-"_$P($$ICDOP^ICDEX(ATXL,"","","E"),U,5)_$C(30) Q
  1.  ... S ^ATXTMP($J,ATXI)=ATXL_$C(30)
  1.  ... I $G(ATXFL)=95.3 S ^ATXTMP($J,ATXI)=ATXL_"/"_$G(^LAB(95.3,$P(ATXL,"-"),80))_$C(30) Q
  1.  ... ;I $G(ATXFL)=81 S ^ATXTMP($J,ATXI)=ATXL_"-"_$P($G(^ICPT($TR(ATXL," "),0)),U,2)_$C(30) Q
  1.  ... ;I $G(ATXFL)=80 S ^ATXTMP($J,ATXI)=ATXL_"-"_$P($G(^ICD9($O(^ICD9(ATXXRF,ATXL,0)),0)),U,3)_$C(30) Q
  1.  ... ;I $G(ATXFL)=80.1 S ^ATXTMP($J,ATXI)=ATXL_"-"_$P($G(^ICD0($O(^ICD0(ATXXRF,ATXL,0)),0)),U,4)_$C(30) Q
  1.  ... I $G(ATXFL)=81 S ^ATXTMP($J,ATXI)=ATXL_"-"_$P($$CPT^ICPTCOD($TR(ATXL," ")),U,3)_$C(30) Q
  1.  ... I $G(ATXFL)=80 S ^ATXTMP($J,ATXI)=ATXL_"-"_$P($$ICDDX^ICDEX(ATXL),U,4)_$C(30) Q
  1.  ... I $G(ATXFL)=80.1 S ^ATXTMP($J,ATXI)=ATXL_"-"_$P($$ICDOP^ICDEX(ATXL,"","","E"),U,5)_$C(30) Q
  1.  .. S ATXGRF=ATXGL_""""_ATXXRF_""")"
  1.  .. N ATXIEN
  1.  .. S ATXIEN=$O(@ATXGRF@(ATXL),-1)
  1.  .. F  S ATXIEN=$O(@ATXGRF@(ATXIEN)) Q:ATXIEN>ATXH  D
  1.  ... S ATXI=ATXI+1
  1.  ... S ^ATXTMP($J,ATXI)=ATXIEN_$C(30)
  1.  ... I $G(ATXFL)=95.3 S ^ATXTMP($J,ATXI)=ATXIEN_"/"_$G(^LAB(95.3,$P(ATXIEN,"-"),80))_$C(30) Q
  1.  ... ;I $G(ATXFL)=81 S ^ATXTMP($J,ATXI)=ATXIEN_"-"_$P($G(^ICPT($TR(ATXIEN," "),0)),U,2)_$C(30) Q
  1.  ... ;I $G(ATXFL)=80 S ^ATXTMP($J,ATXI)=ATXIEN_"-"_$P($G(^ICD9($O(^ICD9(ATXXRF,ATXIEN,0)),0)),U,3)_$C(30) Q
  1.  ... ;I $G(ATXFL)=80.1 S ^ATXTMP($J,ATXI)=ATXIEN_"-"_$P($G(^ICD0($O(^ICD0(ATXXRF,ATXIEN,0)),0)),U,4)_$C(30) Q
  1.  ... I $G(ATXFL)=81 S ^ATXTMP($J,ATXI)=ATXIEN_"-"_$P($$CPT^ICPTCOD($TR(ATXIEN," ")),U,3)_$C(30) Q
  1.  ... I $G(ATXFL)=80 S ^ATXTMP($J,ATXI)=ATXIEN_"-"_$P($$ICDDX^ICDEX(ATXIEN),U,4)_$C(30) Q
  1.  ... I $G(ATXFL)=80.1 S ^ATXTMP($J,ATXI)=ATXIEN_"-"_$P($$ICDOP^ICDEX(ATXIEN,"","","E"),U,5)_$C(30) Q
  1.  S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
  1.  Q
  1.  ;
  1. GETTAX(ATXRET,ATXSTR) ;-- get tax
  1.  S X="MERR^ATXGU",@^%ZOSF("TRAP")
  1.  N ATXDA,ATXI,P,ATXPKG,ATXPKGI,ATXI
  1.  S P="|"
  1.  K ^ATXTMP($J)
  1.  S ATXRET="^ATXTMP("_$J_")"
  1.  S ATXI=0
  1.  S ATXERR=""
  1.  S ATXPKG=$P(ATXSTR,P)
  1.  S ATXPKGI=$O(^DIC(9.4,"C",ATXPKG,0))
  1.  S ^ATXTMP($J,ATXI)="T00080TAXONOMIES"_$C(30)
  1.  S ATXDA=0 F  S ATXDA=$O(^ATXAX("APKG",ATXPKGI,ATXDA)) Q:'ATXDA  D
  1.  . N ATXTAX,ATXRO,ATXFL
  1.  . S ATXTAX=$P($G(^ATXAX(ATXDA,0)),U)
  1.  . S ATXRO=$S($P($G(^ATXAX(ATXDA,0)),U,22):"Read Only",1:"Editable")
  1.  . S ATXFL=$P($G(^ATXAX(ATXDA,0)),U,15)
  1.  . Q:'$G(ATXFL)
  1.  . S ^ATXTMP("TAX",$J,ATXTAX,ATXFL)=ATXRO_U_$S(ATXFL=50:"Med",1:"Tax")
  1.  S ATXDA=0 F  S ATXDA=$O(^ATXLAB("APKG",ATXPKGI,ATXDA)) Q:'ATXDA  D
  1.  . N ATXTAX,ATXRO,ATXFL,ATXPAN
  1.  . S ATXTAX=$P($G(^ATXLAB(ATXDA,0)),U)
  1.  . S ATXRO=$S($P($G(^ATXLAB(ATXDA,0)),U,22):"Read Only",1:"Editable")
  1.  . S ATXFL=$P($G(^ATXLAB(ATXDA,0)),U,9)
  1.  . S ATXPAN=$P($G(^ATXLAB(ATXDA,0)),U,11)
  1.  . I '$G(ATXFL) S ATXFL=60
  1.  . Q:'$G(ATXFL)
  1.  . S ^ATXTMP("TAX",$J,ATXTAX,ATXFL)=ATXRO_U_"Lab"_U_ATXPAN
  1.  S ATXDA=0 F  S ATXDA=$O(^ATXTMP("TAX",$J,ATXDA)) Q:ATXDA=""  D
  1.  . N ATXIEN
  1.  . S ATXIEN=0 F  S ATXIEN=$O(^ATXTMP("TAX",$J,ATXDA,ATXIEN)) Q:ATXIEN=""  D
  1.  .. S ATXI=ATXI+1
  1.  .. S ATXRO=$G(^ATXTMP("TAX",$J,ATXDA,ATXIEN))
  1.  .. S ^ATXTMP($J,ATXI)=ATXDA_"("_$P(ATXRO,U)_"/"_$P(ATXRO,U,2)_"/"_ATXIEN_"/"_$P(ATXRO,U,3)_")"_$C(30)
  1.  S ^ATXTMP($J,ATXI+1)=$C(31)_$G(ATXERR)
  1.  K ^ATXTMP("TAX",$J)
  1.  Q
  1.  ;