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

APCHTAXE.m

Go to the documentation of this file. 
  1. APCHTAXE ; IHS/CMI/LAB - DISPLAY IND LISTS ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;; ;
  1. EP ;EP - CALLED FROM OPTION
  1.  D EN
  1.  Q
  1. MAJPROC ;EP
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option is used to update the list of CPT codes that"
  1.  W !,"should be included in the History of Surgery component of the"
  1.  W !,"health summary.  This taxonomy should contain only CPT codes"
  1.  W !,"for procedures/surgeries that you would expect to see on the"
  1.  W !,"history of surgery section of the health summary.",!!
  1.  D PAUSE
  1.  S APCHTAXI=$O(^ATXAX("B","APCH HS MAJOR PROCEDURE CPTS",0))
  1.  S APCHFILE=81
  1.  S APCHTAXN=$P(^ATXAX(APCHTAXI,0),U)
  1.  D EN
  1.  Q
  1. MINPROC ;EP
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option is used to update the list of CPT codes that"
  1.  W !,"should be included in the History of MINOR Surgery component of the"
  1.  W !,"health summary.  This taxonomy should contain only CPT codes"
  1.  W !,"for procedures/surgeries that you would expect to see on the"
  1.  W !,"MINOR surgery section of the health summary.",!!
  1.  D PAUSE
  1.  S APCHTAXI=$O(^ATXAX("B","APCH HS MINOR PROCEDURE CPTS",0))
  1.  S APCHFILE=81
  1.  S APCHTAXN=$P(^ATXAX(APCHTAXI,0),U)
  1.  D EN
  1.  Q
  1. EOJ ;EP
  1.  D ^XBFMK
  1.  K APCHITEM,APCHX,APCHTAXI,APCHITMI,APCHHIGH,APCHTXLI,APCHFILE,APCHTAXN
  1.  Q
  1.  ;; ;
  1. EN ;EP -- main entry point for 
  1.  D EN^VALM("APCH TAXONOMY 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 "_APCHTAXN_" taxonomy"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  I APCHFILE=60 D LAB Q
  1.  I $P(^ATXAX(APCHTAXI,0),U,13) D CANDISP Q
  1.  K APCHITEM S APCHHIGH="",C=0
  1.  S APCHX=0 F  S APCHX=$O(^ATXAX(APCHTAXI,21,APCHX)) Q:APCHX'=+APCHX  D
  1.  .S C=C+1
  1.  .S APCHITMI=$P(^ATXAX(APCHTAXI,21,APCHX,0),U)
  1.  .I APCHFILE=9999999.05 S APCHITEM(C,0)=C_")  "_APCHITMI I 1
  1.  .E  S APCHITEM(C,0)=C_")  "_$$VAL^XBDIQ1($P(^ATXAX(APCHTAXI,0),U,15),APCHITMI,.01)
  1.  .S APCHITEM("IDX",C,C)=APCHITMI
  1.  .Q
  1.  S (VALMCNT,APCHHIGH)=C
  1.  Q
  1. CANDISP ;
  1.  K APCHITEM S APCHHIGH="",C=0
  1.  S APCHX=0 F  S APCHX=$O(^ATXAX(APCHTAXI,21,APCHX)) Q:APCHX'=+APCHX  D
  1.  .S C=C+1
  1.  .S APCHITEM(C,0)=C_")  "_$P(^ATXAX(APCHTAXI,21,APCHX,0),U)_"-"_$P(^ATXAX(APCHTAXI,21,APCHX,0),U,2)
  1.  .S APCHITEM("IDX",C,C)=APCHX
  1.  .Q
  1.  S (VALMCNT,APCHHIGH)=C
  1.  Q
  1. LAB ;
  1.  K APCHITEM S APCHHIGH="",C=0
  1.  S APCHX=0 F  S APCHX=$O(^ATXLAB(APCHTAXI,21,APCHX)) Q:APCHX'=+APCHX  D
  1.  .S C=C+1
  1.  .S APCHITMI=$P(^ATXLAB(APCHTAXI,21,APCHX,0),U)
  1.  .S APCHITEM(C,0)=C_")  "_$P($G(^LAB(60,APCHITMI,0)),U)
  1.  .S APCHITEM("IDX",C,C)=APCHITMI
  1.  .Q
  1.  S (VALMCNT,APCHHIGH)=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 !!,IORVON,"Please NOTE:",IORVOFF
  1.  W !,"To remove a CPT code from the list you must put a minus sign before"
  1.  W !,"the code.  For example, to remove code 56011 from this taxonomy you must type"
  1.  W !,"-56011 at the ENTER ANOTHER CPT prompt."
  1.  W !
  1.  D PAUSE
  1.  I APCHFILE=60,$P(^ATXLAB(APCHTAXI,0),U,22) W !!,"The ",$P(^ATXLAB(APCHTAXI,0),U)," Taxonomy is READ ONLY.",!,"You can not update it." D PAUSE G REMX
  1.  I APCHFILE'=60,$P(^ATXAX(APCHTAXI,0),U,22) W !!,"The ",$P(^ATXAX(APCHTAXI,0),U)," Taxonomy is READ ONLY.",!,"You can not update it." D PAUSE G REMX
  1.  W ! K DIR
  1.  I APCHFILE=80 D ICD9ADD G REMX
  1.  I APCHFILE=80.1 D ICD0ADD G REMX
  1.  I APCHFILE=81 D ICPTADD G REMX
  1.  ;I APCHFILE'=60,$P(^ATXTYPE(APCHTAXT,0),U,4)=1 D ICD9ADD G REMX
  1.  S DIR(0)="NO^1:"_APCHHIGH,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 APCHITMI=APCHITEM("IDX",Y,Y)
  1.  ;sure
  1.  I APCHFILE=60 K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to remove the "_$P(^LAB(60,APCHITMI,0),U)_" lab test",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I APCHFILE'=60,APCHTAXT K DIR D
  1.  .S DIR(0)="Y",DIR("A")="Are you sure you want to remove the "_$S(APCHFILE'=9999999.05:$$VAL^XBDIQ1($P(^ATXAX(APCHTAXI,0),U,15),APCHITMI,.01),1:APCHITMI)_" "_$$VAL^XBDIQ1(9002226,APCHTAXI,.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 APCHFILE=60 S DA(1)=APCHTAXI,DA=$O(^ATXLAB(APCHTAXI,21,"B",APCHITMI,0)),DIE="^ATXLAB("_APCHTAXI_",21,",DR=".01///@" D ^DIE
  1.  I APCHFILE'=60 S DA(1)=APCHTAXI,DA=$O(^ATXAX(APCHTAXI,21,"B",APCHITMI,0)),DIE="^ATXAX("_APCHTAXI_",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 APCHFILE=60,$P(^ATXLAB(APCHTAXI,0),U,22) W !!,"The ",$P(^ATXLAB(APCHTAXI,0),U)," is READ ONLY.",!,"You can not update it." D PAUSE G ADDX
  1.  I APCHFILE'=60,$P(^ATXAX(APCHTAXI,0),U,22) W !!,"The ",$P(^ATXAX(APCHTAXI,0),U)," is READ ONLY.",!,"You can not update it." D PAUSE G ADDX
  1.  I APCHFILE=60 D LABADD G ADDX
  1.  I APCHFILE=80 D ICD9ADD G ADDX
  1.  I APCHFILE=80.1 D ICD0ADD G ADDX
  1.  I APCHFILE=81 D ICPTADD G ADDX
  1.  K DIC
  1.  S DIC(0)="AEMQ",DIC=$P(^ATXAX(APCHTAXI,0),U,15) D ^DIC
  1.  I Y=-1 G ADDX
  1.  I $D(^ATXAX(APCHTAXI,21,"B",$S(APCHFILE'=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=APCHTAXI
  1.  S (X,APCHTXLI)=+Y
  1.  I APCHFILE=9999999.05 S (X,APCHTXLI)=$P(^AUTTCOM(+Y,0),U)  ;special processing for community
  1.  S APCHFILE=$P(^ATXAX(APCHTAXI,0),U,15)
  1.  S DA(1)=APCHTAXI
  1.  S DIC="^ATXAX("_DA_",21,"
  1.  S DIC(0)="L",DIC("DR")=".02////"_APCHTXLI K DD,DO
  1.  S:'$D(^ATXAX(DA,21,0)) ^ATXAX(DA,21,0)="^9002226.02101A"
  1.  D FILE^DICN
  1.  I '$D(^ATXAX(APCHTAXI,21,"B",APCHTXLI)) 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.  I $D(^ATXLAB(APCHTAXI,21,"B",+Y)) W !!,"Lab test ",$P(^LAB(60,+Y,0),U)," is already in the taxonomy." H 2 G ADD
  1.  S DA=APCHTAXI
  1.  S (X,APCHTXLI)=+Y
  1.  S DA(1)=APCHTAXI
  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(APCHTAXI,21,"B",APCHTXLI)) W !!,"adding lab test failed." H 2 G ADD
  1. ADDX ;
  1.  K DIC,DA,DR,APCHTXLI,DD,DO
  1.  D BACK
  1.  Q
  1. ICD9ADD ;
  1.  ;D ICD9ADD^APCHTAXF
  1.  Q
  1. ICD0ADD ;
  1.  ;D ICD0ADD^APCHTAXH
  1.  Q
  1. ICPTADD ;
  1.  D ICPTADD^APCHTAXL
  1.  Q