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

ATXTAXE.m

Go to the documentation of this file. 
  1. ATXTAXE ; IHS/CMI/LAB - DISPLAY IND LISTS ;
  1.  ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
  1.  ;; ;
  1. EP ;EP - CALLED FROM OPTION
  1.  D EN
  1.  Q
  1. EOJ ;EP
  1.  D ^XBFMK
  1.  K ATXITEM,ATXX,ATXTAXI,ATXITMI,ATXHIGH,ATXTXLI
  1.  Q
  1.  ;; ;
  1. EN ;EP -- main entry point for
  1.  S DIE="^ATXAX(",DR=".02;5101;1101",DA=ATXTAXI D ^DIE
  1.  ;
  1.  D EN^VALM("ATX TAXONOMY GENERIC EDIT")
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  W:$D(IOF) @IOF
  1.  D EOJ
  1.  Q
  1.  ;
  1. PAUSE ;EP
  1.  Q:$E(IOST)'="C"!(IO'=IO(0))
  1.  W ! S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. HDR ; -- header code
  1.  S VALMHDR(1)="Updating the "_ATXTAXN_" taxonomy"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  I ATXFILE=60 D LAB Q
  1.  I $P(^ATXAX(ATXTAXI,0),U,13)!($$ACAN($P(^ATXAX(ATXTAXI,0),U,15))) D CANDISP Q
  1.  K ATXITEM S ATXHIGH="",C=0
  1.  S ATXX=0 F  S ATXX=$O(^ATXAX(ATXTAXI,21,ATXX)) Q:ATXX'=+ATXX  D
  1.  .S C=C+1
  1.  .S ATXITMI=$P(^ATXAX(ATXTAXI,21,ATXX,0),U)
  1.  .I ATXFILE=9999999.05 S ATXITEM(C,0)=C_")  "_ATXITMI I 1
  1.  .E  S ATXITEM(C,0)=C_")  "_$$VAL^XBDIQ1($P(^ATXAX(ATXTAXI,0),U,15),ATXITMI,.01)
  1.  .S ATXITEM("IDX",C,C)=ATXITMI
  1.  .Q
  1.  S (VALMCNT,ATXHIGH)=C
  1.  Q
  1. ACAN(F) ;
  1.  I $G(F)="" Q 0
  1.  I F=80 Q 1
  1.  I F=80.1 Q 1
  1.  I F=81 Q 1
  1.  Q 0
  1. CANDISP ;
  1.  K ATXITEM S ATXHIGH="",C=0
  1.  S ATXX=0 F  S ATXX=$O(^ATXAX(ATXTAXI,21,ATXX)) Q:ATXX'=+ATXX  D
  1.  .S C=C+1
  1.  .S ATXITEM(C,0)=C_")  "_$$STRIP^XLFSTR($P(^ATXAX(ATXTAXI,21,ATXX,0),U)," ")_" - "_$$STRIP^XLFSTR($P(^ATXAX(ATXTAXI,21,ATXX,0),U,2)," ")
  1.  .S $E(ATXITEM(C,0),30)=$S($P(^ATXAX(ATXTAXI,21,ATXX,0),U,3):"   "_$P(^ICDS($P(^ATXAX(ATXTAXI,21,ATXX,0),U,3),0),U,1),1:"")
  1.  .S ATXITEM("IDX",C,C)=ATXX
  1.  .Q
  1.  S (VALMCNT,ATXHIGH)=C
  1.  Q
  1. LAB ;
  1.  K ATXITEM S ATXHIGH="",C=0
  1.  S ATXX=0 F  S ATXX=$O(^ATXLAB(ATXTAXI,21,ATXX)) Q:ATXX'=+ATXX  D
  1.  .S C=C+1
  1.  .S ATXITMI=$P(^ATXLAB(ATXTAXI,21,ATXX,0),U)
  1.  .S ATXITEM(C,0)=C_")  "_$P($G(^LAB(60,ATXITMI,0)),U)
  1.  .S ATXITEM("IDX",C,C)=ATXITMI
  1.  .Q
  1.  S (VALMCNT,ATXHIGH)=C
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. BACK ;go back to listman
  1.  D TERM^VALM0
  1.  S VALMBCK="R"
  1.  D INIT
  1.  D HDR
  1.  K DIR
  1.  K X,Y,Z,I
  1.  Q
  1.  ;
  1. REM ;
  1.  D FULL^VALM1
  1.  W !
  1.  I ATXFILE=60,$P(^ATXLAB(ATXTAXI,0),U,22) W !!,"The ",$P(^ATXLAB(ATXTAXI,0),U)," Taxonomy is READ ONLY.",!,"You can not update it." D PAUSE G REMX
  1.  I ATXFILE'=60,$P(^ATXAX(ATXTAXI,0),U,22) W !!,"The ",$P(^ATXAX(ATXTAXI,0),U)," Taxonomy is READ ONLY.",!,"You can not update it." D PAUSE G REMX
  1.  I ATXFILE'=60,$P(^ATXAX(ATXTAXI,0),U,5)'=DUZ W !!,"You are not the creator of the ",$P(^ATXAX(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it." D PAUSE G REMX
  1.  I ATXFILE=60,$P(^ATXLAB(ATXTAXI,0),U,5)'=DUZ W !!,"You are not the creator of the ",$P(^ATXLAB(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it." D PAUSE G REMX
  1.  W ! K DIR
  1.  NEW ATXREMM
  1.  S ATXREMM=1
  1.  I ATXFILE=80 D ICD9ADD G REMX
  1.  I ATXFILE=80.1 D ICD0ADD G REMX
  1.  I ATXFILE=81 D ICPTADD G REMX
  1.  ;I ATXFILE'=60,$P(^ATXTYPE(ATXTAXT,0),U,4)=1 D ICD9ADD G REMX
  1.  S DIR(0)="NO^1:"_ATXHIGH,DIR("A")="Remove Which Item"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No item selected." G REMX
  1.  I $D(DIRUT) W !,"No item selected." G REMX
  1.  S ATXITMI=ATXITEM("IDX",Y,Y)
  1.  ;sure
  1.  I ATXFILE=60 K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to remove the "_$P(^LAB(60,ATXITMI,0),U)_" lab test",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I ATXFILE'=60,ATXTAXT K DIR D
  1.  .S DIR(0)="Y",DIR("A")="Are you sure you want to remove the "_$S(ATXFILE'=9999999.05:$$VAL^XBDIQ1($P(^ATXAX(ATXTAXI,0),U,15),ATXITMI,.01),1:ATXITMI)_" "_$$VAL^XBDIQ1(9002226,ATXTAXI,.15),DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I 'Y G REM
  1.  I $D(DIRUT) G REMX
  1.  D ^XBFMK
  1.  I ATXFILE=60 S DA(1)=ATXTAXI,DA=$O(^ATXLAB(ATXTAXI,21,"B",ATXITMI,0)),DIE="^ATXLAB("_ATXTAXI_",21,",DR=".01///@" D ^DIE
  1.  I ATXFILE'=60 S DA(1)=ATXTAXI,DA=$O(^ATXAX(ATXTAXI,21,"B",ATXITMI,0)),DIE="^ATXAX("_ATXTAXI_",21,",DR=".01///@" D ^DIE
  1. REMX ;
  1.  D ^XBFMK
  1.  D BACK
  1.  Q
  1. ADD ;EP - add an item to the selected list - called from a protocol
  1.  D FULL^VALM1
  1.  W !
  1.  I ATXFILE=60,$P(^ATXLAB(ATXTAXI,0),U,22) W !!,"The ",$P(^ATXLAB(ATXTAXI,0),U)," is READ ONLY.",!,"You can not update it." D PAUSE G ADDX
  1.  I ATXFILE'=60,$P(^ATXAX(ATXTAXI,0),U,22) W !!,"The ",$P(^ATXAX(ATXTAXI,0),U)," is READ ONLY.",!,"You can not update it." D PAUSE G ADDX
  1.  I ATXFILE'=60,$P(^ATXAX(ATXTAXI,0),U,5)'=DUZ W !!,"You are not the creator of the ",$P(^ATXAX(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it." D PAUSE G ADDX
  1.  I ATXFILE=60,$P(^ATXLAB(ATXTAXI,0),U,5)'=DUZ W !!,"You are not the creator of the ",$P(^ATXLAB(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it." D PAUSE G ADDX
  1.  I ATXFILE=60 D LABADD G ADDX
  1.  I ATXFILE=80 D ICD9ADD G ADDX
  1.  I ATXFILE=80.1 D ICD0ADD G ADDX
  1.  I ATXFILE=81 D ICPTADD G ADDX
  1.  K DIC
  1.  S DIC(0)="AEMQ",DIC=$P(^ATXAX(ATXTAXI,0),U,15) D ^DIC
  1.  I Y=-1 G ADDX
  1.  I $D(^ATXAX(ATXTAXI,21,"B",$S(ATXFILE'=9999999.05:+Y,1:$P(^AUTTCOM(+Y,0),U,1)))) W !!,"That item is already in the taxonomy." H 2 G ADD
  1.  S DA=ATXTAXI
  1.  S (X,ATXTXLI)=+Y
  1.  I ATXFILE=9999999.05 S (X,ATXTXLI)=$P(^AUTTCOM(+Y,0),U)  ;special processing for community
  1.  S ATXFILE=$P(^ATXAX(ATXTAXI,0),U,15)
  1.  S DA(1)=ATXTAXI
  1.  S DIC="^ATXAX("_DA_",21,"
  1.  S DIC(0)="L",DIC("DR")=".02////"_ATXTXLI K DD,DO
  1.  S:'$D(^ATXAX(DA,21,0)) ^ATXAX(DA,21,0)="^9002226.02101A"
  1.  D FILE^DICN
  1.  I '$D(^ATXAX(ATXTAXI,21,"B",ATXTXLI)) W !!,"adding ITEM failed." H 2 G ADD
  1.  G ADDX
  1. LABADD ;
  1.  K DIC
  1.  S DIC(0)="AEMQ",DIC="^LAB(60,",DIC("A")="Which LAB Test: " D ^DIC
  1.  I Y=-1 G ADDX
  1.  S ATXTXLI=+Y
  1.  I '$P(^ATXLAB(ATXTAXI,0),U,11),$O(^LAB(60,ATXTXLI,2,0)) S ATXYN="" D  G:'ATXYN ADDX
  1.  .W !!,"This lab test, ",$P(^LAB(60,ATXTXLI,0),U),", is a panel test and the"
  1.  .W !,"taxonomy ",$P(^ATXLAB(ATXTAXI,0),U)," should not contain panel tests.",!
  1.  .S DIR(0)="Y",DIR("A")="Do you still want to add this lab test to this taxonomy",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  .Q:$D(DIRUT)
  1.  .S ATXYN=Y
  1.  I $D(^ATXLAB(ATXTAXI,21,"B",ATXTXLI)) W !!,"Lab test ",$P(^LAB(60,ATXTXLI,0),U)," is already in the taxonomy." H 2 G ADD
  1.  S DA=ATXTAXI
  1.  S X=ATXTXLI
  1.  S DA(1)=ATXTAXI
  1.  S DIC="^ATXLAB("_DA_",21,"
  1.  S DIC(0)="L" K DD,DO
  1.  S:'$D(^ATXLAB(DA,21,0)) ^ATXLAB(DA,21,0)="^9002228.02101PA"
  1.  D FILE^DICN
  1.  I '$D(^ATXLAB(ATXTAXI,21,"B",ATXTXLI)) W !!,"adding lab test failed." H 2 G ADD
  1. ADDX ;
  1.  K DIC,DA,DR,ATXTXLI,DD,DO
  1.  D BACK
  1.  Q
  1. ICD9ADD ;
  1.  D ICD9ADD^ATXTAXF
  1.  Q
  1. ICD0ADD ;
  1.  D ICD9ADD^ATXTAXF
  1.  Q
  1. ICPTADD ;
  1.  D ICPTADD^ATXTAXL
  1.  Q