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

ATXEMP.m

Go to the documentation of this file.
  1. ATXEMP ; IHS/OHPRD/TMJ - ICD CODES FOR A GIVEN TAXONOMY BEFORE MODIFICATION ;
  1. ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
  1. ;
  1. D INIT
  1. F ATXL=0:0 D START W ! Q:ATXSTP
  1. K ATXL,ATXSTP
  1. D EOJ
  1. Q
  1. ;
  1. INIT ;
  1. S U="^",ATXFLG=""
  1. Q
  1. ;
  1. START ;
  1. D ASK Q:ATXSTP
  1. D TSKMN
  1. D EOJ
  1. Q
  1. ;
  1. ASK ;
  1. S ATXSTP=0
  1. S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,5)=DUZ,$P(^(0),U,8)" D ^DIC K DIC
  1. I Y<1 S ATXSTP=1 Q
  1. I $D(^TMP($J,"ATXTAX",+Y)) W !,$C(7),"Taxonomy currently",^(+Y)," Try later.",! G ASK
  1. I '$O(^ATXAX(+Y,21,0)) W !,$C(7),"This option for modifying existing ICD codes in taxonomies only!",!,"If you want to enter ICD codes for a taxonomy where none existed",!,"before, use the create taxonomy option.",! G ASK
  1. S ATXX=+Y,^TMP($J,"ATXTAX",+Y)=" being modified."
  1. K ^TMP($J,"ATXEMP",ATXX)
  1. D DFNS
  1. S DIE="^ATXAX(",DR=".01;.02;1101",DA=ATXX D ^DIE K DIE,DR
  1. I $D(Y) S ATXSTP=1 K ^TMP($J,"ATXTAX",ATXX),^TMP($J,"ATXEMP",ATXX) Q
  1. D BUILD,^ATXCODE
  1. I ATXSTP=1 Q
  1. Q
  1. ;
  1. DFNS ;GET LO AND HIGH DFNS FOR THIS TAXONOMY
  1. S ATXCNT=0
  1. S ATXSS=0 F ATXL=0:0 S ATXSS=$O(^ATXAX(ATXX,21,ATXSS)) Q:ATXSS'=+ATXSS S ATXLOV=$P(^(ATXSS,0),U) S:ATXLOV'[" " ATXLOV=ATXLOV_" " D
  1. .S ATXHIV=$P(^ATXAX(ATXX,21,ATXSS,0),U,2) S:ATXHIV'[" " ATXHIV=ATXHIV_" " S ATXCNT=ATXCNT+1,ATXLW(ATXCNT)=ATXLOV,ATXHIH(ATXCNT)=ATXHIV D GETVAL
  1. Q
  1. ;
  1. GETVAL ;GET RANGE OF DFNS
  1. S ^TMP($J,"ATXEMP",ATXX,$O(^ICD9("BA",ATXLOV,"")))=""
  1. Q:ATXLOV=ATXHIV
  1. F ATXL=0:0 S ATXLOV=$O(^ICD9("BA",ATXLOV)) Q:ATXLOV](ATXHIV)!(ATXLOV="") S ATXDFN=$O(^ICD9("BA",ATXLOV,"")),^TMP($J,"ATXEMP",ATXX,ATXDFN)=""
  1. Q
  1. ;
  1. BUILD ;BUILD ATXTABLE FOR ROUTINE ATXCODE
  1. S ATX("CODE")=0 F S ATX("CODE")=$O(^ATXAX(ATXX,21,"AA",ATX("CODE"))) Q:ATX("CODE")="" S ATXTABLE(ATX("CODE"))=$O(^(ATX("CODE"),""))
  1. Q
  1. ;
  1. TSKMN ;
  1. I $O(^ATXPAT(ATXX,11,0)) W !!,$C(7),"Taxonomy will be modified (if changes were made) and patient list in PT TAXONOMY",!,"file will be updated in background by taskman!"
  1. E W !!,$C(7),"Taxonomy will now be modified (if changes were made) in background by taskman!"
  1. K ZTSAVE F %="ATXX" S ZTSAVE(%)=""
  1. S ZTRTN="ZTM^ATXMOD",ZTDESC="MODIFY ICD9 TAXONOMY FIELD",ZTIO="",ZTDTH=DT D ^%ZTLOAD K ZTSK
  1. Q
  1. ;
  1. EOJ ;
  1. K ATXLOV,ATXHIV,ATXLO,ATXHI,ATXDFN,ATXFLG,ATXP,ATXIOF,ATXCHK,ATXHIH,ATXLW,ATXI,ATXDLC,ATXX,ATXCNT,ATXDEL,ATXFLG,ATXSTOP,ATXSS
  1. Q
  1. ;